You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
gpg-ezmlm/gpg-ezmlm-manage.pl

403 lines
9.8 KiB

#!/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");