# $DUH: header_regex,v 1.4 2002/12/16 05:14:33 tv Exp $
#
# Copyright (c) 2002 Todd Vierling <tv@pobox.com> <tv@duh.org>.
# All rights reserved.
# Please see the COPYRIGHT file, part of the PMilter distribution,
# for full copyright and license terms.

##### header_regex #####
#
# Rejects messages with Received: headers matching supplied regexes.

use PMilter::Modules;
use PMilter::Server qw(:all);

my @regexes = regex_list(shift @_, 'i');
my $errmsg = shift_errmsg(@_, 'Invalid or malformed header %1 in message');

+{
	header => sub {
		my $ctx = shift;
		my $name = shift;
		my $value = shift;

		my $header = "$name: $value";
		$header =~ s/\s+/ /g; # flatten all whitespace to single space

		foreach my $rx (@regexes) {
			if ($header =~ $rx) {
				my $err = $errmsg;
				$err =~ s/%1/$name:/g;

				return $ctx->reject("554 $err");
			}
		}

		return SMFIS_CONTINUE;
	},
};
