Crypt-GPG
view release on metacpan or search on metacpan
# -*-cperl-*-
#
# Crypt::GPG - An Object Oriented Interface to GnuPG.
# Copyright (c) 2000-2007 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: GPG.pm,v 1.64 2014/09/18 12:21:25 ashish Exp $
package Crypt::GPG;
use Carp;
use File::Spec ();
use Date::Parse;
use File::Temp qw( tempfile tempdir );
use IPC::Run qw( start pump finish timeout );
use vars qw( $VERSION $AUTOLOAD );
File::Temp->safe_level( File::Temp::STANDARD );
( $VERSION ) = '$Revision: 1.64 $' =~ /\s+([\d\.]+)/;
sub new {
bless { GPGBIN => '/usr/local/bin/gpg',
FORCEDOPTS => '--no-secmem-warning',
GPGOPTS => '--lock-multiple --compress-algo 1 ' .
'--cipher-algo cast5 --force-v3-sigs',
VERSION => $VERSION,
DELAY => 0,
PASSPHRASE => '',
COMMENT => "Crypt::GPG v$VERSION",
ARMOR => 1,
MARGINALS => 3,
DETACH => 1,
# $message .= "\n" unless $message =~ /\n$/s;
$message =~ s/(?<!\r)\n/\r\n/sg;
print $tmpfh $message; close $tmpfh;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
push (@opts, ('--comment', $self->comment)) if $self->comment;
my $signhow = $self->clearsign ? '--clearsign' : '--sign';
local $SIG{CHLD} = 'IGNORE';
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, @secretkey,'--no-tty', '--status-fd', '2', '--command-fd',
0, '-o-', $signhow, @extras, $tmpnam], \$in, \$out, \$err, timeout( 30 ));
my $skip = 1; my $i = 0;
local $SIG{CHLD} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
while ($skip) {
pump $h until ($err =~ /NEED_PASSPHRASE (.{16}) (.{16}).*\n/g or
$err =~ /GOOD_PASSPHRASE/g);
if ($2) {
$in .= $self->passphrase . "\n";
pump $h until $err =~ /(GOOD|BAD)_PASSPHRASE/g;
my ($tf, $ts, $td) = ($self->tmpfiles, $self->tmpsuffix, $self->tmpdir);
my ($tmpfh, $tmpnam) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
my ($tmpfh2, $tmpnam2) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
my $ciphertext = ref($_[0]) ? join '', @{$_[0]} : $_[0];
$ciphertext .= "\n" unless $ciphertext =~ /\n$/s;
print $tmpfh $ciphertext; close $tmpfh;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
push (@opts, ('--comment', $self->comment)) if $self->comment and !$_[1];
backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
local $SIG{CHLD} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
my $x;
if ($_[1]) {
my $message = ref($_[1]) ? join '', @{$_[1]} : $_[1];
# $message .= "\n" unless $message =~ /\n$/s;
$message =~ s/(?<!\r)\n/\r\n/sg;
($tmpfh3, $tmpnam3) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
print $tmpfh3 $message; close $tmpfh3;
my $y = $self->gpgbin . " @opts --marginals-needed " . $self->marginals . " --status-fd 1 --logger-fd 1 --command-fd 0 --no-tty --verify $tmpnam $tmpnam3";
$x = `$y`;
}
else {
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--marginals-needed', $self->marginals,
'--status-fd', '1', '--command-fd', 0, '--yes', '--no-tty',
'--decrypt', '-o', $tmpnam2, $tmpnam],
\$in, \$out, \$err, timeout( 30 ));
my $success = 0;
my $seckey = (ref($self->secretkey)?$self->secretkey->{ID}:$self->secretkey);
while (1) {
pump $h until ($out =~ /NEED_PASSPHRASE (.{16}) (.{16}).*\n/g
or $out =~ /(GOOD_PASSPHRASE)/g
my $self = shift;
my @return;
my ($tmpfh, $tmpnam) =
tempfile( $self->tmpfiles, DIR => $self->tmpdir,
SUFFIX => $self->tmpsuffix, UNLINK => 1);
warn join '',@{$_[0]};
print $tmpfh join '',@{$_[0]}; close $tmpfh;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($info) = backtick ($self->gpgbin, @opts, '--status-fd', 1, '--no-tty', '--batch', $tmpnam);
$info =~ s/ENC_TO (.{16})/{push @return, $1}/sge;
unlink $tmpnam;
return @return;
}
sub encrypt {
my $self = shift;
my ($message, $rcpts) = @_;
my $info;
$message = join ('', @$message) if ref($message) eq 'ARRAY';
print $tmpfh $message; close $tmpfh;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
push (@opts, '--default-key', ref($self->secretkey)?$self->secretkey->{ID}:$self->secretkey) if $sign and $self->secretkey;
push (@opts, $sign) if $sign; push (@opts, $armor) if $armor;
push (@opts, ('--comment', $self->comment)) if $self->comment;
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
'-o', $tmpnam2, @rcpts, '--encrypt', $tmpnam], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
my $pos;
eval {
pump $h until ($out =~ /(o)penfile.overwrite.okay/g
or $out =~ /(u)(n)trusted_key.override/g #! Test
or $out =~ /(k)(e)(y) not found/g #! Test
or $out =~ /(p)(a)(s)(s)phrase.enter/g);
$pos = 1 if $1; $pos = 2 if $2; $pos = 3 if $3; $pos = 4 if $4;
};
return if grep { $_ !~ /^[a-f0-9]+$/i } @keyids;
my $tmpdir = tempdir( $self->tmpdirs,
DIR => $self->tmpdir, CLEANUP => 1);
my ($tmpfh, $tmpnam) =
tempfile( $self->tmpfiles, DIR => $self->tmpdir,
SUFFIX => $self->tmpsuffix, UNLINK => 1);
print $tmpfh $key;
my @pret1 = ('--options', '/dev/null', '--homedir', $tmpdir);
my @pret2 = ('--keyring', "$tmpdir/pubring.gpg",
'--secret-keyring', "$tmpdir/secring.gpg");
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my @listopts = qw(--fingerprint --fingerprint --with-colons);
backtick($self->gpgbin, @opts, @pret1, '-v', '--import', $tmpnam);
backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
my ($keylist) = backtick($self->gpgbin, @opts, @pret1, '--marginals-needed',
$self->marginals, '--check-sigs', @listopts, @keyids);
my ($seclist) = backtick($self->gpgbin, @opts, @pret1,
'--list-secret-keys', @listopts);
my @seckeys = grep { my $id = $_->{ID};
(grep { $id eq $_ } @keyids) ? $_ : '' }
$self->parsekeys(split /\n/,$seclist);
my @ret = ($self->parsekeys(split /\n/,$keylist), @seckeys);
if ($pretend) {
#! This hack needed to get real calc trusts for to-import keys. Test!
backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
($keylist) = backtick($self->gpgbin, @opts, @pret2, '--marginals-needed',
$self->marginals, '--check-sigs', @listopts);
my @realkeylist = grep { my $id = $_->{ID} if $_;
$id and grep { $id eq $_->{ID} } @ret }
# map { ($_->{Keyring} eq "$tmpdir/secring.gpg"
# or $_->{Keyring} eq "$tmpdir/pubring.gpg") ? $_ : 0 }
$self->parsekeys(split /\n/,$keylist);
@ret = (@realkeylist, @seckeys);
}
else {
if (@keyids) {
my ($out) = backtick($self->gpgbin, @opts, @pret1, "--export", '-a', @keyids);
print $tmpfh $out; close $tmpfh;
}
backtick($self->gpgbin, @opts, '-v', '--import', $tmpnam);
}
rmtree($tmpdir, 0, 1);
unlink($tmpnam);
return @ret;
}
sub export {
my $self = shift;
my $key = shift;
my $id = $key->{ID};
return unless $id =~ /$self->{VKEYID}/;
my $armor = $self->armor ? '-a' : '';
my $secret = $key->{Type} eq 'sec' ? '-secret-keys' : '';
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
push (@opts, ('--comment', $self->comment)) if $self->comment;
push (@opts, '--status-fd', '1');
my ($out) = backtick($self->gpgbin, @opts, "--export$secret", $armor, $id);
$out;
}
sub keygen {
my $self = shift;
my ($name, $email, $keytype, $keysize, $expire, $pass, $comment) = @_;
return unless $keysize =~ /$self->{VKEYSZ}/
and $keysize > 767 and $keysize < 4097
and $pass =~ /$self->{VPASSPHRASE}/
}
}
}
sub _exec_gen_key {
my $self = shift;
my ($name, $email, $keytype, $keysize, $expire, $pass, $comment, $forked) = @_;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
'--gen-key'], \$in, \$out, \$err);
if ($forked) {
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
}
pump $h until $out =~ /keygen\.algo/g; $in .= "1\n";
pump $h until $out =~ /keygen\.size/g; $in .= "$keysize\n";
pump $h until $out =~ /keygen\.valid/g; $in .= "$expire\n";
pump $h until $out =~ /keygen\.name/g; $in .= "$name\n";
pump $h until $out =~ /keygen\.email/g; $in .= "$email\n";
}
print "|\n" if $forked;
finish $h;
}
sub keydb {
my $self = shift;
my @ids = map { return unless /$self->{VKEYID}/; $_ } @_;
my @moreopts = qw(--fingerprint --fingerprint --with-colons);
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
my ($keylist) = backtick($self->gpgbin, @opts, '--marginals-needed', $self->marginals,
'--no-tty', '--check-sigs', @moreopts, @ids);
my ($seclist) = backtick($self->gpgbin, @opts,
'--no-tty', '--list-secret-keys', @moreopts, @ids);
my @keylist = split /\n(\s*\n)?/, $keylist;
my @seclist = split /\n(\s*\n)?/, $seclist;
$self->parsekeys (@keylist, @seclist);
}
sub keyinfo {
shift->keydb(@_);
}
sub parsekeys {
my $self=shift; my @keylist = @_;
my @keys; my ($i, $subkey, $subnum, $uidnum) = (-1);
my $keyring = '';
$^W = 0;
foreach (@keylist) {
next if /^\-/;
next if /^(gpg|tru):/;
if (/^\//) {
$keyring = $_; chomp $keyring;
next;
}
if (/^(pub|sec)/) {
$uidnum=-1; $subnum=-1; $subkey=0;
my ($type, $trust, $size, $algorithm, $id, $created,
$expires, $u2, $ownertrust, $uid) = split (':');
$keys[++$i] = {
Keyring => $keyring,
my $self = shift;
my ($key, $oldpass, $newpass) = @_;
return unless $oldpass =~ /$self->{VPASSPHRASE}/
and $newpass =~ /$self->{VPASSPHRASE}/
and $key->{Type} eq 'sec';
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
'--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
pump $h until $out =~ /keyedit\.prompt/g; $in .= "passwd\n";
pump $h until ($out =~ /GOOD_PASSPHRASE/g
or $out =~ /(passphrase\.enter)/g);
unless ($1) {
finish $h, return if $oldpass;
}
}
sub keytrust {
my $self = shift;
my ($key, $trustlevel) = @_;
return unless $trustlevel =~ /$self->{VTRUSTLEVEL}/;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty',
'--status-fd', '1', '--command-fd', 0,
'--edit-key', $key->{ID}],
\$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
pump $h until $out =~ /keyedit\.prompt/g; $in .= "trust\n";
pump $h until $out =~ /edit_ownertrust\.value/g; $in .= "$trustlevel\n";
if ($trustlevel == 5) {
pump $h until $out =~ /edit_ownertrust\.set_ultimate\.okay/g; $in .= "Y\n";
}
pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
# Check if already signed.
return 1 unless grep { !grep { $signingkey eq $_->{ID} }
@{$_->{Signatures}} }
(@{$key->{UIDs}})[@uids];
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
push (@opts, '--default-key', $self->secretkey) if $self->secretkey;;
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--status-fd', '1', '--command-fd', 0, '--no-tty',
'--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
for (@uids) {
my $uid = $_+1;
pump $h until ($out =~ /keyedit\.prompt/g);
$in .= "uid $uid\n";
}
pump $h until ($out =~ /keyedit\.prompt/g);
$out = '';
sub delkey {
my $self = shift;
my $key = shift;
return unless $key->{ID} =~ /$self->{VKEYID}/;
my $del = $key->{Type} eq 'sec' ?
'--delete-secret-and-public-key':'--delete-key';
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
$del, $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
pump $h until ($out =~ /delete it first\./g or $out =~ /(delete_key)(.secret)?.okay/g);
#! ^^^^^^^^^^^^^^^^^ to-fix.
finish $h, return undef unless $1;
$in .= "Y\n";
if ($key->{Type} eq 'sec') {
pump $h until $out =~ /delete_key.okay/g; $in .= "Y\n";
}
finish $h;
}
sub disablekey {
my $self = shift;
my $key = shift;
return unless $key->{ID} =~ /$self->{VKEYID}/;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
'--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
pump $h until ($out =~ /been disabled/g or $out =~ /(keyedit\.prompt)/g);
#! ^^^^^^^^^^^^^ to-fix.
finish $h, return undef unless $1;
$in .= "disable\n";
pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
finish $h;
return 1;
}
sub enablekey {
my $self = shift;
my $key = shift;
return unless $key->{ID} =~ /$self->{VKEYID}/;
my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
my ($in, $out, $err, $in_q, $out_q, $err_q);
my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
'--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
pump $h until ($out =~ /been disabled/g or $out =~ /(keyedit\.prompt)/g);
#! ^^^^^^^^^^^^^ to-fix.
finish $h, return undef unless $1;
$in .= "enable\n";
pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
finish $h;
return 1;
}
sub debug {
my $self = shift;
return $self->{DEBUG} unless defined $_[0];
unless ($_[0] == $self->{DEBUG}) { $ENV{IPCRUNDEBUG} = $_[0] ? 'data' : ''; }
$self->{DEBUG} = $_[0];
}
sub AUTOLOAD {
my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
if ($auto =~ /^(passphrase|secretkey|armor|gpgbin|gpgopts|delay|marginals|
detach|clearsign|encryptsafe|version|comment|tmpdir|tmpdirs|
tmpfiles|tmpsuffix|nofork)$/x) {
return $self->{"\U$auto"} unless defined $_[0];
$self->{"\U$auto"} = shift;
}
elsif ($auto eq 'DESTROY') {
}
else {
croak "Could not AUTOLOAD method $auto.";
}
Crypt::GPG - An Object Oriented Interface to GnuPG.
=head1 VERSION
$Revision: 1.64 $
$Date: 2007/04/02 13:34:25 $
=head1 SYNOPSIS
use Crypt::GPG;
my $gpg = new Crypt::GPG;
$gpg->gpgbin('/usr/bin/gpg'); # The GnuPG executable.
$gpg->secretkey('0x2B59D29E'); # Set ID of default secret key.
$gpg->passphrase('just testing'); # Set passphrase.
# Sign a message:
my $sign = $gpg->sign('testing again');
# Encrypt a message:
my @encrypted = $gpg->encrypt ('top secret', 'test@bar.com');
# Get message info:
my @recipients = $gpg->msginfo($encrypted);
# Decrypt a message.
my ($plaintext, $signature) = $gpg->verify($encrypted);
# Key generation:
$status = $gpg->keygen
('Test', 'test@foo.com', 'ELG-E', 2048, 0, 'test passphrase');
print while (<$status>); close $status;
# Key database manipulation:
$gpg->addkey($key, @ids);
@keys = $gpg->keydb(@ids);
# Key manipulation:
$key = $keys[0];
$gpg->delkey($key);
$gpg->disablekey($key);
$gpg->enablekey($key);
$gpg->keypass($key, $oldpassphrase, $newpassphrase);
$keystring = $gpg->export($key);
=head1 DESCRIPTION
The Crypt::GPG module provides access to the functionality of the
GnuPG (www.gnupg.org) encryption tool through an object oriented
interface.
It provides methods for encryption, decryption, signing, signature
verification, key generation, key certification, export and
import. Key-server access is on the todo list.
This release of the module may create compatibility issues with
previous versions. If you find any such problems, or any bugs or
documentation errors, please do report them to
crypt-gpg at neomailbox.com.
=head1 CONSTRUCTOR
=over 2
=item B<new()>
Creates and returns a new Crypt::GPG object.
=back
=head1 DATA METHODS
=over 2
=item B<gpgbin($path)>
Sets the B<GPGBIN> instance variable which gives the path to the GnuPG
binary.
=item B<gpgopts($opts)>
Sets the B<GPGOPTS> instance variable which may be used to pass
additional options to the GnuPG binary. For proper functioning of this
module, it is advisable to always include '--lock-multiple' in the
GPGOPTS string.
=item B<delay($seconds)>
Sets the B<DELAY> instance variable. This is no longer necessary (nor
used) in the current version of the module, but remains so existing
- Enabled use of default Key ID for signing
- Allow for GPG returning 8 or 16 bit KeyIDs (thanks to Roberto Jimenoca)
- Fixed tempfiles being left around after decrypt()
- Changed exit() to CORE::exit() (suggested by Jonathan R. Baker)
Revision 1.61 2006/12/21 12:36:28 ashish
- Skip tests if gpg not found.
- Use File::Spec to determine tmpdir. Suggested by Craig Manley.
Revision 1.59 2006/12/19 12:51:54 ashish
- Documentation fixes.
- Removed tests for obsolete 768 bit keys.
- Bugfixes.
- Tested with gpg 1.4.6.
Revision 1.57 2005/12/15 17:09:17 ashish
- Fixed bug in decrypt
- Fixed small key certification bugs.
Revision 1.50 2005/02/10 12:32:51 cvs
- Overhauled to use IPC::Run instead of Expect.
- Test suite split up into multiple scripts.
Revision 1.42 2002/12/11 03:33:19 cvs
- Fixed bug in certify() when trying to certify revoked a key.
- Applied dharris\x40drh.net's patch to allow for varying date formats
between gpg versions, and fix time parsing and the
Crypt::GPG::Signature autoloaded accessor functions.
Revision 1.40 2002/09/23 23:01:53 cvs
- Fixed a bug in keypass()
- Documentation fixes.
Revision 1.37 2002/09/21 02:37:49 cvs
- Added certify() method, to enable certifying keys.
- Added Crypt::GPG::Signature methods - validity(), keyid(), time()
and trusted().
=back
=head1 AUTHOR
Crypt::GPG is Copyright (c) 2000-2007 Ashish Gulhati
<crypt-gpg at neomailbox.com>. All Rights Reserved.
=head1 ACKNOWLEDGEMENTS
Thanks to Barkha, for inspiration; to the GnuPG team; and to everyone
who writes free software.
=head1 LICENSE
This code is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 BUGS REPORTS, PATCHES, FEATURE REQUESTS
Are very welcome. Email crypt-gpg at neomailbox.com.
=cut
{
"abstract" : "An Object Oriented Interface to GnuPG.",
"author" : [
"Ashish Gulhati <crypt-gpg@neomailbox.com>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
---
abstract: 'An Object Oriented Interface to GnuPG.'
author:
- 'Ashish Gulhati <crypt-gpg@neomailbox.com>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile (
'NAME' => 'Crypt::GPG',
'AUTHOR' => 'Ashish Gulhati <crypt-gpg@neomailbox.com>',
'ABSTRACT_FROM' => 'GPG.pm',
'VERSION_FROM' => 'GPG.pm',
'PREREQ_PM' => {
'Carp' => 0,
'Fcntl' => 0,
'IPC::Run' => 0,
'File::Path' => 0,
'File::Temp' => 0,
'Date::Parse' => 0,
},
NAME
Crypt::GPG - An Object Oriented Interface to GnuPG.
VERSION
$Revision: 1.64 $
$Date: 2007/04/02 13:34:25 $
SYNOPSIS
use Crypt::GPG;
my $gpg = new Crypt::GPG;
$gpg->gpgbin('/usr/bin/gpg'); # The GnuPG executable.
$gpg->secretkey('0x2B59D29E'); # Set ID of default secret key.
$gpg->passphrase('just testing'); # Set passphrase.
# Sign a message:
my $sign = $gpg->sign('testing again');
# Encrypt a message:
my @encrypted = $gpg->encrypt ('top secret', 'test@bar.com');
# Get message info:
my @recipients = $gpg->msginfo($encrypted);
# Decrypt a message.
my ($plaintext, $signature) = $gpg->verify($encrypted);
# Key generation:
$status = $gpg->keygen
('Test', 'test@foo.com', 'ELG-E', 2048, 0, 'test passphrase');
print while (<$status>); close $status;
# Key database manipulation:
$gpg->addkey($key, @ids);
@keys = $gpg->keydb(@ids);
# Key manipulation:
$key = $keys[0];
$gpg->delkey($key);
$gpg->disablekey($key);
$gpg->enablekey($key);
$gpg->keypass($key, $oldpassphrase, $newpassphrase);
$keystring = $gpg->export($key);
DESCRIPTION
The Crypt::GPG module provides access to the functionality of the GnuPG
(www.gnupg.org) encryption tool through an object oriented interface.
It provides methods for encryption, decryption, signing, signature
verification, key generation, key certification, export and import.
Key-server access is on the todo list.
This release of the module may create compatibility issues with previous
versions. If you find any such problems, or any bugs or documentation
errors, please do report them to crypt-gpg at neomailbox.com.
CONSTRUCTOR
new()
Creates and returns a new Crypt::GPG object.
DATA METHODS
gpgbin($path)
Sets the GPGBIN instance variable which gives the path to the GnuPG
binary.
gpgopts($opts)
Sets the GPGOPTS instance variable which may be used to pass
additional options to the GnuPG binary. For proper functioning of this
module, it is advisable to always include '--lock-multiple' in the
GPGOPTS string.
delay($seconds)
Sets the DELAY instance variable. This is no longer necessary (nor
used) in the current version of the module, but remains so existing
scripts don't break.
- Enabled use of default Key ID for signing
- Allow for GPG returning 8 or 16 bit KeyIDs (thanks to Roberto Jimenoca)
- Fixed tempfiles being left around after decrypt()
- Changed exit() to CORE::exit() (suggested by Jonathan R. Baker)
Revision 1.61 2006/12/21 12:36:28 ashish
- Skip tests if gpg not found.
- Use File::Spec to determine tmpdir. Suggested by Craig Manley.
Revision 1.59 2006/12/19 12:51:54 ashish
- Documentation fixes.
- Removed tests for obsolete 768 bit keys.
- Bugfixes.
- Tested with gpg 1.4.6.
Revision 1.57 2005/12/15 17:09:17 ashish
- Fixed bug in decrypt
- Fixed small key certification bugs.
Revision 1.50 2005/02/10 12:32:51 cvs
- Overhauled to use IPC::Run instead of Expect.
- Test suite split up into multiple scripts.
Revision 1.42 2002/12/11 03:33:19 cvs
- Fixed bug in certify() when trying to certify revoked a key.
- Applied dharris\x40drh.net's patch to allow for varying date formats
between gpg versions, and fix time parsing and the
Crypt::GPG::Signature autoloaded accessor functions.
Revision 1.40 2002/09/23 23:01:53 cvs
- Fixed a bug in keypass()
- Documentation fixes.
Revision 1.37 2002/09/21 02:37:49 cvs
selectively import only requested key IDs from a key block.
- parsekeys() now also figures out which keyring a key belongs to.
- Added certify() method, to enable certifying keys.
- Added Crypt::GPG::Signature methods - validity(), keyid(), time()
and trusted().
AUTHOR
Crypt::GPG is Copyright (c) 2000-2007 Ashish Gulhati <crypt-gpg at
neomailbox.com>. All Rights Reserved.
ACKNOWLEDGEMENTS
Thanks to Barkha, for inspiration; to the GnuPG team; and to everyone
who writes free software.
LICENSE
This code is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
BUGS REPORTS, PATCHES, FEATURE REQUESTS
Are very welcome. Email crypt-gpg at neomailbox.com.
t/01-keygen.t view on Meta::CPAN
# -*-cperl-*-
#
# keygen.t - Crypt::GPG key generation tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 01-keygen.t,v 1.9 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
BEGIN { plan tests => 2 }
print STDERR <<__ENDMSG;
NOTE: If the tests are skipped, you may need to install gpg,
and/or set the environment variable GPGBIN to the
location of the gpg binary.
If the keygen test takes a long time you may need to
generate more randomness on your computer (by running a
recursive directory listing in the background, for
example).
__ENDMSG
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
# Create new Crypt::GPG object
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
# Start test loop with different key sizes/types
################################################
for my $bits (qw(1024 2048)) {
for my $type ('ELG-E') {
# Generate key pair
#####################
skip($nogpg,
sub {
my $status = $gpg->keygen("A $bits $type", "$bits$type\@test.com",
$type, $bits, 0, "$bits Bit $type Test Key");
return 0 unless $status;
$|=1;
while (<$status>) {
chomp; print;
}
close $status; print "\n"; $|=0;
}, 0);
}
}
t/02-import.t view on Meta::CPAN
# -*-cperl-*-
#
# import.t - Crypt::GPG key import tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 02-import.t,v 1.4 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
BEGIN { plan tests => 1 }
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
# Create new Crypt::GPG object
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
my @samplekeys; samplekeys();
# Import sample keys
####################
skip($nogpg,
sub {
for my $x (@samplekeys) {
my ($imported) = $gpg->addkey($x->{Key});
return 0 unless $imported->{ID} eq $x->{ID};
}
1;
}
);
sub samplekeys {
push (@samplekeys, {'ID' => 'D354E162BCA6DBD1',
'Key' => <<__ENDKEY
-----BEGIN PGP PUBLIC KEY BLOCK-----
t/03-export.t view on Meta::CPAN
# -*-cperl-*-
#
# export.t - Crypt::GPG key export tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 03-export.t,v 1.6 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
BEGIN { plan tests => 10 }
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
# Create new Crypt::GPG object
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
# Start test loop with different key sizes/types
################################################
for my $bits (qw(1024 2048)) {
for my $type ('ELG-E') {
# Export our public key
#######################
my $publickey; my $pub;
skip($nogpg,
sub {
($publickey) = grep { $_->{Type} =~ /^pub[^\@]?/ } $gpg->keyinfo("A $bits $type");
$pub = $gpg->export($publickey);
});
# Pretend import public key
###########################
skip($nogpg,
sub {
my ($imported) = $gpg->addkey($pub, 1);
$publickey->{ID} eq $imported->{ID};
});
# Really import public key
##########################
skip($nogpg,
sub {
my ($imported) = $gpg->addkey($pub);
$publickey->{ID} eq $imported->{ID};
});
# Export secret key
###################
my $secretkey; my $sec;
skip($nogpg,
sub {
($secretkey) = grep { $_->{Type} =~ /^sec[^\@]?/ } $gpg->keyinfo("A $bits $type");
$sec = $gpg->export($secretkey);
});
# Import secret key
###################
skip(1, sub {
$gpg->addkey($sec);
});
}
}
t/04-encdec.t view on Meta::CPAN
# -*-cperl-*-
#
# enc-dec.t - Crypt::GPG encryption / decryption tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 04-encdec.t,v 1.8 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
BEGIN { plan tests => 10 }
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
# Create new Crypt::GPG object
my @x;
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
# Start test loop with different key sizes/types
################################################
for my $bits (qw(1024 2048)) {
for my $type ('ELG-E') {
my $secretkey;
($secretkey) = grep { $_->{Type} =~ /^sec[^\@]?/ } $gpg->keyinfo("A $bits $type")
unless $nogpg;
$gpg->secretkey($secretkey);
$gpg->encryptsafe(0);
# Encrypt
#########
skip($nogpg,
sub {
@x = $gpg->encrypt("Test\n", "A $bits $type");
});
for my $nopass (0,1) {
if ($nopass) {
# Blank out the Key password and do another round of tests
##########################################################
skip($nogpg,
sub {
$gpg->passphrase('');
$gpg->keypass($secretkey, "$bits Bit $type Test Key", '');
});
}
# Decrypt
#########
skip($nogpg,
sub {
$gpg->passphrase($nopass ? '' : "$bits Bit $type Test Key");
my ($clear) = $gpg->decrypt(@x);
defined $clear and $clear eq "Test\n";
});
}
# Set passphrase back to original
#################################
skip($nogpg,
sub {
$gpg->keypass($secretkey, '', "$bits Bit $type Test Key");
});
}
}
t/05-sigver.t view on Meta::CPAN
# -*-cperl-*-
#
# sigver.t - Crypt::GPG signing / verification tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 05-sigver.t,v 1.7 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
BEGIN { plan tests => 32 }
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
# Create new Crypt::GPG object
my @x;
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
# Start test loop with different key sizes/types
################################################
for my $bits (qw(1024 2048)) {
for my $type ('ELG-E') {
my $secretkey;
($secretkey) = grep { $_->{Type} =~ /^sec[^\@]?/ } $gpg->keyinfo("A $bits $type")
unless $nogpg;
$gpg->secretkey($secretkey->{ID});
for my $nopass (0,1) {
if ($nopass) {
# Blank out the Key password and do another round of tests
##########################################################
skip($nogpg,
sub {
$gpg->passphrase('');
$gpg->keypass($secretkey, "$bits Bit $type Test Key", '');
});
}
$gpg->passphrase("$bits Bit $type Test Key") unless $nopass;
$gpg->encryptsafe(0); #! Must test with both trusted and untrusted keys.
# Encrypt and sign with GPG
###########################
my @xs;
skip($nogpg,
sub {
@xs = $gpg->encrypt("Test\n", "A $bits $type", '-sign');
});
# Sign with GPG
###############
#! Need to check for hang when secret key not set.
skip($nogpg,
sub {
my $signed = $gpg->sign("Signing a test\nmessage, combining\nand\r\nline endings.\n");
$signed =~ /^-----BEGIN PGP SIGNATURE-----.*-----END PGP SIGNATURE-----$/s;
});
#! Clearsign with GPG
#####################
skip(sub {1});
#! Detached sign with GPG
#########################
skip(sub {1});
# Decrypt & Verify GPG with GPG
###############################
skip($nogpg,
sub {
$gpg->secretkey($secretkey);
my ($clear, $sign) = $gpg->decrypt(@xs);
defined $clear and $clear eq "Test\n"
and ref($sign) eq 'Crypt::GPG::Signature';
});
#! Verify Signature (GPG with GPG)
##################################
skip(sub {1});
#! Verify detached signature (GPG with GPG)
#################################################
skip(sub {1});
}
# Set passphrase back to original
#################################
skip($nogpg,
sub {
$gpg->keypass($secretkey, '', "$bits Bit $type Test Key");
});
}
}
t/06-keyops.t view on Meta::CPAN
# -*-cperl-*-
#
# keyops.t - Crypt::GPG key manipulation tests.
# Copyright (c) 2005-2006 Ashish Gulhati <crypt-gpg at neomailbox.com>
#
# All rights reserved. This code is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: 06-keyops.t,v 1.5 2006/12/21 12:36:35 ashish Exp $
use strict;
use Test;
use Crypt::GPG;
t/06-keyops.t view on Meta::CPAN
my $debug = 0;
my $dir = $0 =~ /^\// ? $0 : $ENV{PWD} . '/' . $0; $dir =~ s/\/[^\/]*$//;
$ENV{HOME} = $dir;
my @samplekeys; samplekeys();
# Create new Crypt::GPG object
my @x;
my $gpg = new Crypt::GPG;
$ENV{GPGBIN} and $gpg->gpgbin($ENV{GPGBIN});
my $nogpg = 1 unless (-e $gpg->gpgbin);
$gpg->gpgopts('--compress-algo 1 --cipher-algo cast5 --force-v3-sigs --no-comment');
$gpg->debug($debug);
unless ($nogpg) {
for my $x (@samplekeys) {
my ($imported) = $gpg->addkey($x->{Key});
return 0 unless $imported->{ID} eq $x->{ID};
}
}
# Start test loop with different key sizes/types
################################################
for my $bits (qw(1024 2048)) {
for my $type ('ELG-E') {
my @mykeys; @mykeys = $gpg->keyinfo("A $bits $type") unless $nogpg;
my ($publickey) = grep { $_->{Type} =~ /^pub[^\@]?/ } @mykeys;
my ($secretkey) = grep { $_->{Type} =~ /^sec[^\@]?/ } @mykeys;
$gpg->secretkey($secretkey->{ID});
for my $nopass (0,1) {
if ($nopass) {
# Blank out the Key password and do another round of tests
##########################################################
skip($nogpg,
sub {
$gpg->passphrase('');
$gpg->keypass($secretkey, "$bits Bit $type Test Key", '');
});
}
$gpg->passphrase("$bits Bit $type Test Key") unless $nopass;
$gpg->encryptsafe(0); #! Must test with both trusted and untrusted keys.
# Local-sign all sample public keys
###################################
#! Test check for already signed.
#! Test check for UID out of range. It's broken.
skip($nogpg,
sub {
for my $x (@samplekeys) {
return unless $gpg->certify($x->{ID}, 1, 0, 0);
}
1;
});
# Sign all sample public keys
#############################
skip($nogpg,
sub {
for my $x (@samplekeys) {
return unless $gpg->certify($x->{ID}, 0, 0, 0);
}
1;
});
#! Verify key signatures
########################
skip(sub {1});
# Change key trust
##################
skip($nogpg,
sub {
$gpg->keytrust($publickey, 3);
});
# Disable key
#############
skip($nogpg,
sub {
$gpg->disablekey($publickey);
});
# Enable key
############
skip($nogpg,
sub {
$gpg->enablekey($publickey);
});
}
# Set passphrase back to original
#################################
skip($nogpg,
sub {
$gpg->keypass($secretkey, '', "$bits Bit $type Test Key");
});
# Delete GPG key pair
#####################
skip($nogpg,
sub {
$gpg->delkey($secretkey);
});
}
}
sub samplekeys {
push (@samplekeys,
{'ID' => '143C9F41D8F056DD',
'Key' => <<__ENDKEY
-----BEGIN PGP PUBLIC KEY BLOCK-----
Version: GnuPG v1.2.4
( run in 1.579 second using v1.01-cache-2.11-cpan-df04353d9ac )