<update>

It's really straight forward...

#!/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;
}
[download]

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}

That was much more than I was looking for, but I thank you for your help. I was just planning to implement a wrapper for sendmail. This looks much more involved, but also much more powerful.

Thanks for the example code.

• -fsender sets the envelope sender, and the header From if it's otherwise unset.
• -Fsender-name sets the name in the header From, if it's otherwise unset
• -t says to get the envelope sender and recipients by parsing the message headers.
• -bp says to print the queue
• -bs says to provide SMTP on stdin/stdout
• other flags are ignored
• other non-flag arguments are envelope recipients.

Update: Fixed formatting.

Intriguing.

I'm not immediately aware of any sendmail lookalike's in perl, but there should be one I think. Are you aware of a list of switches the sendmail binary is expected to handle? My hunch is that you could build a sendmail look-alike with some effort. It probably isn't even that hard.

And most likely you could add additional features (like mime attachments) using all the really slick perl modules out there for this sort of thing (e.g., Net::SMTP, MIME::Lite, etc).

I suspect that the easiest option wouldn't be to reimplement sendmail, but to write a wrapper round sendmail which does all of the scheduling and then hands the actual mail processing off to the original sendmail program.

--
<http://dave.org.uk>

"The first rule of Perl club is you do not talk about Perl club."
-- Chip Salzenberg

Yes, that would be easier by a longshot. I was daydreaming about a replacement so you can use perl as an MTA without having to have sendmail/qmail/msmtp/ssmtp installed, but I suppose it wouldn't pay to make another MTA...

-Paul

I'm almost attracted enough to the problem to make one. The users of my app have the same problem (usually) of having a limit of how many email messages can go out at a specific amount of time.

I could build this queueing system into my current app, but that would make the current app even more complex (safe to say, *its complex*) and having it completely separate would make it much more useful for other people.

We'll see :) If a backer of the project comes up... :)

 

-justin simoni
skazat me

I know how to do all the counting and resetting stuff. Does anyone know how to make the script look like a sendmail like program as far as PHP’s mail functions are concerned?

Ah, I see, you're basically asking how to make the interface to your queuing system, which is basically:

* Keep a count of how many messages go out in x amount of time,

* Queue up messages that can't go out after the limit has been reached

* Reset counter after x amount

* Send awaiting messages,

* etc,

I've always used Getopt::Long for command line interfaces. To emulate what you'd give to sendmail, you'd do something like:

#!/usr/bin/perl 

use Getopt::Long; 


my $sendmail = '/usr/sbin/sendmail'; 


my $f_flag = undef; 
my $t_flag = undef; 
my $i_flag = undef; 
my $o_flag = undef; 


GetOptions("f=s"       => \$f_flag, 
           "t"         => \$t_flag, 
           "i"         => \$i_flag, 
           "o"         => \$o_flag, 
        );         

# Skipping the queue/count stuff for laziness...

my $sendmail_w_flags = $sendmail; 

if($f_flag){ 

    $sendmail_w_flags .= ' -f'.$f_flag;
}

if($t_flag){ 

    $sendmail_w_flags .= ' -t';;
}

if($i_flag){ 

    $sendmail_w_flags .= ' -i';;
}

if($o_flag){ 

    $sendmail_w_flags .= ' -o';;
}




my $message = <STDIN>; 

open(MAIL, '|' . $sendmail_w_flags) or die $!; 
print MAIL $message or die $!;
close MAIL or die $!;
[download]