~rgrjr/rgrjr-scripts

fd23afabc9b9784251fae194407e4460a94f75e7 — Bob Rogers 3 years ago 6cdacd3
Add a new --use-delivered-to option.
   From the delivered-to-1 branch.
* email/qmail-deliver.pl:
   + (write_maildir_message):  Show "Delivered-To:" headers if --verbose
     and we have two or more or double --verbose and we have any.  Also
     add a verbose "already been delivered" warn if we've seen the ID.
   + (process_qmail_file):  Add double verbose warnings for a /dev/null
     destinations and ignored pipes.
   + (find_extension):  If --use-delivered-to was specified and we have
     two or more "Delivered-To:" headers, try to extract an extension
     from the difference between the two most recent localparts; the
     difference must start with "-", which is not included.
   + (address_forged_p):  Pass one less --verbose options to
     forged-local-address.pl as we get.
   + (check_lists):  Bug fix:  Also check the envelope recipient for a
     dead address.
* email/test-qmail-deliver.pl:
   + (deliver_one):  Improve option processing.
   + Test that a message gets delivered according to the extension if
     --use-delivered-to is specified, and not otherwise.
* email/relay-test.text (added):
   + New --use-delivered-to test case.
* email/netatalk-devel.text (added):
   + Message for new --deadlist test case.
* email/test-bounce.text (removed):
   + Rename this . . .
* email/bounce-test.text (added):
   + . . . to eliminate "test-" from the front of the name.
5 files changed, 323 insertions(+), 34 deletions(-)

R email/{test-bounce.text => bounce-test.text}
A email/netatalk-devel.text
M email/qmail-deliver.pl
A email/relay-test.text
M email/test-qmail-deliver.pl
R email/test-bounce.text => email/bounce-test.text +0 -0
A email/netatalk-devel.text => email/netatalk-devel.text +69 -0
@@ 0,0 1,69 @@
X-Delivered-By: /usr/local/bin/qmail-deliver.pl (30898)
Return-Path: <aungkyawsoe@mytel.com.mm>
X-Original-To: rogers-netatalk-devel@rgrjr.dyndns.org
Delivered-To: rogers-netatalk-devel@rgrjr.dyndns.org
Received: from rgrjr.com (li126-47.members.linode.com [69.164.211.47])
	by scorpio.rgrjr.com (Postfix on openSUSE GNU/Linux) with ESMTP id C627C5FEAC
	for <rogers-netatalk-devel@rgrjr.dyndns.org>; Sat,  6 Mar 2021 18:14:20 -0500 (EST)
Received: from YGNSP02_MAIL02.mytel.com.mm (mailgw.mytel.com.mm [103.85.104.3])
	by rgrjr.com (Postfix on openSUSE) with ESMTP id 5930E1D69AC
	for <rogers-netatalk-devel@rgrjr.dyndns.org>; Sat,  6 Mar 2021 23:13:54 +0000 (UTC)
Received: from mta2.mytel.com.mm ([10.201.4.51])
	by YGNSP02_MAIL02.mytel.com.mm  with ESMTP id 126Mxos6015022-126Mxos8015022
	(version=TLSv1.2 cipher=ECDHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO);
	Sun, 7 Mar 2021 05:30:19 +0630
Received: from localhost (localhost [127.0.0.1])
	by mta2.mytel.com.mm (Postfix) with ESMTP id 95B0F1C507E;
	Sun,  7 Mar 2021 05:13:56 +0630 (MMT)
Received: from mta2.mytel.com.mm ([127.0.0.1])
	by localhost (mta2.mytel.com.mm [127.0.0.1]) (amavisd-new, port 10032)
	with ESMTP id aYyMPS8RrSHp; Sun,  7 Mar 2021 05:13:55 +0630 (MMT)
Received: from localhost (localhost [127.0.0.1])
	by mta2.mytel.com.mm (Postfix) with ESMTP id D24E11C5021;
	Sun,  7 Mar 2021 05:04:42 +0630 (MMT)
X-Virus-Scanned: amavisd-new at 
Received: from mta2.mytel.com.mm ([127.0.0.1])
	by localhost (mta2.mytel.com.mm [127.0.0.1]) (amavisd-new, port 10026)
	with ESMTP id G_N0iX60G1IH; Sun,  7 Mar 2021 05:04:41 +0630 (MMT)
