#!/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 ;
}