404 lines
9.8 KiB
Perl
Executable File
404 lines
9.8 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
|
|
use strict;
|
|
use Fcntl;
|
|
use Digest::MD5;
|
|
use IO::Handle;
|
|
use IPC::Open3;
|
|
use Time::Local;
|
|
use File::Sync qw(fsync sync);
|
|
use lib ".";
|
|
use GpgEzmlm;
|
|
|
|
my $configfile = "config";
|
|
my %config = ();
|
|
|
|
$ENV{PATH} = "/bin:/usr/bin";
|
|
$ENV{ENV} = "";
|
|
|
|
#cookie generates a hash given a timestamp, a secret, etc. This infomation
|
|
#is used to generate and check confirmation strings. This is _not_ the
|
|
#same hash algorithm used by ezmlm, but since the strings are ephemeral,
|
|
#so long as I'm self consistent, it shouldn't matter.
|
|
#type is either "s" for subscribe or "u" for unsubscribe
|
|
#target is email addr
|
|
|
|
sub cookie {
|
|
my %charhash = ( 'a'=>'a', 'b'=>'b', 'c'=>'c', 'd'=>'d', 'e'=>'e', 'f'=>'f',
|
|
'0'=>'g', '1'=>'h', '2'=>'i', '3'=>'j', '4'=>'k', '5'=>'l',
|
|
'6'=>'m', '7'=>'n', '8'=>'o', '9'=>'p' );
|
|
my $key = shift;
|
|
my $time = shift;
|
|
my $target = shift;
|
|
my $type = shift;
|
|
my $cookie;
|
|
|
|
my $context = Digest::MD5->new;
|
|
$context->add($key);
|
|
$context->add($time);
|
|
$context->add($target);
|
|
$context->add($type);
|
|
|
|
my $digest = $context->hexdigest;
|
|
|
|
my @characters = split //, $digest;
|
|
for my $i (0..19) {
|
|
$cookie .= $charhash{($characters[$i])};
|
|
}
|
|
$cookie;
|
|
}
|
|
|
|
#maillog writes events to the log file.
|
|
|
|
sub maillog {
|
|
my $event = shift;
|
|
my $addr = shift;
|
|
|
|
open FD, ">>Log" or return;
|
|
print FD time();
|
|
print FD " $event $addr\n";
|
|
close FD;
|
|
}
|
|
|
|
#hashok checks to see if the time given is within 1000000 seconds of now,
|
|
#and if indeed the hash given is valid. ezmlm keeps no state on
|
|
#(un)subscription confirmations. the assumption is, if you can provide a
|
|
#valid hash with a valid timestamp, I must have sent that hash to you,
|
|
#because I need the secret key to produce the hash.
|
|
|
|
sub hashok {
|
|
my $action = shift;
|
|
my $key = shift;
|
|
my $target = shift;
|
|
|
|
my $x = $action;
|
|
$x =~ s/^-(\w)\w\.//;
|
|
my $type = $1;
|
|
$x =~ /^(\d+)/;
|
|
my $u = $1;
|
|
if (($u > time) or ($u < time - 1000000)) {
|
|
return 0;
|
|
}
|
|
|
|
my $cookie = cookie($key, $u, $target, $type);
|
|
|
|
if ($x =~ /$cookie/) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
# A comment about the below. gpgimport is a bit of a kludgey hack. The basic
|
|
# premise is we want to avoid the attack wherein someone subscribes to the
|
|
# list as <foo@bar.com> but provides a key for <tmacd@synacklabs.net>,
|
|
# hypothetically. The Right Way would be to read the key directly, I
|
|
# suppose, but I'll be damned if I implement a key decoder for this.
|
|
#
|
|
# So I filter by sending the keys off to key purgatory, also known as
|
|
# a tmp dir. I then extract only the known acknowledged addr from
|
|
# purgatory, and hopefully we're good to go.
|
|
#
|
|
# Someone feel free to rewrite this to read the key directly. ^_^
|
|
|
|
sub gpgimport {
|
|
my $gpgkey = shift;
|
|
my $addr = shift;
|
|
my $configRef = shift;
|
|
my $error;
|
|
my $empty = "";
|
|
|
|
my $tmpgpg = "$$configRef{gpg} --homedir $$configRef{tempDir}";
|
|
my $gpg = "$$configRef{gpg} --homedir $$configRef{keyDir}";
|
|
|
|
unlink ("$$configRef{tempDir}/pubring.gpg");
|
|
my $cleansedkey;
|
|
my $pid = runcmd("$tmpgpg --no-tty --import",
|
|
\$gpgkey,
|
|
\$empty,
|
|
\$error);
|
|
waitpid $pid, 0;
|
|
|
|
$pid = runcmd("$tmpgpg --no-tty --export -a $addr\n",
|
|
\$empty,
|
|
\$cleansedkey,
|
|
\$error);
|
|
|
|
$pid = runcmd("$gpg --no-tty --import",
|
|
\$cleansedkey,
|
|
\$empty,
|
|
\$error);
|
|
}
|
|
|
|
#begin program proper here.
|
|
|
|
my $sender;
|
|
my $taintsender;
|
|
my $host;
|
|
my $tainthost;
|
|
my $local;
|
|
my $taintlocal;
|
|
my $key;
|
|
my $action;
|
|
|
|
my $mailinglist;
|
|
my $inhost;
|
|
my $inlocal;
|
|
my $outhost;
|
|
my $outlocal;
|
|
my $when = time;
|
|
|
|
|
|
if ($ENV{SENDER}) {
|
|
$taintsender = $ENV{SENDER};
|
|
} else {
|
|
mydie(100, "SENDER not set\n");
|
|
}
|
|
if ($ENV{LOCAL}) {
|
|
$taintlocal = $ENV{LOCAL};
|
|
} else {
|
|
mydie(100,"LOCAL not set\n");
|
|
}
|
|
if ($ENV{HOST}) {
|
|
$tainthost = $ENV{HOST};
|
|
} else {
|
|
mydie(100,"HOST not set\n");
|
|
}
|
|
|
|
if((!($taintsender=~/\S+/)) || ($taintsender =~ /\#\@\[\]/)) {
|
|
mydie(100,"I don't reply to bounce messages (#5.7.2)\n");
|
|
}
|
|
if(!($taintsender=~/\@/)) {
|
|
mydie(100,"I don't reply to senders without host names (#5.7.2)\n");
|
|
}
|
|
|
|
# The following may be overly restrictive. Please let me know what I
|
|
# need to add
|
|
|
|
if ($taintsender =~ /([a-zA-Z0-9\@\+\.\-\_]*)/) {
|
|
$sender = $1;
|
|
}
|
|
|
|
if ($tainthost =~ /([a-zA-Z0-9\@\+\.\-\_]*)/) {
|
|
$host = $1;
|
|
}
|
|
|
|
if ($taintlocal =~ /([a-zA-Z0-9\@\+\.\-\_]*)/) {
|
|
$local = $1;
|
|
}
|
|
|
|
|
|
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");
|
|
|
|
readConfig("$configfile", \%config);
|
|
|
|
if (!(-f "key")) {
|
|
mydie(100, "$dir/key does not exist\n");
|
|
}
|
|
|
|
open KEY, "<key" or mydie(111, "unable to read $dir/key: $!\n");
|
|
$key = <KEY>;
|
|
close(KEY);
|
|
|
|
open MAILINGLIST, "<mailinglist" or mydie(111, "unable to open $dir/mailinglist: $!\n");
|
|
$mailinglist = <MAILINGLIST>;
|
|
chomp $mailinglist;
|
|
close(MAILINGLIST);
|
|
open INHOST, "<inhost" or mydie(111, "unable to open $dir/inhost: $!\n");
|
|
$inhost = <INHOST>;
|
|
chomp $inhost;
|
|
close(INHOST);
|
|
open INLOCAL, "<inlocal" or mydie(111, "unable to open $dir/inlocal: $!\n");
|
|
$inlocal = <INLOCAL>;
|
|
chomp $inlocal;
|
|
close(INLOCAL);
|
|
open OUTHOST, "<outhost" or mydie(111, "unable to open $dir/outhost: $!\n");
|
|
$outhost = <OUTHOST>;
|
|
chomp $outhost;
|
|
close(OUTHOST);
|
|
open OUTLOCAL, "<outlocal" or mydie(111, "unable to open $dir/outlocal: $!\n");
|
|
$outlocal = <OUTLOCAL>;
|
|
chomp $outlocal;
|
|
close(OUTLOCAL);
|
|
|
|
if (!($inhost eq $host)) {
|
|
mydie(100,"I do not accept messages at this address (#5.1.1)\n");
|
|
}
|
|
if(!($local =~ /$inlocal/)) {
|
|
mydie(100,"I do not accept messages at this address (#5.1.1)\n");
|
|
}
|
|
|
|
$action = $local;
|
|
$action =~ s/$inlocal//;
|
|
|
|
my $line;
|
|
if (!(-f "public")) {
|
|
mydie(100, "sorry, I've been told to reject all requests (#5.7.2)\n");
|
|
}
|
|
|
|
if(!(-f "public")) {
|
|
mydie(100, "sorry, I've been told to reject all requests (#5.7.2)\n");
|
|
}
|
|
open PUBLIC, "<public" or mydie(111,"unable to read $dir/public: $!\n");
|
|
close (PUBLIC);
|
|
|
|
my $target = $sender;
|
|
|
|
my $message;
|
|
|
|
if ($action =~ /^-get\.(\d+)/) {
|
|
use integer;
|
|
my $startmsgnum = $1;
|
|
my $endmsgnum = $1;
|
|
if ($action =~ /^-get\.\d+-(\d+)/) {
|
|
$endmsgnum = $1;
|
|
}
|
|
for(my $i = int($startmsgnum); $i <= int($endmsgnum); $i++) {
|
|
my $archived = $i;
|
|
my @archivedMessage = ();
|
|
my $dirnum = $i/100;
|
|
my $msgnum;
|
|
if(($i%100) < 10) {
|
|
$msgnum = "0".($i%100);
|
|
} else {
|
|
$msgnum = $i%100;
|
|
}
|
|
if(open MESSAGE, "<archive/$dirnum/$msgnum") {
|
|
while(defined(my $line = <MESSAGE>)) {
|
|
push @archivedMessage, $line;
|
|
}
|
|
$message = prepare(\@archivedMessage, \%config, $archived, $sender);
|
|
mail("$config{qmailDir}/qmail-queue", $message,
|
|
"$outlocal-help\@$outhost", $sender);
|
|
} else {
|
|
mydie(100, "Requested archive message $i does not exist\n");
|
|
}
|
|
}
|
|
exit();
|
|
}
|
|
|
|
$message .= "Mailing-List: $mailinglist\n";
|
|
|
|
my $rfc822date = rfc822date();
|
|
|
|
$message .= "Date: $rfc822date\n";
|
|
$message .= "Message-ID: <$when.$$.ezmlm\@$outhost>\n";
|
|
$message .= "From: $outlocal-help\@$outhost\n";
|
|
$message .= "To: $target\n";
|
|
|
|
my $flaghashok = 1;
|
|
my $flagconfirm = 0;
|
|
if($action =~ /^-(s)c\./) {
|
|
$flaghashok = hashok($action, $key, $target);
|
|
}
|
|
if($action =~ /^-(u)c\./) {
|
|
$flaghashok = hashok($action, $key, $target);
|
|
}
|
|
if($action =~ /^-(s)ubscribe$/) {
|
|
$flagconfirm = 1;
|
|
}
|
|
if($action =~ /^-(u)nsubscribe$/) {
|
|
$flagconfirm = 1;
|
|
}
|
|
if (!($flaghashok)) { $flagconfirm = 1; }
|
|
|
|
my $confirm;
|
|
|
|
if ($flagconfirm) {
|
|
my $type = $1;
|
|
my $cookie = cookie($key, $when, $target, $type);
|
|
$target =~ /(\S+)\@(\S+)/;
|
|
$confirm .= "$outlocal-$type";
|
|
$confirm .= "c.$when.$cookie-$1";
|
|
$confirm .= "=$2\@$outhost";
|
|
$message .= "Reply-To: $confirm\n";
|
|
}
|
|
|
|
$message .= "Subject: ezmlm response\n";
|
|
my $mydtline = "Delivered-To: responder for $outlocal\@$outhost\n\n";
|
|
$message .= $mydtline;
|
|
|
|
my $flaggoodfield = 0;
|
|
my $gpgkey;
|
|
my $flaginkey = 0;
|
|
my $messagecp;
|
|
|
|
while (<STDIN>) {
|
|
my $line = $_;
|
|
$messagecp .= $line;
|
|
if ($flaginkey) {
|
|
if($line =~ /(^[\w\s\/\+\=\-\:\.\(\)]+)$/) {
|
|
$gpgkey .= $line;
|
|
}
|
|
}
|
|
if (($line =~ /-----BEGIN PGP PUBLIC KEY BLOCK-----/) && (!($flaginkey))) {
|
|
$gpgkey .= $line;
|
|
$flaginkey = 1;
|
|
}
|
|
if ($line =~ /-----END PGP MESSAGE-----/) {
|
|
$flaginkey = 0;
|
|
}
|
|
if(!($line =~ /^\s/)) {
|
|
$flaggoodfield = 0;
|
|
if($line =~ /^mailing-list:/) {
|
|
mydie(100, "incoming message has Mailing-List (#5.7.2)\n");
|
|
}
|
|
if ($line =~ /^$mydtline/) {
|
|
mydie(100, "this message is kinda looping: it already has my Delivered-To line (#5.4.6): $mydtline");
|
|
}
|
|
if (($line =~ /^delivered-to:/) or ($line =~ /^received:/)) {
|
|
$flaggoodfield = 1;
|
|
}
|
|
}
|
|
if($flaggoodfield) {
|
|
$message .= $line;
|
|
}
|
|
}
|
|
copy("text/top", \$message, 0, \%config, $confirm, $target);
|
|
if ($action =~ /^-subscribe$/) {
|
|
copy("text/sub-confirm", \$message, 0, \%config, $confirm, $target);
|
|
} elsif ($action =~ /^-unsubscribe$/) {
|
|
copy("text/unsub-confirm", \$message, 0, \%config, $confirm, $target);
|
|
} elsif ($action =~ /^-sc\./) {
|
|
if($flaghashok) {
|
|
if($config{allowKeySubmission}) {
|
|
gpgimport($gpgkey, $target, \%config);
|
|
}
|
|
if (subscribe($target, 1) > 0) {
|
|
maillog("+",$target);
|
|
copy("text/sub-ok", \$message, 0, \%config, $confirm, $target);
|
|
} else {
|
|
copy("text/sub-nop", \$message, 0, \%config, $confirm, $target);
|
|
}
|
|
} else {
|
|
copy("text/sub-bad", \$message, 0, \%config, $confirm, $target);
|
|
}
|
|
} elsif ($action =~ /^-uc\./) {
|
|
if($flaghashok) {
|
|
if (subscribe($target, 0) > 0) {
|
|
maillog("-", $target);
|
|
copy("text/unsub-ok", \$message, 0, \%config, $confirm, $target);
|
|
} else {
|
|
copy("text/unsub-nop", \$message, 0, \%config, $confirm, $target);
|
|
}
|
|
} else {
|
|
copy("text/unsub-bad", \$message, 0, \%config, $confirm, $target);
|
|
}
|
|
} else {
|
|
copy("text/help", \$message, 0, \%config, $confirm, $target);
|
|
}
|
|
copy("text/bottom", \$message, 0, \%config, $confirm, $target);
|
|
|
|
$message .= "Return-Path: <$sender>\n";
|
|
$message .= $messagecp;
|
|
|
|
mail("$config{qmailDir}/qmail-queue", $message, "$outlocal-return-\@$outhost", "$target");
|