SMTP Listener that writes everything in a Maildir

smtpToMaildir.pl

#!/usr/bin/perl -w
#
# smtpToMaildir.pl (C) 2009 Yrjö Kari-Koskinen <[email protected]>
#
# This program is licensed under Version 2 of the GPL.

# The perl package dependencies can be satisfied with the following
# Debian/Ubuntu packages: libmail-box-perl libnet-smtp-server-perl

use strict;

use Getopt::Std;

use Net::SMTP::Server;
use Net::SMTP::Server::Client;

use Mail::Message;
use Mail::Box::Maildir;

my $usage = "Usage: $0 -h listenHost -p listenPort -d maildir\n";

use vars qw($opt_p $opt_d $opt_h);
getopts('p:d:h:') ||
  die($usage);

if (!$opt_p || !$opt_d || !$opt_h) {
    die($usage);
}

my $server = new Net::SMTP::Server($opt_h, $opt_p) ||
  die("Unable to handle client connection: $!\n");

my $folder = Mail::Box::Maildir->new(folder => $opt_d, access => 'rw') || 
  die("Unable to open Maildir $opt_d.\n");


my $msgNum = 1;
while(my $conn = $server->accept()) {
    
    # Handle the client's connection and spawn off a new parser.
    # This can/should be a fork() or a new thread,
    # but for simplicity...
    my $client = new Net::SMTP::Server::Client($conn) ||
      die("Unable to handle client connection: $!\n");
    
    # Process the client.  This command will block until
    # the connecting client completes the SMTP transaction.
    $client->process || next;

    saveRawMessage($client->{MSG});

    print(($msgNum++).": Saved message from ".$client->{FROM}."\n");
}


sub saveRawMessage {
    my $data = shift;

    my $message = Mail::Message->read($data) ||
      print("Unable to build message.\n") && return;
    
    $folder->addMessage($message) ||
      print("Unable to add message.\n") && return;
    
    $folder->write() ||
      print("Unable to write in Maildir $opt_d.\n") && return;
}