vendor/simpletest/fakemail

   1 #!/usr/bin/perl -w
   2 #
   3 # $Id: fakemail,v 1.10 2005/03/18 15:44:00 lastcraft Exp $
   4 #
   5 use Net::Server::Mail::SMTP;
   6 use IO::Socket::INET;
   7 use Getopt::Long;
   8 use POSIX;
   9
  10 # Bail out if missing parameters.
  11 #
  12 my ($host, $port, $path, $log, $background);
  13 GetOptions(
  14         'host=s' => \$host,
  15         'port=i' => \$port,
  16         'path=s' => \$path,
  17         'log=s' => \$log,
  18         'background' => \$background);
  19
  20 if (! defined($host) or ! defined($port) or ! defined($path)) {
  21     die "Usage: ./fakemail.pl\n" .
  22             "       --host=<localdomain>\n" .
  23             "       --port=<port number>\n" .
  24             "       --path=<path to save mails>\n" .
  25             "       --log=<optional file to append messages to>\n" .
  26             "       --background\n";
  27 };
  28 $path =~ s|/$||;
  29
  30 # Run in background.
  31 #
  32 if ($background) {
  33     my $child_pid = fork;
  34     die ($!) unless defined ($child_pid);
  35     if ($child_pid) {
  36         print "$child_pid";
  37         exit;
  38     }
  39     POSIX::setsid() or die ('Cannot detach from session: $!');
  40     close(STDIN);
  41     close(STDOUT);
  42     close(STDERR);
  43     $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&quit;
  44     $SIG{PIPE} = 'IGNORE';
  45 }
  46 serve();
  47
  48 # SMTP server.
  49 #
  50 {
  51     my $server;
  52     my $socket;
  53
  54     # Start the server.
  55     #
  56     sub serve {
  57         message('Starting fakemail');
  58         $server = new IO::Socket::INET(Listen => 1,
  59                                        Proto => 'tcp',
  60                                        Reuse => 1,
  61                                        LocalPort => $port,
  62                                        LocalHost => $host);
  63         if (! $server) {
  64             message("Cannot start fakemail: $!");
  65             quit();
  66         }
  67         message("Listening on port $port");
  68         while ($socket = $server->accept()) {
  69             message('Starting request');
  70             my $smtp = new Net::Server::Mail::SMTP(socket => $socket);
  71             $smtp->set_callback(RCPT => \&validate_recipient);
  72             $smtp->set_callback(DATA => \&queue_message);
  73             $smtp->process();
  74             close_socket($socket);
  75             $socket = undef;
  76             message('Request done');
  77         }
  78         message("Cannot accept requests");
  79         quit();
  80     }
  81
  82     # Event handlers.
  83     #
  84     sub validate_recipient {
  85         my($session, $recipient) = @_;
  86         return (1);
  87     }
  88
  89     sub queue_message {
  90         my ($session, $data) = @_;
  91
  92         message("Incoming mail");
  93         my $sender = $session->get_sender();
  94         my @recipients = $session->get_recipients();
  95         foreach my $recipient (@recipients) {
  96             message("Capturing mail to $recipient");
  97             open(FILE, "> " . get_filename_from_recipient($recipient));
  98             print FILE ${$data};
  99             close(FILE);
 100             message("Mail to $recipient saved");
 101         }
 102         message("Incoming mail dispatched");
 103         return (1, 250, "message queued");
 104     }
 105
 106     sub quit {
 107         $SIG{INT} = $SIG{TERM} = $SIG{HUP} = 'IGNORE';
 108         message('Stopping fakemail');
 109         if (defined($socket)) {
 110             close_socket($socket);
 111         }
 112         if ($server) {
 113             close_socket($server);
 114         }
 115         message('fakemail stopped');
 116         exit;
 117     }
 118
 119     sub close_socket {
 120         my $socket = shift;
 121         my $ret;
 122
 123         $ret = $socket->flush();
 124         $ret = $socket->shutdown(2);
 125         $ret = $socket->close();
 126     }
 127 }
 128
 129 # Helpers
 130 #
 131 {
 132     my %counts = ();
 133
 134     sub get_filename_from_recipient {
 135         my $recipient = shift;
 136
 137         $recipient =~ s/<|>//g;
 138         if (! defined($counts{$recipient})) {
 139             $counts{$recipient} = 1;
 140         }
 141         return "$path/$recipient." . $counts{$recipient}++;
 142     }
 143 }
 144
 145 sub message {
 146     my $message = shift;
 147
 148     if ($log) {
 149         open(FILE, ">> $log.$$");
 150         print FILE localtime() . ": $message\n";
 151         close(FILE);
 152     } else {
 153         print "$message\n";
 154     }
 155 }