Mail-SpamCannibal
view release on metacpan or search on metacpan
lib/Mail/SpamCannibal/GoodPrivacy.pm view on Meta::CPAN
#!/usr/bin/perl
package Mail::SpamCannibal::GoodPrivacy;
use strict;
#use diagnostics;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use Mail::SpamCannibal::ParseMessage qw(
array2string
string2array
);
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
decrypt
is_pgp
whiteclean
);
=head1 NAME
Mail::SpamCannibal::GoodPrivacy - PGP for spamcannibal mail
=head1 SYNOPSIS
use Mail::SpamCannibal::GoodPrivacy;
$plaintext = decrypt(\$hash);
or -- defaults shown
$plaintext = decrypt(
Data => $data,
ExeFile => '/usr/local/bin/pgp',
KeyPath => '.pgp',
Password => 'sometext',
UserID => 'default userid',
Version => '2.62',
);
($begin,$end) = is_pgp(\@lines,\$err);
$nullchar = whiteclean(\@array);
$outstrng = whiteclean($instring);
=head1 DESCRIPTION
Mail::SpamCannibal::GoodPrivacy is a standardized
wrapper around 'pgp2x', 'pgp6x', or 'gnupg'
that provides encryption and decryption for
IPTable::IPv4::DBTables::SpamCannibal.
Mail::SpamCannibal::GoodPrivacy has been tested using pgp-2.6.2g, pgp-6.5.8,
and gpg-1.2.2 on RSA keys generated by pgp-2.6.2g which are included with
this distribution.
Utilities to verify that a message has PGP encrypted content prior to
decryption so that plain text messages are not inadvertently passed to the
decrypt program;
=over 4
=item $plaintext = decrypt(\$hash);
Decrypt an encoded message.
input: a hash or hash pointer
return: plaintext or '' on error
%hash = (
Data => $data,
ExeFile => '/usr/local/bin/gpg',
KeyPath => './',
Password => 'sometext',
UserID => '',
Version => '',
);
Data: data to decrypt
ExeFile: location of executable
i.e. /usr/local/bin/pgp
/usr/local/bin/gpg
WARNING: use appropriate default
keyring names.
KeyPath: directory for keyrings
Password: password for decryption
UserID: Optional default user for decryption.
The user 'name' or keyID
i.e. 'test' or
E56C91B9 as displayed by
pgp -kv ./keyrings/secring.pgp
or
ENVGPGHOME=./keyrings gpg --list-secret-keys
Version: Version compliance (gpg only)
(none) for standard gpg,
2.6x and 6.x for pgp support
=cut
## test the input array
sub _testme {
my $me = shift;
# Data
die "No data present\n"
unless exists $me->{Data} && $me->{Data};
# ExeFile
die "PGP exe file missing or not executable by effective UID\n"
unless exists $me->{ExeFile} && $me->{ExeFile} &&
-e $me->{ExeFile} && -x $me->{ExeFile};
# KeyPath
$_ = $me->{KeyPath} || './';
if ($_ eq '.') {
$_ = './';
} elsif ($_ ne './' && $_ ne '/') {
chop $_ if $_ =~ m|/$|;
$_ = './'.$_ unless $_ =~ m|^\.*/|;
}
die "Key path $_ does not exist\n"
unless -d $_;
$me->{KeyPath} = $_;
# UserID
$me->{UserID} = '' unless $me->{UserID};
# Password
$me->{Password} = '' unless $me->{Password};
# Version
$me->{Version} = '' unless $me->{Version};
}
sub decrypt {
my $me = $_[0];
return '' unless $me;
$me = {@_} if @_ > 1;
_testme($me);
my $data = '';
my $pgpcmd = '|'. $me->{ExeFile};
$pgpcmd .= ' -u '. $me->{UserID} if $me->{UserID};
if ($pgpcmd =~ m|/pgp[^/]*$|) {
$pgpcmd .= ' -f +batchmode +force 2>/dev/null';
$ENV{PGPPATH} = $me->{KeyPath};
$ENV{PGPPASS} = $me->{Password};
}
elsif( $pgpcmd =~ m|/gpg[^/]*$|) {
$data .= $me->{Password}."\n";
$pgpcmd .= ' --pgp2' if $me->{Version} =~ /^2\./;
$pgpcmd .= ' --pgp6' if $me->{Version} =~ /^6\./;
$pgpcmd .= ' --decrypt --batch --passphrase-fd 0 2>/dev/null';
$ENV{GNUPGHOME} = $me->{KeyPath};
}
else {
die "could not find pgp or gpg executable\n";
}
$data .= $me->{Data};
my $rv = '';
my $pid = open(FROMCHILD, '-|');
if($pid) {
local $/;
$rv = <FROMCHILD>;
close FROMCHILD || ($rv = ''); # kid exited
} else { # child
open(PGP,$pgpcmd) or die "could not exec pgpcmd\n";
$|++;
print PGP $data;
close PGP;
exit;
}
waitpid $pid,0;
$ENV{PGPPASS} = '';
return $rv;
}
=item ($begin,$end) = is_pgp(\@lines,\$err);
Test an array of lines to determine if they
represent a valid PGP encrypted message.
input: pointer to array of lines,
[optional] pointer to
error return string
returns: () empty array on failure
or begin = pointer to -----BEGIN PGP
end = pointer to -----END
for the input array
$err will contain and empty string
on success or a text message
indicating the failure reason
not an array ref
signed cleartext
no BEGIN PGP
no blank line
no armor text
invalid armor
no END
i.e. if (@_ = is_pgp(\@lines)) {
($begin,$end) = @_;
} else {
# sorry, not a PGP message
}
=cut
#
lib/Mail/SpamCannibal/GoodPrivacy.pm view on Meta::CPAN
my $thing = shift;
my $rv = '';
if (ref $thing eq 'ARRAY') {
_whiteAcln($thing);
return '';
}
@_ = split(/\n/,$thing);
_whiteAcln(\@_);
array2string(\@_);
}
1;
__END__
=head1 DEPENDENCIES
Mail::SpamCannibal::ParseMessage
and
You must install at least one of the following
on your system to use this module.
=over 2
=item PGP
Recommend versions of freeware from:
http://www.pl.pgpi.org/versions/freeware.shtml
in the US: PGP 2.6.2g, the "rebel" version
ftp://sunsite.smc.univie.ac.at/pub/crypto/cypherpunks/pgp/pgp262/pgp262g.zip
outside US: PGP 2.6.3i
http://www.pgpi.org/
i.e. pgp263is.tar.gz + pgp263i.patch
or
outside US: PGP 6.5.8
http://www.pgpi.org/
i.e. 'pgpsrc658unix-gnu.tar.gz',
PGPcmdln_6.5.8.Lnx_FW.tar.gz,
or PGPcmdln_6.5.8.Lnx_FW.rpm.tar
2.6.2 rebel was the default used to
develop this module.
=item GnuPG
http://www.gnupg.org/
If you plan to user PGP 2.6x or 6.x compatibility modes and you are in a
country where there are not patent restrictions, then you will also need to
download:
ftp://ftp.gnupg.dk/pub/contrib-dk/idea.c.gz
and place it in the SRC/gnupg-1.x.x/cipher directory.
=item NOTE: in all cases the default key file required.
PGP 2.6.x pubring.pgp, secring.pgp
PGP 6.5.8 pubring.pkr, secring.skr
GnuPG pubring.gpg, secring.gpg
=back
=head1 EXPORT_OK
decrypt
is_pgp
whiteclean
=head1 AUTHOR
Michael Robinton <michael@bizsystems.com>
=head1 COPYRIGHT
Copyright 2003 - 2004, Michael Robinton <michael@bizsystems.com>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
=head1 SEE ALSO
perl(1)
=cut
1;
( run in 0.548 second using v1.01-cache-2.11-cpan-df04353d9ac )