`emailrelay-check-address-domains.pl <emailrelay-check-address-domains.pl>`_
----------------------------------------------------------------------------

.. code:: perl

    #!/usr/bin/env perl
    #
    # SPDX-FileCopyrightText: 2026 Graeme Walker <graeme_walker@users.sourceforge.net>
    # SPDX-License-Identifier: FSFAP
    # 
    # Copyright (c) 2026 Graeme Walker <graeme_walker@users.sourceforge.net>
    # 
    # Copying and distribution of this file, with or without modification,
    # are permitted in any medium without royalty provided the copyright
    # notice and this notice are preserved.  This file is offered as-is,
    # without any warranty.
    # ===
    #
    # emailrelay-check-address-domains.pl
    #
    # An example E-MailRelay filter script that checks the
    # envelope-from address and all the envelope-to recipient
    # addresses against a hard-coded allow-list.
    #
    
    use strict ;
    use warnings ;
    use IO::File ;
    $SIG{__DIE__} = sub { (my $e = join(" ",@_)) =~ s/\n/ /g ; print "<<error>>\n<<error: $e>>\n" ; exit 99 } ;
    
    # list of allowed domains...
    my @allow = qw(
    	books.example.com
    	xn--bcher-kva.example.de
    ) ;
    
    # read the envelope file
    my $envelope = $ARGV[1] or die "usage error\n" ;
    my $fh = new IO::File( $envelope ) or die "cannot open envelope file: $!\n" ;
    my $txt ;
    {
    	local $/ = undef ;
    	$txt = <$fh> ;
    }
    
    my @denied = () ;
    
    # check the envelope 'from' address
    {
    	my ( $address_from ) = ( $txt =~ m/X-MailRelay-From:\s*(\S*)/m ) ;
    	push @denied , $address_from if !allow_address($address_from) ;
    }
    
    # check the envelope 'to' addresses
    {
    	my @address_to = () ;
    	map {
    		my $line = $_ ;
    		my ( $a ) = ( $line =~ m/^X-MailRelay-To-[^:]*:\s*(\S*)/ ) ;
    		push @denied , $a if ( defined($a) && !allow_address($a) ) ;
    	} split( /\r\n/ , $txt ) ;
    }
    
    # return the result
    if( scalar(@denied) )
    {
    	print "<<invalid domain>>\n" ;
    	print "<<" , join(",",@denied) , ">>\n" ;
    	exit( 1 ) ;
    }
    else
    {
    	exit( 0 ) ;
    }
    
    #
    
    sub allow_address
    {
    	my ( $address ) = @_ ;
    	my ( $domain ) = ( $address =~ m/@(.*)/ ) ;
    	$domain ||= "" ;
    	return grep { m/^\Q$domain\E$/i } @allow ;
    }
    

.. _../examples/emailrelay-check-address-domains.pl: emailrelay-check-address-domains_pl.html