init
This commit is contained in:
phil
commit
cee24fcd46
11 changed files with 1516 additions and 0 deletions
25
Changes
Normal file
25
Changes
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
Revision history for Perl extension gpg-ezmlm.
|
||||
|
||||
0.1 May 29, 2002
|
||||
- original release, alpha.
|
||||
|
||||
0.2 Jun 09, 2002
|
||||
- Multiple bugfixes, first real stable release.
|
||||
|
||||
0.2.1 August 28, 2002
|
||||
- Tightened up regular expressions in gpg-ezmlm-send, added
|
||||
explicit read notation to file opens, and improved comments
|
||||
substantially.
|
||||
|
||||
0.3 October 7, 2002
|
||||
- Major rewrite. Combined common functions in gpg-ezmlm.pm,
|
||||
Switch configuration to config file, Added gpg-ezmlm-convert.pl,
|
||||
Added Makefile, and Makefile support stuff, added archiving
|
||||
capability and signature checking. Fixed a bug that caused
|
||||
gpg-ezmlm-send.pl to hang when attempting to pass large
|
||||
files through gpg.
|
||||
|
||||
0.3.1 April 17, 2004
|
||||
- Fixed a bug in runcmd that caused the gpg-ezmlm to sometimes
|
||||
truncate some of the data sent in large messages. Cleaned
|
||||
the manifest.
|
||||
688
GpgEzmlm.pm
Normal file
688
GpgEzmlm.pm
Normal file
|
|
@ -0,0 +1,688 @@
|
|||
package GpgEzmlm;
|
||||
|
||||
use strict;
|
||||
use Fcntl;
|
||||
use File::Sync qw(fsync sync);
|
||||
use Time::Local;
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
use IPC::Open3;
|
||||
use IO::Select;
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
@EXPORT = qw(
|
||||
mydie
|
||||
mail
|
||||
runcmd
|
||||
readConfig
|
||||
hashaddr
|
||||
issub
|
||||
rfc822date
|
||||
subscribe
|
||||
prepare
|
||||
reject
|
||||
);
|
||||
|
||||
$VERSION = '0.3.1';
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GpgEzmlm - Internal functions for the gpg-ezmlm mailing list suite
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use GpgEzmlm;
|
||||
|
||||
Actually, don't. This is an internal API only, not really intended
|
||||
for use by non-gpg-ezmlm programs.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl module containing common code for the gpg-ezmlm
|
||||
mailing list suite of scripts
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
mydie - Acts like die, but the first argument sets the exit code.
|
||||
mail - Used to inject mail to qmail-queue
|
||||
runcmd - Runs a command, and stuffs input to it, puts output and err in
|
||||
scalars. Uses select() to make sure everything moves smoothly
|
||||
readConfig - Reads options from config file
|
||||
hashaddr - Hashes an email addr into one character. Used to determine which
|
||||
subscriber file a subscriber is/would be in.
|
||||
issub - Determines if a given email addr is currently subscribed or not.
|
||||
rfc822date - Returns the date in RFC 822 format
|
||||
subscribe - Subscribes an email addr to the list
|
||||
prepare - Decrypts and encrypts messages to the list.
|
||||
reject - Sends a rejection email to the sender, explaining the reason
|
||||
for rejection.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Todd MacDermid <tmacd@synacklabs.net>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<perl>.
|
||||
|
||||
=cut
|
||||
|
||||
#mydie - Just a simple wrapper that I use instead of die(), because
|
||||
#qmail pays attention to exit values of the script, and this gives
|
||||
#me control over that
|
||||
|
||||
sub mydie {
|
||||
my $error = shift;
|
||||
my $string = shift;
|
||||
print $string;
|
||||
exit $error;
|
||||
}
|
||||
|
||||
#readConfig - opens the config file, sets a few default values, and
|
||||
#sets flags and values in a hash that controls behavior of the program.
|
||||
#definitions of values below:
|
||||
#
|
||||
#keyDir - Where are the keyrings stored?
|
||||
#tempDir - Where the temporary purgatory keyring is stored
|
||||
#signMessages - Should the ML sign messages
|
||||
#requireSigs - Do we require content to be signed - NOT YET IMPLEMENTED
|
||||
#allowKeySubmission - Do we allow users to submit keys through the mgmt
|
||||
# interface
|
||||
#stripMime - Should we strip out pgp-encrypted MIME headers? - NOT YET IMPLEMENTED
|
||||
#encapsulateMime - Should we add in pgp-encrypted MIME headers? - NOT YET IMPLEMENTED
|
||||
#allowAttach - Whether to allow only inline, or allow attachments as well. - NOT YET IMPLEMENTED
|
||||
#nokeyNocrypt - Forward messaged unencrypted if no key?
|
||||
#verifiedKeyReq - Require keys to be verified?
|
||||
#encryptToAll - Encrypt once, to all keys on list
|
||||
#requireSub - Only allow subscribers to a list to post to it.
|
||||
#subList - Are we a sublist? Not set here for ezmlm compat reasons.
|
||||
#archived - Whether we'll archive messages. Set outside of the main config file
|
||||
# for ezmlm compatibility
|
||||
#outhost - The domain hosting the mailing list. Set outside of the main
|
||||
# config file for ezmlm compatibility
|
||||
#outlocal - The name of the mailing list, e.g. crypt-ml. Set outside of the
|
||||
# main config file for ezmlm compatibility
|
||||
#sublist - If it exists, this is the main list that we are a sublist for.
|
||||
# Set outside of the main config file for ezmlm compatibility
|
||||
#allowUnencrypted - Whether to forward unencrypted content. - NOT YET IMPLEMENTED
|
||||
|
||||
sub readConfig {
|
||||
my $configFile = shift;
|
||||
my $configRef = shift;
|
||||
|
||||
#DEFAULT VALUES
|
||||
$$configRef{keyDir} = ".gnupg";
|
||||
$$configRef{tempDir} = "tmp";
|
||||
$$configRef{gpg} = "/usr/local/bin/gpg";
|
||||
$$configRef{qmailDir} = "/var/qmail/bin";
|
||||
$$configRef{allowUnencrypted} = 1;
|
||||
$$configRef{signMessages} = 1;
|
||||
$$configRef{allowKeySubmission} = 1;
|
||||
#END DEFAULTS
|
||||
|
||||
open OUTHOST, "<outhost" or mydie(111, "unable to open outhost: $!\n");
|
||||
$$configRef{outhost} = <OUTHOST>;
|
||||
chomp $$configRef{outhost};
|
||||
close(OUTHOST);
|
||||
|
||||
open OUTLOCAL, "<outlocal" or mydie(111, "unable to open outlocal: $!\n");
|
||||
$$configRef{outlocal} = <OUTLOCAL>;
|
||||
chomp $$configRef{outlocal};
|
||||
close(OUTLOCAL);
|
||||
|
||||
if(open ARCHIVED, "<archived") {
|
||||
if (defined($$configRef{archived} = <ARCHIVED>)) {
|
||||
chomp $$configRef{archived};
|
||||
}
|
||||
close(ARCHIVED);
|
||||
}
|
||||
|
||||
if(open SUBLIST, "<sublist") {
|
||||
if (defined($$configRef{sublist} = <SUBLIST>)) {
|
||||
chomp $$configRef{sublist};
|
||||
}
|
||||
close(SUBLIST);
|
||||
}
|
||||
|
||||
if (open CONFIG, "$configFile") {
|
||||
while (defined(my $confline = <CONFIG>)) {
|
||||
chomp $confline;
|
||||
if ($confline =~/^\s*keyDir\s+(\S+)/i) {
|
||||
$$configRef{keyDir} = $1;
|
||||
} elsif ($confline =~/^\s*tempDir\s+(\S+)/i) {
|
||||
$$configRef{tempDir} = $1;
|
||||
} elsif ($confline =~/^\s*gnupg\s+(\S+)/i) {
|
||||
$$configRef{gpg} = $1;
|
||||
} elsif ($confline =~/^\s*qmailbin\s+(\S+)/i) {
|
||||
$$configRef{qmailDir} = $1;
|
||||
} elsif ($confline =~/^\s*signmessages\s+(\S+)/i) {
|
||||
if ($1 =~ /n/i) {
|
||||
$$configRef{signMessages} = 0;
|
||||
}
|
||||
} elsif ($confline =~/^\s*RequireSigs\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{requireSigs} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*StripMime\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{stripMime} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*EncapsulateMime\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{encapsulateMime} = 1;
|
||||
}
|
||||
} elsif ($confline =~ /^\s*AllowAttach\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{allowAttach} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*NokeyNocrypt\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{nokeyNocrypt} = 1;
|
||||
}
|
||||
|
||||
} elsif ($confline =~/^\s*allowKeySubmission\s+(\S+)/i) {
|
||||
if ($1 =~ /n/i) {
|
||||
$$configRef{allowKeySubmission} = 0;
|
||||
}
|
||||
} elsif ($confline =~/^\s*VerifiedKeyReq\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{verifiedKeyReq} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*allowUnencrypted\s+(\S+)/i) {
|
||||
if ($1 =~ /n/i) {
|
||||
$$configRef{allowUnencrypted} = 0;
|
||||
}
|
||||
} elsif ($confline =~/^\s*EncryptToAll\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{encryptToAll} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*RequireSub\s+(\S+)/i) {
|
||||
if ($1 =~ /y/i) {
|
||||
$$configRef{requireSub} = 1;
|
||||
}
|
||||
} elsif ($confline =~/^\s*strictlevel\s+(\d+)/i) {
|
||||
$$configRef{strictlevel} = $1;
|
||||
}
|
||||
}
|
||||
close(CONFIG);
|
||||
}
|
||||
}
|
||||
|
||||
#runcmd - Runs a command, pushes all the input through it, and writes
|
||||
#to output and err. Select()s across reading and writing, for those
|
||||
#processes that can't hold all your input before they need to be read from
|
||||
#Solves a problem with large messages being pushed through gpg. Thanks to
|
||||
#tcannon@noops.org for the catch.
|
||||
|
||||
sub runcmd {
|
||||
my $cmdline = shift;
|
||||
my $inputref = shift;
|
||||
my $outputref = shift;
|
||||
my $errref = shift;
|
||||
|
||||
$$outputref = "";
|
||||
$$errref = "";
|
||||
my $readpos = 0;
|
||||
my $writepos = 0;
|
||||
my $errpos = 0;
|
||||
my $writeDone = 0;
|
||||
my $readDone = 0;
|
||||
my $errDone = 0;
|
||||
my $done = 0;
|
||||
my $len;
|
||||
my @ready = ();
|
||||
my $stringLength;
|
||||
|
||||
my $pid = open3(\*WRITE, \*READ, \*ERR, "$cmdline") or
|
||||
mydie(100, "Cannot run $cmdline\n");
|
||||
my $select = IO::Select->new();
|
||||
if($$inputref) {
|
||||
$select->add(\*WRITE);
|
||||
$stringLength = length($$inputref);
|
||||
} else {
|
||||
$writeDone = 1;
|
||||
close(WRITE);
|
||||
}
|
||||
$select->add(\*READ);
|
||||
$select->add(\*ERR);
|
||||
|
||||
while(!$done) {
|
||||
if ((!$writeDone) and (@ready = $select->can_write(0))) {
|
||||
foreach my $handle (@ready) {
|
||||
if($handle == \*WRITE) {
|
||||
if($stringLength - $writepos > 4096) {
|
||||
$len = syswrite(WRITE, $$inputref, 4096, $writepos);
|
||||
} else {
|
||||
$len = syswrite(WRITE, $$inputref, ($stringLength - $writepos), $writepos);
|
||||
}
|
||||
if ($len > 0) {
|
||||
$writepos += $len;
|
||||
} else {
|
||||
mydie(111,"System write error: $!\n");
|
||||
}
|
||||
if($writepos == $stringLength) {
|
||||
$writeDone = 1;
|
||||
$select->remove(\*WRITE);
|
||||
close (WRITE);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (@ready = $select->can_read(0)) {
|
||||
foreach my $handle (@ready) {
|
||||
if($handle == \*READ) {
|
||||
$len = sysread(READ, $$outputref, 4096, $readpos);
|
||||
if(defined($len)) {
|
||||
if($len > 0) {
|
||||
$readpos += $len;
|
||||
} else {
|
||||
$readDone = 1;
|
||||
close(READ);
|
||||
$select->remove(\*READ);
|
||||
}
|
||||
} else {
|
||||
die "System read error: $!\n";
|
||||
}
|
||||
}
|
||||
if($handle == \*ERR) {
|
||||
$len = sysread(ERR, $$errref, 4096, $errpos);
|
||||
if(defined($len)) {
|
||||
if($len > 0) {
|
||||
$errpos += $len;
|
||||
} else {
|
||||
$errDone = 1;
|
||||
close(ERR);
|
||||
$select->remove(\*ERR);
|
||||
}
|
||||
} else {
|
||||
die "System read error: $!\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# I know the below looks like an error, it should be
|
||||
# ($errDone and $readDone and $writeDone), but I've been testing this,
|
||||
# and the select never lets me through to pick the EOF off the READ
|
||||
# filehandle on gpg encrypts. If you know why, please enlighten me.
|
||||
|
||||
if(($errDone or $readDone) and $writeDone) {
|
||||
$done = 1;
|
||||
}
|
||||
}
|
||||
|
||||
# OK, I actually am having issues with read not getting everything... <sigh>
|
||||
# Hopefully, the below read will empty everything out of the read buffer.
|
||||
|
||||
while($readDone != 1) {
|
||||
$len = sysread(READ, $$outputref, 4096, $readpos);
|
||||
if(defined($len)) {
|
||||
if($len > 0) {
|
||||
$readpos += $len;
|
||||
} else {
|
||||
$readDone = 1;
|
||||
close(READ);
|
||||
$select->remove(\*READ);
|
||||
}
|
||||
}
|
||||
}
|
||||
return($pid);
|
||||
}
|
||||
|
||||
#mail - injects the mail into the system. Headers and body contained in
|
||||
#$message
|
||||
|
||||
sub mail {
|
||||
my $qmailqueue = shift;
|
||||
my $message = shift;
|
||||
my $from = shift;
|
||||
my @to = @_;
|
||||
|
||||
pipe READ0, WRITE0;
|
||||
pipe READ1, WRITE1;
|
||||
my $pid = fork();
|
||||
if ($pid) {
|
||||
close(READ0);
|
||||
close(READ1);
|
||||
} else {
|
||||
close(WRITE0);
|
||||
close(WRITE1);
|
||||
|
||||
fcntl READ0, &F_GETFL, 0 or mydie(111,"READ0 not open?\n");
|
||||
close(STDIN);
|
||||
fcntl READ0, &F_DUPFD, 0;
|
||||
fcntl READ1, &F_GETFL, 0 or mydie(111,"READ1 not open?\n");
|
||||
close(STDOUT);
|
||||
fcntl READ1, &F_DUPFD, 1;
|
||||
|
||||
exec "$qmailqueue";
|
||||
}
|
||||
print WRITE0 "$message\n";
|
||||
close (WRITE0);
|
||||
print WRITE1 "F";
|
||||
print WRITE1 "$from";
|
||||
print WRITE1 "\0";
|
||||
foreach my $to (@to) {
|
||||
print WRITE1 "T";
|
||||
print WRITE1 "$to";
|
||||
print WRITE1 "\0";
|
||||
}
|
||||
print WRITE1 "\0";
|
||||
close(WRITE1);
|
||||
}
|
||||
|
||||
#ezmlm separates subscriber lists into single character files. The below
|
||||
#replicates the ezmlm algorithm to determine the username to filename
|
||||
#mapping, so gpg-ezmlm can convert an existing ezmlm list and not need
|
||||
#to convert the subscriber list files.
|
||||
|
||||
sub hashaddr {
|
||||
my $addr = shift;
|
||||
my $h = 5381;
|
||||
my $packed;
|
||||
{ # Nasty nasty icky perl hack forthcoming
|
||||
use integer;
|
||||
my @addr = split "", $addr;
|
||||
for (my $j = 0; $j < length $addr; $j++) {
|
||||
$h = ($h + ($h << 5) ^ ord($addr[$j]));
|
||||
$h = $h & 0xffffffff # To deal with 64 bit architectures
|
||||
}
|
||||
$packed = pack "l", $h;
|
||||
}
|
||||
my $unpacked = unpack "L", $packed;
|
||||
my $ch = chr(64 + ($unpacked % 53));
|
||||
return ($ch);
|
||||
}
|
||||
|
||||
#issub checks to see if a given address is subscribed to the mailing
|
||||
#list. Returns 0 if not subscribed, 1 if subscribed
|
||||
|
||||
sub issub {
|
||||
my $address = shift;
|
||||
my $addr = "T" . lc($address);
|
||||
my $char = hashaddr($addr);
|
||||
open FD, "<subscribers/$char" or return(0);
|
||||
my $line = <FD>;
|
||||
foreach my $ss (split "\0", $line) {
|
||||
if ($ss =~ qq/^$addr/) {
|
||||
return(1);
|
||||
}
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
#rfc822date returns a string containing the date in rfc822 format.
|
||||
#You were expecting it to break RSA keys? ^_^
|
||||
|
||||
sub rfc822date {
|
||||
use integer;
|
||||
my $epoch = time();
|
||||
my $localtime = localtime;
|
||||
my $retstring;
|
||||
if ($localtime =~ /^(\S+)\s+(\S+)\s+(\d+)\s+(\d+\:\d+\:\d+)\s+(\d+)/) {
|
||||
$retstring = "$1, $3 $2 $5 $4 ";
|
||||
}
|
||||
my $tl = timelocal((localtime)[0,1,2,3,4,5]);
|
||||
my $tg = timegm((localtime)[0,1,2,3,4,5]);
|
||||
my $secdiff = $tg - $tl;
|
||||
my $hourdiff = $secdiff / 3600;
|
||||
my $mindiff = ($secdiff/60) % 60;
|
||||
my $offset;
|
||||
$offset = sprintf ("%.02d%.02d", $hourdiff, $mindiff);
|
||||
$retstring .= $offset;
|
||||
return $retstring;
|
||||
}
|
||||
|
||||
#subscribe actually adds the subscriber email address to one of the
|
||||
#subscriber list files, if it's not there already, shorter than
|
||||
#400 characters, and a whole bunch of other potential error conditions.
|
||||
#The subscriber files are a set of 53 single character files contained
|
||||
#in the subscribers subdir. Which file a subscriber belongs in is determined
|
||||
#by hashaddr
|
||||
|
||||
sub subscribe {
|
||||
my $userhost = shift;
|
||||
my $flagadd = shift;
|
||||
my $LOCK_EX = 2;
|
||||
|
||||
open LOCK, ">lock" or mydie(111,"unable to open lock: $!\n");
|
||||
flock LOCK, $LOCK_EX or mydie(111,"unable to obtain lock: $!\n");
|
||||
|
||||
if($userhost =~ /\n/) {
|
||||
print "address contains newline\n";
|
||||
return -8;
|
||||
}
|
||||
|
||||
my $addr = "T" . lc($userhost);
|
||||
if (length($addr) > 400) {
|
||||
print "address is too long\n";
|
||||
return -7;
|
||||
}
|
||||
if (!($addr =~ /\@/)) {
|
||||
print "address does not contain @\n";
|
||||
return -6;
|
||||
}
|
||||
|
||||
my $ch = hashaddr($addr);
|
||||
my $fn = "subscribers/$ch";
|
||||
my $fnnew = $fn."n";
|
||||
if (!(open FDNEW, ">$fnnew")) {
|
||||
print "unable to write $fnnew: $!\n";
|
||||
return -4;
|
||||
}
|
||||
|
||||
my $flagwasthere = 0;
|
||||
if (!(open FD, "$fn")) {
|
||||
# print "unable to read $fn: $!\n"; # Need to separate ENOENT from other
|
||||
# return -3; # errors. fix later.
|
||||
} else {
|
||||
my $line = <FD>;
|
||||
foreach my $ss (split "\0", $line) {
|
||||
if ($ss =~ qq/^$addr/) {
|
||||
$flagwasthere = 1;
|
||||
if (!($flagadd)) { next; }
|
||||
}
|
||||
print FDNEW "$ss\0";
|
||||
}
|
||||
close FD;
|
||||
}
|
||||
if ($flagadd && !$flagwasthere) {
|
||||
print FDNEW "$addr\0";
|
||||
}
|
||||
my $fdnew = select(FDNEW);
|
||||
$| = 1; # flush FDNEW's buffers
|
||||
select($fdnew);
|
||||
if (!(fsync(FDNEW))) {
|
||||
close (FDNEW);
|
||||
print "unable to write $fnnew: $!\n";
|
||||
return -4;
|
||||
}
|
||||
close FDNEW;
|
||||
if (!(rename "$fnnew", "$fn")) {
|
||||
print "unable to move temporary file to $fn: $!";
|
||||
return -5;
|
||||
}
|
||||
return ($flagadd ^ $flagwasthere);
|
||||
}
|
||||
|
||||
# prepare takes in a raw message in the form of an array of lines, a config
|
||||
# hash reference, and an array of recipients. It will return the message
|
||||
# encrypted for all recipients that it has keys for, or if it has no keys,
|
||||
# it will return error messages.
|
||||
|
||||
sub prepare {
|
||||
my $messageArrayRef = shift;
|
||||
my $configref = shift;
|
||||
my $archived = shift;
|
||||
my @recipients = shift;
|
||||
|
||||
my $inheader = 1;
|
||||
my $flagmlwasthere = 0;
|
||||
my $flagbadfield = 0;
|
||||
my $flagincrypted = 0;
|
||||
my $incontenttype = 0;
|
||||
my %headerremovemap = ();
|
||||
my @header = ();
|
||||
my @cryptedmessage = ();
|
||||
my @message = ();
|
||||
my @decryptedmessage = ();
|
||||
my $numcrypted = 0;
|
||||
my $nummessage = 0;
|
||||
my $gpg = "$$configref{gpg} --homedir $$configref{keyDir}";
|
||||
|
||||
my $mydtline = "Delivered-To: mailing list ".$$configref{outlocal}."\@".$$configref{outhost};
|
||||
|
||||
open HEADERRM, "<headerremove" or
|
||||
mydie(111, "unable to open headerremove: $!\n");
|
||||
while (<HEADERRM>) {
|
||||
chomp;
|
||||
/^(\S+)/;
|
||||
$headerremovemap{(lc $1)} = 1;
|
||||
}
|
||||
close(HEADERRM);
|
||||
|
||||
foreach my $line (@$messageArrayRef) {
|
||||
if(!($line =~ /\S+/)) {
|
||||
$inheader = 0;
|
||||
}
|
||||
if($inheader) {
|
||||
if($line =~ /^(\S+):/) {
|
||||
$flagbadfield = 0;
|
||||
$incontenttype = 0;
|
||||
if($headerremovemap{(lc $1)}) {
|
||||
$flagbadfield = 1;
|
||||
} else {
|
||||
$flagbadfield = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if($archived) {
|
||||
if ($line =~ /^subject:/i) {
|
||||
$line =~ s/subject:/Subject: \[$$configref{outlocal} archive \#$archived\]/i;
|
||||
}
|
||||
} else {
|
||||
if ($line =~ /^$mydtline/i) {
|
||||
mydie(100, "this message is looping: it already has my Delivered-To line (#5.4.6): $line\n");
|
||||
}
|
||||
}
|
||||
|
||||
if ($line =~ /^mailing-list:/i) {
|
||||
$flagmlwasthere = 1;
|
||||
}
|
||||
|
||||
if(!($flagbadfield)) {
|
||||
push @header, $line;
|
||||
}
|
||||
} else {
|
||||
if (!($archived)) {
|
||||
if($$configref{subList}) {
|
||||
if (!($flagmlwasthere)) {
|
||||
mydie(100, "sublist messages must have Mailing-List (#5.7.2)\n");
|
||||
}
|
||||
} else {
|
||||
if ($flagmlwasthere) {
|
||||
mydie(100, "message already has Mailing-List (#5.7.2)\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($line =~ /-----BEGIN PGP MESSAGE-----/) {
|
||||
$flagincrypted = 1;
|
||||
}
|
||||
|
||||
if($flagincrypted) {
|
||||
push @{$cryptedmessage[$numcrypted]}, $line;
|
||||
} else {
|
||||
push @{$message[$nummessage]}, $line;
|
||||
}
|
||||
|
||||
if ($line =~ /-----END PGP MESSAGE-----/) {
|
||||
$flagincrypted = 0;
|
||||
$numcrypted++;
|
||||
$nummessage++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for(my $i = 0; $i < $numcrypted; $i++) {
|
||||
my $error;
|
||||
my @signlines = ();
|
||||
my $goodsig = 0;
|
||||
my $trustedsig = 1;
|
||||
my $ciphertext = join '', @{$cryptedmessage[$i]};
|
||||
runcmd("$gpg -d", \$ciphertext, \$decryptedmessage[$i], \$error);
|
||||
foreach my $errline (split /\n/, $error) {
|
||||
if (($errline =~ /decryption failed/) or
|
||||
($errline =~ /invalid packet/)) {
|
||||
$decryptedmessage[$i] = "Unable to decrypt content";
|
||||
}
|
||||
# if (/signature/) {
|
||||
# push @signlines, $_;
|
||||
}
|
||||
}
|
||||
my $mail;
|
||||
foreach my $hline (@header) {
|
||||
$mail .= $hline;
|
||||
}
|
||||
for (my $i = 0; $i < ($numcrypted+1); $i++) {
|
||||
if ($message[$i]) {
|
||||
foreach my $line (@{$message[$i]}) {
|
||||
$mail .= $line;
|
||||
}
|
||||
}
|
||||
if ($decryptedmessage[$i]) {
|
||||
my $recipientline;
|
||||
foreach my $recipient (@recipients) {
|
||||
$recipientline .= " -r $recipient";
|
||||
}
|
||||
my $error;
|
||||
my $plaintext = $decryptedmessage[$i];
|
||||
my $ciphertext;
|
||||
if ($$configref{verifiedKeyReq}) {
|
||||
if ($$configref{signMessages}) {
|
||||
runcmd("$gpg --no --no-tty --batch -sea $recipientline",
|
||||
\$plaintext,
|
||||
\$ciphertext,
|
||||
\$error);
|
||||
} else {
|
||||
runcmd("$gpg --no --no-tty --batch -ea $recipientline",
|
||||
\$plaintext,
|
||||
\$ciphertext,
|
||||
\$error);
|
||||
}
|
||||
} else {
|
||||
if ($$configref{signMessages}) {
|
||||
runcmd("$gpg --yes --no-tty --batch --always-trust -sea $recipientline",
|
||||
\$plaintext,
|
||||
\$ciphertext,
|
||||
\$error);
|
||||
} else {
|
||||
runcmd("$gpg --yes --no-tty --batch --always-trust -ea $recipientline",
|
||||
\$plaintext,
|
||||
\$ciphertext,
|
||||
\$error);
|
||||
}
|
||||
}
|
||||
my $goodcrypt = 1;
|
||||
foreach my $errline (split /\n/, $error) {
|
||||
if (($errline =~ /public key not found/) or
|
||||
($errline =~ /no valid addressees/)) {
|
||||
$goodcrypt = 0;
|
||||
if(!($$configref{encryptToAll})) {
|
||||
if ($$configref{nokeyNocrypt}) {
|
||||
$mail .= $plaintext;
|
||||
} else {
|
||||
$mail .= "Encrypted content not forwarded due to lack of key.\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (($goodcrypt) or ($$configref{encryptToAll})) {
|
||||
$mail .= $ciphertext;
|
||||
}
|
||||
}
|
||||
}
|
||||
return($mail);
|
||||
}
|
||||
23
LICENSE
Normal file
23
LICENSE
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
Copyright (c) 2002, tmacd@synacklabs.net
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use, with or without modification, are permitted
|
||||
provided that the following conditions are met:
|
||||
|
||||
Redistributions of code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
Neither the name of SynAckLabs nor the names of its contributors
|
||||
may be used to endorse or promote products derived from this software
|
||||
without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
|
||||
TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
|
||||
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
||||
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
||||
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
12
MANIFEST
Normal file
12
MANIFEST
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
Changes
|
||||
GpgEzmlm.pm
|
||||
config
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
README
|
||||
LICENSE
|
||||
TODO
|
||||
gpg-ezmlm-convert.pl
|
||||
gpg-ezmlm-manage.pl
|
||||
gpg-ezmlm-send.pl
|
||||
|
||||
10
Makefile.PL
Normal file
10
Makefile.PL
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
'NAME' => 'gpg-ezmlm',
|
||||
'VERSION_FROM' => 'GpgEzmlm.pm', # finds $VERSION
|
||||
'EXE_FILES' => [ 'gpg-ezmlm-manage.pl', 'gpg-ezmlm-convert.pl', 'gpg-ezmlm-send.pl' ],
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(AUTHOR => 'Todd MacDermid <tmacd@synacklabs.net>') : ()),
|
||||
);
|
||||
40
README.md
Normal file
40
README.md
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
GpgEzmlm version 0.3
|
||||
=====================
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module type the following:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make install
|
||||
|
||||
To convert an existing ezmlm mailing list to a gpg-ezmlm mailing list,
|
||||
run:
|
||||
|
||||
gpg-ezmlm-convert.pl <dir> <dot>
|
||||
|
||||
Where <dir> is the directory the current ezmlm list lives in, and
|
||||
<dot> is in the form of ~/.qmail-mlname, for a mailing list named
|
||||
mlname. Same as the dot that you used in ezmlm-make(1). Edit the
|
||||
config file created in the directory to your preferences.
|
||||
|
||||
To convert an existing gpg-ezmlm list to this version, just point the
|
||||
dotfiles (.qmail-<list> and .qmail-<list>-default) to the new
|
||||
gpg-ezmlm-send.pl and gpg-ezmlm-manage.pl. If you want to change the
|
||||
default configuration settings, a sample config file has been included,
|
||||
edit to taste.
|
||||
|
||||
DEPENDENCIES
|
||||
|
||||
This suite requires these other modules, libraries, and tools:
|
||||
|
||||
GnuPG ( http://www.gnupg.org )
|
||||
ezmlm ( http://cr.yp.to/ezmlm.html )
|
||||
qmail ( http://cr.yp.to/qmail.html )
|
||||
perl ( http://www.cpan.org )
|
||||
Digest::MD5 ( http://search.cpan.org/search?module=Digest::MD5 )
|
||||
File::Sync ( http://search.cpan.org/search?module=File::Sync )
|
||||
|
||||
Sorry about all the requirements. I did try to avoid Gnome syndrome...
|
||||
|
||||
10
TODO
Normal file
10
TODO
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
Add functionality to work with MIME cleanly.
|
||||
|
||||
For that matter, add S/MIME support. Just imagine, a whole world of
|
||||
encrypted email clients, talking to each other...
|
||||
|
||||
Add moderation capabilities.
|
||||
|
||||
Write script to convert Majordomo and Mailman lists.
|
||||
|
||||
Add web archive option.
|
||||
65
config
Normal file
65
config
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
#This is a sample configuration file for gpg-ezmlm. The file as distributed
|
||||
#with the package contains all options set to their default values,
|
||||
#and commented out. To change these options, uncomment the line,
|
||||
#and set the option appropriately. Most options take either yes or no
|
||||
#as options. Options are case insensitive.
|
||||
|
||||
#GnuPG is the location of your gpg executable
|
||||
#
|
||||
# GnuPG /usr/local/bin/gpg
|
||||
|
||||
#qmailBin is where all of your qmail executables are located
|
||||
#
|
||||
# qmailBin /var/qmail/bin
|
||||
|
||||
#keyDir is the location of the keyring for this particular mailing
|
||||
#list. gpg-ezmlm supports a separate keyring for each ml, or you
|
||||
#can cram them all together if you like by setting the below
|
||||
#
|
||||
# keyDir .gnupg
|
||||
|
||||
#tempDir is the location of the purgatory keyrings where submitted keys
|
||||
#are stored before they are added to the main mailing list keyring.
|
||||
#You should probably not have a reason to change this.
|
||||
#
|
||||
# tempDir tmp
|
||||
|
||||
#signMessages controls whether gpg-ezmlm signs outgoing messages
|
||||
#or not. If this is not set, messages may be spoofed as if they
|
||||
#were from the mailing list
|
||||
#
|
||||
# signMessages yes
|
||||
|
||||
#If requireSigs is set to yes, then only messages with a valid, trusted
|
||||
#signature will be forwarded to the rest of the group.
|
||||
#
|
||||
# requireSigs no
|
||||
|
||||
#allowKeySubmission determines if users are allowed to submit their
|
||||
#own keys to the mailing list in the subscription confirmation emails.
|
||||
#You may want to set this to no if you are using your user account's
|
||||
#own .gnupg directory as the keyDir, as opposed to having a separate
|
||||
#one just for the mailing list
|
||||
#
|
||||
# allowKeySubmission yes
|
||||
|
||||
#Setting NokeyNocrypt to yes will forward the encrypted portions of
|
||||
#messages unencrypted to recipients for whom gpg-ezmlm does not
|
||||
#possess a key. By default, those recipients will instead receive
|
||||
#a message stating "encrypted content not forwarded because I
|
||||
#don't have a key for you."
|
||||
#
|
||||
# NokeyNocrypt no
|
||||
|
||||
#VerifiedKeyReq requies that all keys that are used be trusted keys.
|
||||
#An untrusted key is treated the same as no key at all.
|
||||
#
|
||||
# VerifiedKeyReq no
|
||||
|
||||
#RequireSub, if set to yes, will require that the sender of a message
|
||||
#be a subscriber to the email list that he is attempting to post
|
||||
#messages to. Senders who are not subscribed to the list will
|
||||
#have their submissions rejected automatically.
|
||||
#
|
||||
# RequireSub no
|
||||
|
||||
88
gpg-ezmlm-convert.pl
Executable file
88
gpg-ezmlm-convert.pl
Executable file
|
|
@ -0,0 +1,88 @@
|
|||
#/usr/bin/perl -w
|
||||
|
||||
#gpg-ezmlm-convert is a tool to convert a currently existing ezmlm
|
||||
#list into a gpg-ezmlm list, by replacing the appropriate lines,
|
||||
#creating the appropriate subdirs, and generating a list key for you.
|
||||
|
||||
use strict;
|
||||
|
||||
my $dir = shift;
|
||||
my $dot = shift;
|
||||
|
||||
if (!(-d $dir)) {
|
||||
die "No such directory $maildirlist\n";
|
||||
}
|
||||
|
||||
mkdir "$dir/.gnupg", 0700 or
|
||||
die "Cannot make $maildirlist/.gnupg: $!\n";
|
||||
|
||||
mkdir "$dir/tmp", 0700 or
|
||||
die "Cannot make $maildirlist/tmp: $!\n";
|
||||
|
||||
open NEWSEND, ">$dot.n" or die "Cannot make temporary file $dot.n: $!\n";
|
||||
open NEWDEFAULT, ">$dot-default.n" or
|
||||
die 'Cannot make temporary file $dot-default.n: $!\n";
|
||||
|
||||
|
||||
open CONFIG, ">$dir/config" or
|
||||
die "Cannot open $dir/config: $!\n";
|
||||
|
||||
print CONFIG << ENDCONFIG;
|
||||
#This is the configuration file for gpg-ezmlm. The file as distributed
|
||||
#with the package contains all options set to their default values,
|
||||
#and commented out. To change these options, uncomment the line,
|
||||
#and set the option appropriately. Most options take either yes or no
|
||||
#as options. Options are case insensitive.
|
||||
|
||||
#GnuPG is the location of your gpg executable
|
||||
#
|
||||
# GnuPG /usr/local/bin/gpg
|
||||
|
||||
#qmailBin is where all of your qmail executables are located
|
||||
#
|
||||
# qmailBin /var/qmail/bin
|
||||
|
||||
#keyDir is the location of the keyring for this particular mailing
|
||||
#list. gpg-ezmlm supports a separate keyring for each ml, or you
|
||||
#can cram them all together if you like by setting the below
|
||||
#
|
||||
# keyDir .gnupg
|
||||
|
||||
#tempDir is the location of the purgatory keyrings where submitted keys
|
||||
#are stored before they are added to the main mailing list keyring.
|
||||
#You should probably not have a reason to change this.
|
||||
#
|
||||
# tempDir tmp
|
||||
|
||||
#signMessages controls whether gpg-ezmlm signs outgoing messages
|
||||
#or not. If this is not set, messages may be spoofed as if they
|
||||
#were from the mailing list
|
||||
#
|
||||
# signMessages yes
|
||||
|
||||
#If requireSigs is set to yes, then only messages with a valid, trusted
|
||||
#signature will be forwarded to the rest of the group.
|
||||
#
|
||||
# requireSigs no
|
||||
|
||||
#Setting NokeyNocrypt to yes will forward the encrypted portions of
|
||||
#messages unencrypted to recipients for whom gpg-ezmlm does not
|
||||
#possess a key. By default, those recipients will instead receive
|
||||
#a message stating "encrypted content not forwarded because I
|
||||
#don't have a key for you."
|
||||
#
|
||||
# NokeyNocrypt no
|
||||
|
||||
#VerifiedKeyReq requies that all keys that are used be trusted keys.
|
||||
#An untrusted key is treated the same as no key at all.
|
||||
#
|
||||
# VerifiedKeyReq no
|
||||
|
||||
#RequireSub, if set to yes, will require that the sender of a message
|
||||
#be a subscriber to the email list that he is attempting to post
|
||||
#messages to. Senders who are not subscribed to the list will
|
||||
#have their submissions rejected automatically.
|
||||
#
|
||||
# RequireSub no
|
||||
ENDCONFIG
|
||||
close(CONFIG);
|
||||
428
gpg-ezmlm-manage.pl
Executable file
428
gpg-ezmlm-manage.pl
Executable file
|
|
@ -0,0 +1,428 @@
|
|||
#!/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} = "";
|
||||
|
||||
#copy takes a filename and a buffer, and appends the contents of that
|
||||
#file to the buffer. These files are the messages that the mailing list
|
||||
#sends back. If a line consists of a !R or !A, then the contents of
|
||||
#that line are replaced.
|
||||
|
||||
sub copy {
|
||||
my $file = shift;
|
||||
my $buffer = shift;
|
||||
my $confirm = shift;
|
||||
my $target = shift;
|
||||
|
||||
open FILE, "<$file" or mydie(111, "unable to open $file: $!\n");
|
||||
|
||||
while (my $line = <FILE>) {
|
||||
if($line =~ /\!R/) {
|
||||
$$buffer .= $confirm;
|
||||
} elsif ($line =~ /\!A/) {
|
||||
$$buffer .= $target;
|
||||
} else {
|
||||
$$buffer .= $line;
|
||||
}
|
||||
}
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
#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, $confirm, $target);
|
||||
if ($action =~ /^-subscribe$/) {
|
||||
copy("text/sub-confirm", \$message, $confirm, $target);
|
||||
} elsif ($action =~ /^-unsubscribe$/) {
|
||||
copy("text/unsub-confirm", \$message, $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, $confirm, $target);
|
||||
} else {
|
||||
copy("text/sub-nop", \$message, $confirm, $target);
|
||||
}
|
||||
} else {
|
||||
copy("text/sub-bad", \$message, $confirm, $target);
|
||||
}
|
||||
} elsif ($action =~ /^-uc\./) {
|
||||
if($flaghashok) {
|
||||
if (subscribe($target, 0) > 0) {
|
||||
maillog("-", $target);
|
||||
copy("text/unsub-ok", \$message, $confirm, $target);
|
||||
} else {
|
||||
copy("text/unsub-nop", \$message, $confirm, $target);
|
||||
}
|
||||
} else {
|
||||
copy("text/unsub-bad", \$message, $confirm, $target);
|
||||
}
|
||||
} else {
|
||||
copy("text/help", \$message, $confirm, $target);
|
||||
}
|
||||
copy("text/bottom", \$message, $confirm, $target);
|
||||
|
||||
$message .= "Return-Path: <$sender>\n";
|
||||
$message .= $messagecp;
|
||||
|
||||
mail("$config{qmailDir}/qmail-queue", $message, "$outlocal-return-\@$outhost", "$target");
|
||||
127
gpg-ezmlm-send.pl
Executable file
127
gpg-ezmlm-send.pl
Executable file
|
|
@ -0,0 +1,127 @@
|
|||
#!/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);
|
||||
|
||||
Loading…
Reference in a new issue