Received: from mailbox.mytel.com.mm (mailbox1.mytel.com.mm [10.201.4.35])
	by mta2.mytel.com.mm (Postfix) with ESMTP id 714031C5239;
	Sun,  7 Mar 2021 04:56:43 +0630 (MMT)
Message-ID: <16332427.248336.1615069603272.JavaMail.zimbra@mytel.com.mm>
Subject: PROCESSED
MIME-Version: 1.0
Content-Type: multipart/mixed; 
	boundary="----=_Part_248330_846774070.1615069603165"
X-Originating-IP: [10.201.4.38]
X-Mailer: Zimbra 8.8.6_GA_1906 (ZimbraWebClient - GC88 (Mac)/8.8.6_GA_1906)
Thread-Index: ooqW8UuIAep/d2gOZjAQBhK7lhbYFg==
Thread-Topic: PROCESSED
Date: Sun,  7 Mar 2021 05:04:42 +0630 (MMT)
From: aungkyawsoe@mytel.com.mm

------=_Part_248330_846774070.1615069603165
Content-Type: multipart/alternative; 
	boundary="=_c756c6c3-3bf9-4645-a175-eff0220a1417"

--=_c756c6c3-3bf9-4645-a175-eff0220a1417
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 7bit

[content deleted]

--=_c756c6c3-3bf9-4645-a175-eff0220a1417
Content-Type: text/html; charset=utf-8
Content-Transfer-Encoding: 7bit

<html><body>[content deleted]</body></html>

--=_c756c6c3-3bf9-4645-a175-eff0220a1417--

------=_Part_248330_846774070.1615069603165
Content-Type: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet;
 name=Reciept.xlsx
Content-Disposition: attachment; filename=Reciept.xlsx
Content-Transfer-Encoding: base64

[content deleted]

------=_Part_248330_846774070.1615069603165--

M email/qmail-deliver.pl => email/qmail-deliver.pl +87 -5
@@ 21,6 21,7 @@ my $tag = "$0 ($$)";
my $test_p = 0;
my $verbose_p = 0;
my $redeliver_p = 0;
my $ext_from_deliver_to_p = 0;
my (@whitelists, @blacklists, @host_deadlists, @deadlists);
my @forged_local_args;



