ezmlm-web/gpg-ezmlm
3
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

init

Browse source
This commit is contained in:
phil 2016-07-22 21:57:59 +02:00
commit cee24fcd46
11 changed files with 1516 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
Changes Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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);