Hello;
I am programming using the following module created for Qmail to
perform massmailings. I am having problems with the donefunc
callback routing which is mreport() in my perl program.
Here is the perl module and following that is my perl program:
#!/usr/bin/perl
# -*- perl -*-
# $Header: /home/johnl/hack/jmail/RCS/Qspam.pm,v 1.2 2001/05/18 16:35:02
johnl E
xp $
#
# qspam_start(N, donefunc) - max number of concurrent deliveries,
# callback when delivery done
#
# callback is donefunc(mfile, code, resultflag, resultmsg)
# mfile, and code from qspam_send
# resultflag is "y" for delivered, "n" for rejected, "" for queued
# resultmsg is from SMTP session
#
# qspam_send(to, from, mfile [, code]) - send mfile, using to and from as
# envelope addresses, optional code to identify message
#
# qspam_flush() - flush uncompleted messages
#
#
package Qspam;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(qspam_start qspam_send qspam_flush);
use strict;
my $codecounter;
my $debug;
my %dels;
my ($maxdels, $donefunc);
my $activedels;
sub qspam_start {
$maxdels = shift || 20;
$donefunc = shift;
$debug = shift;
$codecounter = $activedels = 0;
%dels = ();
}
sub qspam_send {
my ($to, $from, $mfile, $code) = @_;
my $pid;
my ($tohost) = ($to =~ /.*\@(.*)/);
$code = ++$codecounter unless $code;
$pid = fork();
die "Fork $code failed" unless defined $pid;
if($pid == 0) {
open(STDIN, $mfile) or die "Cannot reopen $mfile";
open(STDOUT, ">/tmp/qspam/qspam-$code") or die "Cannot create
qspam-$cod
e";
exec "/var/qmail/bin/qmail-remote", $tohost, $from, $to;
die "Cannot run qmail-remote";
}
$dels{$pid} = [ 'r', $to, $from, $mfile, $code ];
$activedels++;
downto($maxdels);
}
sub qspam_flush {
downto(0);
}
sub downto {
my ($max) = @_;
while($activedels > $max) {
my $pid = wait();
my ($type, $to, $from, $mfile, $code);
if($pid < 0) {
print "?? wait with no pids\n";
return;
}
my $del = $dels{$pid};
if(!defined $del) {
print "?? mystery pid $pid\n";
next;
}
delete $dels{$pid};
($type, $to, $from, $mfile, $code) = @$del;
if($type eq 'r') {
my ($rbuf, $acode, $arpt, $rcode, $rrpt);
# check qmail-remote status, do queue if needed
open(RPT, "/tmp/qspam/qspam-$code") or die "Cannot open
qspam-$code"
;
sysread RPT,$rbuf,1000;
close RPT;
while($rbuf =~ m/(.)([^\000]*)\000/sg) {
$acode = $1; $arpt = $2;
if($acode =~ m{[a-z]}) { # recipient code
$rcode = $acode;
$rrpt = $arpt;
next;
}
if($rcode eq "r" and $acode eq "K") { # it worked
$donefunc and &$donefunc($mfile, $code, "y", $arpt);
unlink "/tmp/qspam/qspam-$code";
$activedels--;
} elsif($rcode eq "h" or $acode eq "D") { # it failed
$donefunc and &$donefunc($mfile, $code, "n",
"$rrpt/$arpt");
unlink "/tmp/qspam/qspam-$code";
$activedels--;
} else { # didn't work, queue it
print "Queue $to $code $arpt\n" if $debug;
open(CTL, ">/tmp/qspam/qspam-$code")
or die "Cannot recreate qspam-$code";
print CTL "F$from\0T$to\0\0";
close CTL;
my $pid = fork();
die "Fork $code failed" unless defined $pid;
if($pid == 0) {
open(STDIN, $mfile) or die "Cannot reopen $mfile";
close(STDOUT);
open(IN2, "/tmp/qspam/qspam-$code")
or die "Cannot reopen qspam-$code";
die "wrong fd " . fileno(IN2) if fileno(IN2) != 1;
exec "/var/qmail/bin/qmail-queue";
die "Cannot run qmail-queue";
}
$dels{$pid} = [ 'q', $to, $from, $mfile, $code ];
}
last;
}
} elsif($type eq 'q') { # clean up after queueing
print "Queue fail $? for $code\n" if $?;
$donefunc and &$donefunc($mfile, $code, "", undef);
unlink "/tmp/qspam/qspam-$code";
$activedels--;
} else {
die "strange type $type";
}
}
}
1;
I have written this perl program to run:
#!/usr/bin/perl
#
# list Perl Modules
use Qspam qw(qspam_start qspam_send qspam_flush);
# list Perl Subroutines
use subs qw(mreport);
# Set environmental variables
$ENV{QMAILSHOST} = "smtp-out.load.com";
$ENV{QMAILHOST} = "smtp-out.load.com";
$ENV{MAILHOST} = "smtp-out.load.com";
$qspam_root = "/tmp/qspam";
if ( ! -d $qspam_root ) {
mkdir "$qspam_root", 0755;
}
$mmd_root = "/tmp/massmail";
$mmd_prep = "$mmd_root/$ARGV[0]";
$msg_text = "$mmd_prep/msg_text";
if ( ! -d $mmd_root ) {
mkdir "$mmd_root", 0755;
if ( ! -d $mmd_prep ) {
mkdir "$mmd_prep", 0755;
}
}
$running = "/var/run/massmail-$ARGV[0].active";
if ( ! -e $running ) {
open RUNNING, ">$running";
close RUNNING;
}
qspam_start($ARGV[1],mreport);
$mmd_drop = "/var/spool/massmail/drop$ARGV[0]";
while ( -e $running ) {
opendir MMD_DROP, $mmd_drop;
@emlfiles = grep !/^\.\.?$/, readdir MMD_DROP;
close MMD_DROP;
# Sleep for 2 seconds for all messages listed to finish being written.
select undef, undef, undef, 2.00;
$num_eml = @emlfiles;
if ( "$num_eml" > 0 ) {
for ($i = 0; $i < $num_eml; $i++) {
$emlfile = "$mmd_drop/$emlfiles[$i]";
$msg_name = "$msg_text-$emlfiles[$i]";
open EMLFILE, $emlfile;
open MSG_TEXT, ">$msg_name";
$skip_check = 0;
$to_counter = 0;
while ( $line = <EMLFILE> ) {
$line =~ s/\r$//g;
if ( "$skip_check" == 1 ) {
print MSG_TEXT "$line";
}
else {
($column1, $column2) = split(" ", $line);
if ( grep /X-Receiver:/i, $column1 ) {
$to[$to_counter++] = "$column2";
}
elsif ( grep /X-Sender:/i, $column1 ) {
$from = "$column2";
$skip_check = "1";
}
else {
print MSG_TEXT "$line";
}
}
}
close MSG_TEXT;
close EMLFILE;
for ( $j = 0; $j < $to_counter; $j++ ) {
$msg_code = "$ARGV[0].$num_eml.$j";
qspam_send( $to[$j], $from, $msg_name, $msg_code );
}
unlink $emlfile;
}
}
qspam_flush();
}
exit 0;
sub mreport {
$mailfile = shift;
$mcode = shift;
$mresult = shift;
$mstat = shift;
$frpt = "/var/spool/massmail/failure.txt";
if ( "$mresult" eq "n" ) {
if ( ! -f $frpt ) {
open FRPT, ">$frpt";
close FRPT;
chown 139, 139, $frpt;
}
open FRPT, ">>$frpt";
print FRPT "Message $mailfile FAILED\r\n";
close FRPT;
}
else {
unlink $mailfile;
}
}
My problem is that the subroutine mreport is not getting the variables
passed
back to it from Qspam.pm.
I can not figure out why. Could someone help me? Thanks.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