@@ 34,6 35,7 @@ GetOptions('help' => \$help, 'man' => \$man, 'usage' => \$usage,
	   'test!' => \$test_p,
	   'verbose+' => \$verbose_p,
	   'redeliver!' => \$redeliver_p,
	   'use-delivered-to!' => \$ext_from_deliver_to_p,
	   'deadlist=s' => \@deadlists,
	   'host-deadlist=s' => \@host_deadlists,
	   'whitelist=s' => \@whitelists,


@@ 109,6 111,14 @@ sub write_maildir_message {
    # delivery.
    my ($maildir, $head, $headers, $message_source) = @_;

    if ($verbose_p && $head->count('delivered-to')) {
	my @delivered_to = $head->get('delivered-to');
	warn("Message for $maildir has '",
	     join(q{', '}, map { chomp; $_; } @delivered_to), "'.\n")
	    # It's unusual to have more than one of these.
	    if @delivered_to > 1 || $verbose_p > 1;
    }

    # Validate maildir.
    unless ($maildir =~ m@/$@ && -d $maildir) {
	warn "$tag:  invalid maildir '$maildir'.\n";


@@ 125,6 135,9 @@ sub write_maildir_message {
	    my $msgid_file = "$msgid_dir/$message_id";
	    if (-e $msgid_file) {
		# Already seen.
		warn("Message '$message_id' for $maildir ",
		     "has already been delivered.\n")
		    if $verbose_p;
		if (ref($message_source)) {
		    while (<$message_source>) { }
		}


@@ 205,10 218,14 @@ sub process_qmail_file {
	    # Ignore comments and blank lines.
	}
	elsif (substr($_, 0, 1) eq '|') {
	    # Silently ignore piped commands.
	    # Ignore piped commands.
	    warn "Ignoring piped command in $qmail_file\n"
		if $verbose_p > 1;
	}
	elsif (m@^(&?dev-null|/dev/null)$@) {
	    # Explicitly ignored.
	    warn "Delivered message to /dev/null\n"
		if $verbose_p > 1;
	}
	elsif (m@^\S+/$@) {
	    # Maildir delivery.


@@ 237,10 254,36 @@ sub find_localpart {
}

sub find_extension {
    # Find the extension from $ENV{EXTENSION}, or the localpart if we can find
    # one, or assume it is "".
    # Find the extension from the difference in the latest two "Delivered-To:"
    # header localparts if --use-delivered-to was specified and such headers
    # exist, or directly from $ENV{EXTENSION}, or the from localpart or
    # $ENV{LOCAL} if we can find one (in which case we have to assume the first
    # hyphen is the extension separator), or just assume the extension is "".
    my ($head) = @_;

    if ($ext_from_deliver_to_p && $head->count('delivered-to') >= 2) {
	# If we have at least two "Delivered-To:" headers, we might be able to
	# extract an extension that was dropped between the previous address
	# ($local2, e.g. "rogers-emacs") and the final destination ($local1,
	# e.g. "rogers").  Note that comparing the two localparts means that we
	# don't have to guess which of possibly many hyphens is the right one.
	my ($local1, $local2)
	    = map { chomp;
		    my ($localpart) = split(/@/);
		    lc($localpart);
	} $head->get('delivered-to');
	my $len1 = length($local1); 
	if (length($local2) > $len1 + 1) {
	    my $suffix = substr($local2, $len1);
	    if (substr($suffix, 0, 1) eq '-'
		&& $local1 eq substr($local2, 0, $len1)) {
		warn("$tag:  Found suffix '$suffix' from 'Delivered-To:'\n")
		    if $verbose_p > 1;
		return substr($suffix, 1)
	    }
	}
    }

    my $extension = $ENV{EXTENSION};
    return $extension
	if $extension;


@@ 261,6 304,8 @@ sub address_forged_p {
    # Get forged-local-address.pl from the same place we are running.
    my $fla = $0;
    $fla =~ s@[^/]*$@forged-local-address.pl@;
    unshift(@forged_local_args, ('--verbose') x ($verbose_p - 1))
	if $verbose_p > 1;
    my $fla_cmd = join(' ', "| $fla", @forged_local_args);
    open(my $out, $fla_cmd)
	or die "could not open $fla";


@@ 361,6 406,9 @@ sub check_lists {
    my $dead_dest = -r '.qmail-dead' ? '.qmail-dead' : '.qmail-spam';
    if (@deadlists) {
	my $to_addresses = $find_addresses->(qw(to cc));
	my $recipient = $ENV{RECIPIENT};
	$to_addresses->{$recipient}++
	    if $recipient;
	return $dead_dest
	    if $address_match_p->($to_addresses, @deadlists);
    }


@@ 456,7 504,7 @@ qmail-deliver.pl - deliver mail like qmail-local, with whitelists/blacklists
    qmail-deliver.pl [ --help | --man | --usage ]

    qmail-deliver.pl [ --verbose ... ] [ --[no]test ] [ --redeliver ]
    		     [ --add-local=<name> ... ]
    		     [ --add-local=<name> ... ] [ --[no-]use-delivered-to ]
		     [ --network-prefix=<IP> ... ] [ relay-ip=<IP> ... ]
		     [ --whitelist=<file> ... ] [ --blacklist=<file> ... ]
		     [ --deadlist=<file> ... ] [ --host-deadlist=<file> ... ]


@@ 579,7 627,8 @@ See L</Message processing> for details.
=item B<--deadlist>

Names a file of deadlisted B<recipients>; if the message is addressed
(either "To:" or "CC:") to someone on this list, it is sent to
(either "To:" or "CC:" or the envelope
sender) to someone on this list, it is sent to
F<.qmail-dead> if that exists, else to F<.qmail-spam>.
See L</Message processing> for details.



@@ 631,6 680,39 @@ really only useful with C<--redeliver>.

Prints just the L<"SYNOPSIS"> section of this documentation.

=item B<--no-use-delivered-to>

=item B<--use-delivered-to>

Whether or not to use "Delivered-To:" headers when trying to find an
address extension.  The default is C<--no-use-delivered-to> because
when C<--use-delivered-to> is specified, this overrides the normal
environment C<EXTENSION> specification provided by the mail server;
normally, the mail server should know better.

The C<--use-delivered-to> option is helpful when an intermediate
server must be put in charge of aliasing in order to funnel multiple
addresses toward a single destination address for final delivery.  If
the intermediate server adds (for instance):

    Delivered-To: rogers-emacs@rgrjr.com

before redirecting the message to C<rogers@rgrjr.com>, and the
destination server adds:

    Delivered-To: rogers@rgrjr.com

before handing the message off to C<qmail-deliver.pl>, then
C<qmail-deliver.pl> can use these headers to re-split the different
alias email streams.  In this case, it would extract "emacs" as the
desired extension, and direct that message according to the
F<.qmail-emacs> file.  Note that only the localpart of each address is
consulted; the "@rgrjr.com" in each address is ignored completely, and
in fact is allowed to be different.  Note that these "Delivered-To:"
headers will be added in the B<reverse> of the order shown here (the
most recent ones are towards the top), and only the (chronologically)
last two such headers are consulted.

=item B<--verbose>

Prints debugging information if specified, appended to the

A email/relay-test.text => email/relay-test.text +97 -0
@@ 0,0 1,97 @@
Return-Path: <rogers+caf_=rogers=rgrjr.dyndns.org@rgrjr.com>
X-Original-To: rogers@rgrjr.dyndns.org
Delivered-To: rogers@rgrjr.dyndns.org
Received: from rgrjr.com (li126-47.members.linode.com [69.164.211.47])
	by scorpio.rgrjr.com (Postfix on openSUSE GNU/Linux) with ESMTP id 85C085FE4A
	for <rogers@rgrjr.dyndns.org>; Mon,  1 Mar 2021 15:04:26 -0500 (EST)
Received: from mail-io1-f48.google.com (mail-io1-f48.google.com [209.85.166.48])
	by rgrjr.com (Postfix on openSUSE) with ESMTP id C9FE51D69AD
	for <rogers@rgrjr.dyndns.org>; Mon,  1 Mar 2021 20:04:36 +0000 (UTC)
Received: by mail-io1-f48.google.com with SMTP id g27so17803677iox.2
        for <rogers@rgrjr.dyndns.org>; Mon, 01 Mar 2021 12:04:26 -0800 (PST)
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
        d=1e100.net; s=20161025;
        h=x-gm-message-state:delivered-to:dkim-signature:from:mime-version
         :content-transfer-encoding:message-id:date:to:subject;
        bh=42KV6ihpl3+pVtusr5kU6pdhU1aFsmYIgYa6cU1Y7zA=;
        b=raLlnsbgRbv1D7J7tKzVk91vmyzJUpFhFzB9CPT0024iWelFDt8YR81f8ik/0gXA/r
         GNlwHPqNojvTJHBhoHOw3fNC4HlL6meuf6m0pdtbU0vcsfBQle5P2ylh1LQJCUsTeAAT
         rA3PQ6ZeZESjsvmEMHsYV9hn1JDZbARyHNWSRuuEYa7Pvg4x0VpY9kACtQkL2Hxzayn/
         2MyzT8ZbHHfJZGS7kY8XqmeL2SK35sVuq6kvnqa5+ywgIzrTl0M0/9DLi6czDtson4VX
         kkX9SXaRu8qG93zZAJ/qSnht+1jT9HjeC19XZa3Jq41eW2U485hArLtz7lYX23x2FK9J
         UedQ==
X-Gm-Message-State: AOAM532NSQ50gU5X58fte0folBHKc6Cs774oVmhXpSmHNEbK647oBggK
	YMacF8ETi/wvoxSn69rlX8CzizT9UI4Y4nwDR4WOVxF567WTLcHcbtlwaFzk1g==
X-Received: by 2002:a05:6602:2048:: with SMTP id z8mr3033259iod.143.1614629065855;
        Mon, 01 Mar 2021 12:04:25 -0800 (PST)
X-Forwarded-To: rogers@rgrjr.dyndns.org
X-Forwarded-For: rogers@rgrjr.com rogers@rgrjr.dyndns.org
Delivered-To: rogers-emacs@rgrjr.com
Received: by 2002:a6b:3f05:0:0:0:0:0 with SMTP id m5csp4054876ioa;
        Mon, 1 Mar 2021 12:04:24 -0800 (PST)
X-Received: by 2002:a4a:d88a:: with SMTP id b10mr13860232oov.29.1614629064219;
        Mon, 01 Mar 2021 12:04:24 -0800 (PST)
ARC-Seal: i=1; a=rsa-sha256; t=1614629064; cv=none;
        d=google.com; s=arc-20160816;
        b=Bnvtb+Sl1Ad7jorRjOCaeHKhGyQvWbbqlYoq8SV1kDbBUdTfzoatl3RPMHVokaj9I4
         wi6y9trgJRaB2QXP1yKiqVjAL6kNSUnb/hgcaEb1iyiumlaBskCsh6Erx2wGRePncGoZ
         520E7KUffNhuWxajLZaDrJtFFuds1XygNleMezdJjIhSPmDV5VUG8vziT3/hloW3HU9+
         vqJ0J6OFn6wGcOhBGSgoM6+X94RWTV1KsV0W2qvTFbZI5InIH1y2wsK8By5JT+XZWDNZ
         a9pruKuLcWZB823n16AJQn311I0ic+yGtcYfifDTCzy4f+mZQT1gEPxN/ySzTVJiaftW
         MYkA==
ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816;
        h=subject:to:date:message-id:content-transfer-encoding:mime-version
         :from:dkim-signature;
        bh=42KV6ihpl3+pVtusr5kU6pdhU1aFsmYIgYa6cU1Y7zA=;
        b=wtxS32VUUAc/S9WG+50WeqHeESWiSgK3D8Ota6wZ6KU7eMXhkIZbhZYjzgp05UXIPz
         04qjahxts4iLc+WpwMGaq0dkovio6DiVjvFugItry5cWQ0CXT1IhNi3laixtBBu765p6
         qV6uhUI8ML6ps+AtgQA2q/vjyabx8cdY1nec2aSd8mk0TgwhiB3uu9M9MMDCs/0eZ5ag
         WdFDOEaE+mlJ1G36LiHDnI2waIGUTC1TigJMO1wXFqkP/FUc3XOed7oGLfnrJAKeSmTu
         vRhOfW8k4+NvM3oricaKE3VjQzUMoCCg3MhdC49qLGGagEb/xEf8bpWx0k28zutf/BDV
         eWTw==
ARC-Authentication-Results: i=1; mx.google.com;
       dkim=pass header.i=@modulargenetics-com.20150623.gappssmtp.com header.s=20150623 header.b=UnZIeh59;
       spf=neutral (google.com: 209.85.220.97 is neither permitted nor denied by best guess record for domain of rogers@modulargenetics.com) smtp.mailfrom=rogers@modulargenetics.com
Received: from mail-sor-f97.google.com (mail-sor-f97.google.com. [209.85.220.97])
        by mx.google.com with SMTPS id h5sor4076094ots.5.2021.03.01.12.04.22
        for <rogers-emacs@rgrjr.com>
        (Google Transport Security);
        Mon, 01 Mar 2021 12:04:24 -0800 (PST)
Received-SPF: neutral (google.com: 209.85.220.97 is neither permitted nor denied by best guess record for domain of rogers@modulargenetics.com) client-ip=209.85.220.97;
Authentication-Results: mx.google.com;
       dkim=pass header.i=@modulargenetics-com.20150623.gappssmtp.com header.s=20150623 header.b=UnZIeh59;
       spf=neutral (google.com: 209.85.220.97 is neither permitted nor denied by best guess record for domain of rogers@modulargenetics.com) smtp.mailfrom=rogers@modulargenetics.com
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
        d=modulargenetics-com.20150623.gappssmtp.com; s=20150623;
        h=from:mime-version:content-transfer-encoding:message-id:date:to
         :subject;
        bh=42KV6ihpl3+pVtusr5kU6pdhU1aFsmYIgYa6cU1Y7zA=;
        b=UnZIeh59iRon/falRYn2oeEFw4qFIcMtIdcmMW+DHmiTTIgeTjQpkwOP12sqewFyOd
         Nl5FtYCYJvvGkCoCHaWDHsIQDHi7ELLtvRoWK/w6pvUEk2ozN0b7QTc6d1FVjVX8RDrj
         QSVw4sWssM4ANUn/uVOLAYkKXsKqbUHqAhL2jpGAr9D4/WbVTj7X2s07jkeuWE/aQ46z
         Yn2ehGo1hpuTEbBUK5fl+DfssTGYsm4uZLUbJX+e7k9o+iEFE9fILxT0VwyahCi0n5ZM
         lPQMNijgDaUgtiCThSXp5mwqxwWslp04QPxVUrtKaGlvtEI11+WfVTdGhTIlDbr/xghX
         QYXw==
X-Google-Smtp-Source: ABdhPJyUxGLPp4enoeHVC/mMsGu0QeO9NaF8zOYsrhHGyF/iqXqqOcXA78TRYKJi6bqf2zrElfg2vgPj1f/d
X-Received: by 2002:a9d:6c92:: with SMTP id c18mr14540460otr.82.1614629062733;
        Mon, 01 Mar 2021 12:04:22 -0800 (PST)
Received: from alexandria.modulargenetics.com (pool-100-0-197-235.bstnma.fios.verizon.net. [100.0.197.235])
        by smtp-relay.gmail.com with ESMTP id w3sm2940560oow.27.2021.03.01.12.04.22
        for <rogers-emacs@rgrjr.com>;
        Mon, 01 Mar 2021 12:04:22 -0800 (PST)
X-Relaying-Domain: modulargenetics.com
Received: by alexandria.modulargenetics.com (Postfix, from userid 503)
	id 1CCE161D6C; Mon,  1 Mar 2021 15:04:22 -0500 (EST)
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Message-ID: <24637.18630.90257.937044@alexandria.modulargenetics.com>
X-Mailer: VM 7.19 under Emacs 27.1
From: Bob Rogers <rogers@modulargenetics.com>
To: Bob Rogers <rogers-emacs@rgrjr.com>
Subject: email testing [1]
Date: Mon, 1 Mar 2021 15:04:22 -0500

   Start of a new testing series.

					-- Bob

M email/test-qmail-deliver.pl => email/test-qmail-deliver.pl +70 -29
@@ 8,20 8,19 @@
use strict;
use warnings;

use Test::More tests => 64;

# Clean up from old runs, leaving an empty Maildir.
chdir('email') or die "bug";
for my $dir (qw(spam emacs Maildir)) {
    system(qq{rm -fr $dir})
	if -d $dir;
}
unlink(qw(.qmail-spam .qmail-emacs .qmail-dead));
ok(0 == system('maildirmake Maildir'), "created Maildir")
    or die "no 'maildirmake' program?\n";
use Test::More tests => 72;

### Subroutines.

sub clean_up {
    # Clean up from old runs, leaving an empty Maildir.
    for my $dir (qw(spam emacs dead Maildir)) {
	system(qq{rm -fr $dir})
	    if -d $dir;
    }
    unlink(qw(list.tmp .qmail-spam .qmail-emacs .qmail-dead));
}

sub count_messages {
    # Really, this just counts files.
    my ($maildir, $subdir) = @_;


@@ 39,34 38,48 @@ sub count_messages {
    return $count;
}

my %boolean_option_p
    = (test_p => " --test",
       redeliver_p => " --redeliver",
       use_deliver_to_p => " --use-delivered-to",
       verbose_p => " --verbose");
my %keyword_option_p
    = (network_prefix => '--network-prefix',
       blacklist => '--blacklist',
       whitelist => '--whitelist',
       deadlist => '--deadlist',
       host_deadlist => '--host-deadlist');

sub deliver_one {
    my ($message_file, $maildir, $expected_messages, %options) = @_;
    my ($message_file, $maildir, $expected_messages, @options) = @_;
    my %options = @options;
    my $exit_code = ($options{exit_code} || 0) << 8;
    $options{network_prefix} ||= '10.0.0';
    local $ENV{RECIPIENT} = $options{recipient} || '';
    local $ENV{SENDER} = $options{sender} || 'rogers@rgrjr.dyndns.org';
    local $ENV{LOCAL} = $options{localpart};

    # Set up the command.
    my $command
	= join(' ', q{perl -Mlib=.. ./qmail-deliver.pl --relay 69.164.211.47},
	       q{--add-local rgrjr.dyndns.org --add-local rgrjr.com});
    $command .= " --network-prefix=$options{network_prefix}"
	if $options{network_prefix};
    $command .= " --test"
	if $options{test_p};
    $command .= " --redeliver"
	if $options{redeliver_p};
    $command .= " --blacklist=$options{blacklist}"
	if $options{blacklist};
    $command .= " --whitelist=$options{whitelist}"
	if $options{whitelist};
    $command .= " --deadlist=$options{deadlist}"
	if $options{deadlist};
    $command .= " --host-deadlist=$options{host_deadlist}"
	if $options{host_deadlist};
    while (@options) {
	my ($keyword, $value) = (shift(@options), shift(@options));
	if (my $opt = $keyword_option_p{$keyword}) {
	    $command .= " $opt=$value";
	}
	elsif ($opt = $boolean_option_p{$keyword}) {
	    $command .= $opt;
	}
    }
    for my $opt (qw(file file1 file2 file3)) {
	$command .= " $options{$opt}"
	    if $options{$opt};
    }
    # We still discard stderr even if we are passing the --verbose option,
    # because qmail-deliver.pl redirects its stderr to post-deliver.log; this
    # redirection is just to catch a few forged-local-address.pl dribbles when
    # --verbose is not specified.
    my $exit = system(qq{$command < $message_file 2>/dev/null});
    ok($exit_code == $exit, "deliver $message_file")
	or warn "actually got exit code $exit for '$command < $message_file'";


@@ 77,6 90,12 @@ sub deliver_one {

### Main code.

## Set up.
chdir('email') or die "bug";
clean_up();
ok(0 == system('maildirmake Maildir'), "created Maildir")
    or die "no 'maildirmake' program?\n";

## Simple default deliveries.
deliver_one('from-bob.text', 'Maildir', 1);
deliver_one('rgrjr-forged-1.text', 'Maildir', 2);


@@ 120,13 139,21 @@ unlink('list.tmp');

## Test deadlisting.
system('echo rogers-ilisp@rgrjr.dyndns.org > list.tmp');
system('echo /dev/null > .qmail-dead');
deliver_one('dead-1.text', 'Maildir', 4,
ok(0 == system('maildirmake dead'), "created dead maildir");
system('echo dead/ > .qmail-dead');
deliver_one('dead-1.text', 'dead', 1,
	    deadlist => 'list.tmp',
	    sender => 'debra@somewhere.com');
system('echo rogers-netatalk-devel@rgrjr.dyndns.org >> list.tmp');
deliver_one('netatalk-devel.text', 'dead', 2,
	    recipient => 'rogers-netatalk-devel@rgrjr.dyndns.org',
	    deadlist => 'list.tmp',
	    sender => 'debra@somewhere.com');
ok(0 == system('rm -fr dead'), 'removed dead maildir');

## Test host deadlisting.
system('echo qq.com > host-deadlist.tmp');
system('echo /dev/null > .qmail-dead');
deliver_one('from-debra.text', 'Maildir', 4,
	    host_deadlist => 'host-deadlist.tmp',
	    sender => 'bogus@qq.com');


@@ 199,9 226,23 @@ deliver_one('from-debra.text', 'Maildir', 6,
	    network_prefix => '65.54.168');

## Test delivery of a Postfix bounce message.
deliver_one('test-bounce.text', 'Maildir', 7,
deliver_one('bounce-test.text', 'Maildir', 7,
	    network_prefix => '209.85.128.0/17');

## Test the --use-delivered-to feature.
system('echo rogers@modulargenetics.com >> list.tmp');
deliver_one('relay-test.text', 'emacs', 3,
	    whitelist => 'list.tmp',
	    use_deliver_to_p => 1,
	    network_prefix => '209.85.128.0/17');
# The same message will go to Maildir/ without the --use-delivered-to flag.
deliver_one('relay-test.text', 'Maildir', 8,
	    whitelist => 'list.tmp',
	    network_prefix => '209.85.128.0/17');

## Tidy up.
clean_up();

__END__

=head1 NAME