128 lines
2.9 KiB
Perl
Executable file
128 lines
2.9 KiB
Perl
Executable file
#!/usr/bin/perl -wT
|
|
|
|
use strict;
|
|
use IPC::Open3;
|
|
use lib ".";
|
|
use GpgEzmlm;
|
|
|
|
my $configfile = "config";
|
|
my %config = ();
|
|
$ENV{PATH} = "/bin:/usr/bin";
|
|
$ENV{ENV} = "";
|
|
|
|
my @messageArray;
|
|
|
|
#numwrite writes the current number of the message for use in the mailing
|
|
#list archive.
|
|
|
|
sub numwrite {
|
|
my $num = shift;
|
|
|
|
open NUMNEW, ">numnew" or mydie (111,"unable to create numnew: $!\n");
|
|
print NUMNEW "$num\n";
|
|
close NUMNEW;
|
|
rename "numnew", "num" or mydie (111, "unable to move numnew to num: $!\n");
|
|
}
|
|
|
|
my $num;
|
|
|
|
#start main program here
|
|
|
|
my $dir;
|
|
my $taintdir = shift;
|
|
if ($taintdir =~ /(\S+)/) {
|
|
$dir = $1;
|
|
} else {
|
|
mydie(100,"$0: usage: $0 dir\n");
|
|
}
|
|
chdir "$dir" or mydie(111,"unable to switch to $dir: $!\n");
|
|
|
|
my $LOCK_EX = 2;
|
|
open LOCK, ">lock" or mydie(111,"unable to open $dir/lock: $!\n");
|
|
flock LOCK, $LOCK_EX or mydie(111,"unable to obtain $dir/lock: $!\n");
|
|
|
|
readConfig("$configfile", \%config);
|
|
|
|
if($config{requireSub}) {
|
|
my $taintsender;
|
|
if ($ENV{SENDER}) {
|
|
$taintsender = $ENV{SENDER};
|
|
} else {
|
|
mydie(100, "SENDER not set\n");
|
|
}
|
|
if($taintsender =~ /([a-zA-Z\0-9\@\.\-\_]+)/) {
|
|
my $sender = $1;
|
|
if(!(issub($sender))) {
|
|
mydie(100, "Only subscribers to the list may post to it\n");
|
|
}
|
|
} else {
|
|
mydie(100, "bad SENDER\n");
|
|
}
|
|
}
|
|
|
|
open NUM, "<num" or mydie(111, "unable to open $dir/num: $!\n");
|
|
my $taintnum = <NUM>;
|
|
if($taintnum =~ /(\d+)/) {
|
|
$num = $1;
|
|
}
|
|
close(NUM);
|
|
$num++;
|
|
|
|
if($config{archived}) {
|
|
use integer;
|
|
my $dirnum = $num/100;
|
|
if(!(-d "archive/$dirnum")) {
|
|
mkdir "archive/$dirnum", 0755 or
|
|
mydie(111, "unable to create archive directory\n");
|
|
}
|
|
my $msgnum;
|
|
if(($num%100) < 10) {
|
|
$msgnum = "0".($num%100);
|
|
} else {
|
|
$msgnum = $num%100;
|
|
}
|
|
open(ARCHIVE, ">archive/$dirnum/$msgnum") or
|
|
mydie(111, "unable to write archive/$dirnum/$msgnum: $!\n");
|
|
}
|
|
|
|
while (my $line = <>) {
|
|
push @messageArray, $line;
|
|
}
|
|
|
|
my $fromstring = "$config{outlocal}-return-$num-\@$config{outhost}-\@\[\]";
|
|
|
|
my @sublist = ();
|
|
opendir(SUBSCRIBERS, "subscribers") or mydie(111,"unable to read subscribers: $!\n");
|
|
while (defined(my $subsub = readdir(SUBSCRIBERS))) {
|
|
my $subfile = sprintf "subscribers/$subsub";
|
|
open(SUBL, $subfile) || mydie(111, "unable to read $subfile: $!\n");
|
|
if(defined(my $substring = <SUBL>)) {
|
|
foreach my $subscriber (split /\0/, $substring) {
|
|
if ($subscriber =~ /T([a-zA-Z\0-9\@\.\-\_]+)/) {
|
|
push @sublist, $1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close(SUBSCRIBERS);
|
|
|
|
my $archived = 0;
|
|
|
|
if($config{encryptToAll}) {
|
|
my $mail = prepare(\@messageArray, \%config, $archived, @sublist);
|
|
mail("$config{qmailDir}/qmail-queue", $mail, "$fromstring", @sublist);
|
|
} else {
|
|
foreach my $separatesubscriber (@sublist) {
|
|
my $mail = prepare(\@messageArray, \%config, $archived, $separatesubscriber);
|
|
mail("$config{qmailDir}/qmail-queue", $mail, "$fromstring", $separatesubscriber);
|
|
}
|
|
}
|
|
|
|
if($config{archived}) {
|
|
print ARCHIVE @messageArray;
|
|
close(ARCHIVE);
|
|
}
|
|
|
|
numwrite($num);
|
|
|