731 lines
19 KiB
Perl
731 lines
19 KiB
Perl
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
|
|
copy
|
|
mail
|
|
runcmd
|
|
readConfig
|
|
hashaddr
|
|
issub
|
|
rfc822date
|
|
subscribe
|
|
prepare
|
|
reject
|
|
);
|
|
|
|
$VERSION = '0.3.3';
|
|
|
|
=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);
|
|
}
|
|
}
|
|
|
|
#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, or contains the
|
|
#tags <#l#>, <#n#>, or <#h#>, then the contents of that line are replaced.
|
|
|
|
|
|
sub copy {
|
|
my $file = shift;
|
|
my $buffer = shift;
|
|
my $isHeader = shift;
|
|
my $configRef = shift;
|
|
my $confirm = shift;
|
|
my $target = shift;
|
|
my $outmsgnum = shift;
|
|
|
|
open FILE, "<$file" or mydie(111, "unable to open $file: $!\n");
|
|
|
|
while (my $line = <FILE>) {
|
|
$line =~ s/^\!R/$confirm/;
|
|
$line =~ s/^\!A/$target/;
|
|
$line =~ s/<\#l\#>/$$configRef{outlocal}/;
|
|
$line =~ s/<\#h\#>/$$configRef{outhost}/;
|
|
$line =~ s/<\#n\#>/$outmsgnum/;
|
|
if($isHeader > 0) {
|
|
if($line =~ /\S+/) {
|
|
$$buffer .= $line;
|
|
}
|
|
} else {
|
|
$$buffer .= $line;
|
|
}
|
|
}
|
|
close(FILE);
|
|
}
|
|
|
|
|
|
#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, that 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;
|
|
|
|
$mail .= $mydtline. "\n";
|
|
|
|
if (-r "headeradd") {
|
|
copy("headeradd", \$mail, 1, $configref);
|
|
}
|
|
|
|
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);
|
|
}
|