#!/usr/bin/perl -w
use strict;
# $Id: mta.pl,v 0.0 2007/01/19 19:38:39 shmem Exp $
# local delaying MTA
use Carp;
use File::Spec;
use Net::SMTP;
use Net::SMTP::Server;
use Net::SMTP::Server::Client;
my $relay = 'smarthost';
my $port = 25;
my $time = time;
my $spooldir = 'delayed';
my $maxmsgs = 30;
my $timeframe = 3600;
-d $spooldir or mkdir $spooldir,0755 or die "spooldir: $!\n";
my $server = new Net::SMTP::Server('localhost', $port) ||
croak("Unable to handle client connection: $!\n");
my $sentcount = 0;
while(my $conn = $server->accept()) {
# receive mail and spool it.
my $client = new Net::SMTP::Server::Client($conn) ||
croak("Unable to handle client connection: $!\n");
my $file = File::Spec->catfile($spooldir,time);
open O, '>', $file or die "Can't write $file: $!\n";
if ( $client->process ) {
print O $client->{'FROM'}.$/;
print O join('|',@{$client->{'TO'}}).$/;
print O $client->{'MSG'}.$/;
close O or die "Can't close filehandle O: $!\n";
warn "[$file] message queued.\n";
} # else { *shrug*. Client quit. }
# deliver mails.
opendir(D, $spooldir) or die "Can't read '$spooldir': $!\n";
my @files = grep (!/^\.\.?/,readdir D);
foreach my $file (@files) {
# reset $sentcount if timeframe passed
if (time - $time >= $timeframe) {
$sentcount = 0;
$time = time;
warn "timer reset.\n";
}
if ($sentcount == $maxmsgs) {
warn "Delivery delayed, reached $maxmsgs in $timeframe sec
+s.\n";
last;
}
my $mailfile = File::Spec->catfile ($spooldir,$file);
open MAIL, '<', $mailfile
or die "Can't read '$mailfile': $!\n";
chomp(my $FROM = <MAIL>);
chomp(my $TO = <MAIL>);
my $MSG = do { local $/; <MAIL> };
$TO = [split /\|/, $TO];
my $sent = relay ($FROM, $TO, $MSG);
if ($sent) {
$sentcount++;
unlink $mailfile or die "Can't unlink '$mailfile': $!\n";
warn "[$file]: (#$sentcount) sent\n";
} else {
warn "[$file]: delivery failed \n";
}
}
}
sub relay {
my ($FROM, $TO, $MSG) = @_;
my $smtp = new Net::SMTP($relay);
$smtp -> mail ($FROM) or return;
$smtp -> to (@{$TO}) or return;
$smtp -> data ($MSG) or return;
$smtp -> quit or return;
}
Eliminating the flaw that mails are only sent after receiving one
is left as an excercise to the reader ;-)
</update>
--shmem
_($_=" "x(1<<5)."?\n".q·/)Oo. G°\ /
/\_¯/(q /
---------------------------- \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
|