commit cee24fcd468718211e40dfb3f034cba121bc5a95 Author: phil Date: Fri Jul 22 21:57:59 2016 +0200 init diff --git a/Changes b/Changes new file mode 100644 index 0000000..1ffe506 --- /dev/null +++ b/Changes @@ -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. diff --git a/GpgEzmlm.pm b/GpgEzmlm.pm new file mode 100644 index 0000000..1d68c85 --- /dev/null +++ b/GpgEzmlm.pm @@ -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 + +=head1 SEE ALSO + +L. + +=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, "; + chomp $$configRef{outhost}; + close(OUTHOST); + + open OUTLOCAL, "; + chomp $$configRef{outlocal}; + close(OUTLOCAL); + + if(open ARCHIVED, ")) { + chomp $$configRef{archived}; + } + close(ARCHIVED); + } + + if(open SUBLIST, ")) { + chomp $$configRef{sublist}; + } + close(SUBLIST); + } + + if (open CONFIG, "$configFile") { + while (defined(my $confline = )) { + 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... + # 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, "; + 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 = ; + 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, ") { + 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); +} diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..febda7e --- /dev/null +++ b/LICENSE @@ -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. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..afedab8 --- /dev/null +++ b/MANIFEST @@ -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 + diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..0f25363 --- /dev/null +++ b/Makefile.PL @@ -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 ') : ()), +); diff --git a/README.md b/README.md new file mode 100644 index 0000000..ea11796 --- /dev/null +++ b/README.md @@ -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 + +Where is the directory the current ezmlm list lives in, and + 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- and .qmail--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... + diff --git a/TODO b/TODO new file mode 100644 index 0000000..31b2c16 --- /dev/null +++ b/TODO @@ -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. diff --git a/config b/config new file mode 100644 index 0000000..9dc45d7 --- /dev/null +++ b/config @@ -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 + diff --git a/gpg-ezmlm-convert.pl b/gpg-ezmlm-convert.pl new file mode 100755 index 0000000..4703d4d --- /dev/null +++ b/gpg-ezmlm-convert.pl @@ -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); diff --git a/gpg-ezmlm-manage.pl b/gpg-ezmlm-manage.pl new file mode 100755 index 0000000..708dd33 --- /dev/null +++ b/gpg-ezmlm-manage.pl @@ -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 = ) { + 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 but provides a key for , +# 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, "; +close(KEY); + +open MAILINGLIST, "; +chomp $mailinglist; +close(MAILINGLIST); +open INHOST, "; +chomp $inhost; +close(INHOST); +open INLOCAL, "; +chomp $inlocal; +close(INLOCAL); +open OUTHOST, "; +chomp $outhost; +close(OUTHOST); +open 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, ")) { + 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 () { + 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"); diff --git a/gpg-ezmlm-send.pl b/gpg-ezmlm-send.pl new file mode 100755 index 0000000..8ece8f9 --- /dev/null +++ b/gpg-ezmlm-send.pl @@ -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, "; +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 = )) { + 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); +