#!/usr/bin/perl -w
#
# $Id: fakemail,v 1.10 2005/03/18 15:44:00 lastcraft Exp $
#
use Net::Server::Mail::SMTP;
use IO::Socket::INET;
use Getopt::Long;
use POSIX;

# Bail out if missing parameters.
#
my ($host, $port, $path, $log, $background);
GetOptions(
        'host=s' => \$host,
        'port=i' => \$port,
        'path=s' => \$path,
        'log=s' => \$log,
        'background' => \$background);

if (! defined($host) or ! defined($port) or ! defined($path)) {
    die "Usage: ./fakemail.pl\n" .
            "       --host=<localdomain>\n" .
            "       --port=<port number>\n" .
            "       --path=<path to save mails>\n" .
            "       --log=<optional file to append messages to>\n" .
            "       --background\n";
};
$path =~ s|/$||;

# Run in background.
#
if ($background) {
    my $child_pid = fork;
    die ($!) unless defined ($child_pid);
    if ($child_pid) {
        print "$child_pid";
        exit;
    }
    POSIX::setsid() or die ('Cannot detach from session: $!');
    close(STDIN);
    close(STDOUT);
    close(STDERR);
    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&quit;
    $SIG{PIPE} = 'IGNORE';
}
serve();

# SMTP server.
#
{
    my $server;
    my $socket;

    # Start the server.
    #
    sub serve {
        message('Starting fakemail');
        $server = new IO::Socket::INET(Listen => 1,
                                       Proto => 'tcp',
                                       Reuse => 1,
                                       LocalPort => $port,
                                       LocalHost => $host);
        if (! $server) {
            message("Cannot start fakemail: $!");
            quit();
        }
        message("Listening on port $port");
        while ($socket = $server->accept()) {
            message('Starting request');
            my $smtp = new Net::Server::Mail::SMTP(socket => $socket);
            $smtp->set_callback(RCPT => \&validate_recipient);
            $smtp->set_callback(DATA => \&queue_message);
            $smtp->process();
            close_socket($socket);
            $socket = undef;
            message('Request done');
        }
        message("Cannot accept requests");
        quit();
    }

    # Event handlers.
    #
    sub validate_recipient {
        my($session, $recipient) = @_;
        return (1);
    }

    sub queue_message {
        my ($session, $data) = @_;

        message("Incoming mail");
        my $sender = $session->get_sender();
        my @recipients = $session->get_recipients();
        foreach my $recipient (@recipients) {
            message("Capturing mail to $recipient");
            open(FILE, "> " . get_filename_from_recipient($recipient));
            print FILE ${$data};
            close(FILE);
            message("Mail to $recipient saved");
        }
        message("Incoming mail dispatched");
        return (1, 250, "message queued");
    }

    sub quit {
        $SIG{INT} = $SIG{TERM} = $SIG{HUP} = 'IGNORE';
        message('Stopping fakemail');
        if (defined($socket)) {
            close_socket($socket);
        }
        if ($server) {
            close_socket($server);
        }
        message('fakemail stopped');
        exit;
    }

    sub close_socket {
        my $socket = shift;
        my $ret;

        $ret = $socket->flush();
        $ret = $socket->shutdown(2);
        $ret = $socket->close();
    }
}

# Helpers
#
{
    my %counts = ();

    sub get_filename_from_recipient {
        my $recipient = shift;

        $recipient =~ s/<|>//g;
        if (! defined($counts{$recipient})) {
            $counts{$recipient} = 1;
        }
        return "$path/$recipient." . $counts{$recipient}++;
    }
}

sub message {
    my $message = shift;

    if ($log) {
        open(FILE, ">> $log.$$");
        print FILE localtime() . ": $message\n";
        close(FILE);
    } else {
        print "$message\n";
    }
}
