GPG
view release on metacpan or search on metacpan
CHANGES.txt view on Meta::CPAN
add key management (waiting - not possible for now due to gnupg limitations, see BUG)
delete-key / delete-secret-key (waiting - not possible for now due to gnupg limitations, see BUG)
sign-key / lsign-key (waiting - not possible for now due to gnupg limitations, see BUG)
--- 2000.08.06 -- 0.05
Makefile.PL search the 'gpg' executable
Makefile.PL check if "Data::Dumper", "IO::Handle" and "IPC::Open3" exist
Makefile.PL warn for Solaris and HP-UX, need entropy
new methods fast_import(), update_trustdb()
better output from import_keys(), accept multiple import
new methods verify_files()
<P>
<HR>
<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
<P>
<PRE> use GPG;
</PRE>
<P>
<PRE> my ($passphrase,$key_id) = ("1234567890123456",'');
</PRE>
<P>
<PRE> my $gpg = new GPG(homedir => './test'); # Creation
</PRE>
<P>
<PRE> die $gpg->error() if $gpg->error(); # Error handling
</PRE>
<P>
<PRE> my ($pubring,$secring) = $gpg->gen_key(key_size => "512",
real_name => "Joe Test",
email => 'nobody@yahoo.com',
comment => "",
passphrase => $passphrase);
</PRE>
<P>
<PRE> my $pubkey = $gpg->list_packets($pubring);
my $seckey = $gpg->list_packets($secring);
$key_id = $pubkey->[0]{'key_id'};
</PRE>
<P>
<PRE> $gpg->import_keys($secring);
$gpg->import_keys($pubring);
</PRE>
<P>
<PRE> my $signed = $gpg->clearsign($key_id,$passphrase,"TEST_TEXT");
my $verify = $gpg->verify($signed);
</PRE>
<P>
<PRE> my $TEST_TEXT = $gpg->encrypt("TEST_TEXT",$key_id);
$TEST_TEXT = $gpg->decrypt($passphrase,$TEST_TEXT);
</PRE>
<P>
<PRE> $TEST_TEXT = $gpg->sign_encrypt($key_id,$passphrase,$TEST_TEXT,$key_id);
my $decrypt_verify = $gpg->decrypt_verify($passphrase,$TEST_TEXT);
</PRE>
<P>
<PRE> my $keys = $gpg->list_keys();
my $sigd = $gpg->list_sig();
</PRE>
<P>
<HR>
<H1><A NAME="INSTALLATION">INSTALLATION</A></H1>
<P>
<PRE> % perl Makefile.PL
% make
% make test
% make install
</PRE>
<P>
<PRE> Tips :
- if you want secure memory, do not forget :
% chown root /usr/local/bin/gpg ; chmod 4755 /usr/local/bin/gpg
</PRE>
<P>
<HR>
<H1><A NAME="METHODS">METHODS</A></H1>
<P>
Look at the ``test.pl'' and ``quick_test.pl'' for examples and futher
explanations.
<P>
You can set ``VERBOSE'' in ``test.pl'' to ``1'' and restart the test, to
see more extensive output.
<DL>
<DT><STRONG><A NAME="item_new">new %params</A></STRONG><DD>
<P>
<PRE> Parameters are :
- gnupg_path (most of time, 'gpg' stand inside /usr/local/bin)
- homedir (gnupg homedir, default is $HOME/.gnupg)
- config (gnupg config file)
- armor (armored if 1, DEFAULT IS *1* !)
- debug (1 for debugging, default is 0)
</PRE>
<DT><STRONG><A NAME="item_gen_key">gen_key %params</A></STRONG><DD>
<P>
<PRE> Parameters are :
- key_size (see gnupg doc)
- real_name (usually first name and last name, must not be empty)
<DT><STRONG><A NAME="item_delete_key">delete_key $key_id</A></STRONG><DD>
<P>
No yet implemented, gnupg doesn't accept this in batch mode.
</DL>
<P>
<HR>
<H1><A NAME="FAQ">FAQ</A></H1>
<P>
<PRE> Q: How does it work ?
A: it uses IPC::Open3 to connect the 'gpg' program.
IPC::Open3 is executing the fork and managing the filehandles for you.
</PRE>
<P>
<PRE> Q: How secure is GPG ?
A: As secure as you want... Be carefull. First, GPG is no
more securer than 'gpg'.
Second, all passphrases are stored in non-secure memory, unless
you "chown root" and "chmod 4755" your script first. Third, your
script probably store passpharses somewhere on the disk, and
this is *not* secure.
</PRE>
<P>
<PRE> Q: Why using GPG, and not GnuPG or GnuPG::Interface ??
A: Because of their input/output facilities,
GnuPG.pm only works on filenames.
GnuPG::Interface works with fileshandles, but is hard to use - all filehandle
<P>
<HR>
<H1><A NAME="KNOWN_BUGS">KNOWN BUGS</A></H1>
<P>
Currently known bugs are caused by gnupg (www.gnupg.org) and *not* by
GPG.pm :
<P>
<PRE> - the methods "delete_key" and "delete_secret_key" do not work,
Not because of a bug but because gnupg cannot do that in batch mode.
- sign_key() and lsign_key() : "gpg: can't do that in batchmode"
- verify() and verify_files() output only the wrong file, even only one has
a wrong signature. Other files are ignored.
</PRE>
<P>
I hope a later version of gnupg will correct this issues...
<P>
<HR>
<H1><A NAME="TODO">TODO</A></H1>
<P>
<P>
CPAN : ${CPAN}/authors/id/M/MI/MILES/
<P>
sourceforge : <A
HREF="https://sourceforge.net/project/filelist.php?group_id=8630">https://sourceforge.net/project/filelist.php?group_id=8630</A>
<P>
developpers info at <A
HREF="https://sourceforge.net/projects/gpg">https://sourceforge.net/projects/gpg</A>
<P>
doc and home-page at <A
HREF="http://gpg.sourceforge.net/">http://gpg.sourceforge.net/</A> (this
document)
<P>
<HR>
<H1><A NAME="DEVELOPPEMENT">DEVELOPPEMENT</A></H1>
<P>
<PRE> CVS access :
look at <A HREF="http://acity.sourceforge.net/devel.html">http://acity.sourceforge.net/devel.html</A>
... and replace "agora" or "acity" by "gpg".
</PRE>
<P>
<HR>
<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
<P>
<PRE> GnuPG - <A HREF="http://www.gnupg.org">http://www.gnupg.org</A>
GnuPG.pm - input/output only through file_names
GnuPG::Interface - input/output only through file_handles
see <A HREF="http://GnuPG-Interface.sourceforge.net/">http://GnuPG-Interface.sourceforge.net/</A> or CPAN
IPC::Open3 - communication with 'gpg', see "perldoc perlipc"
</PRE>
<P>
<HR>
<H1><A NAME="AUTHOR">AUTHOR</A></H1>
<P>
<PRE> miles@_REMOVE_THIS_users.sourceforge.net, pf@_REMOVE_THIS_spin.ch
extra thanks to tpo_at_spin
</PRE>
</BODY>
sub new ($%) { my ($this,%params) = @_;
my $class = ref($this) || $this;
my $self = {};
$self->{'gnupg_path'} = $params{'gnupg_path'} || $GNUPG_PATH;
$self->{'homedir'} = $params{'homedir'} || $ENV{'HOME'}.'/.gnupg';
$self->{'config'} = $params{'config'} || '';
$self->{'armor'} = $params{'armor'} || '1'; # Default IS armored !
$self->{'debug'} = $params{'debug'} || '';
$self->{'COMMAND'} = "$self->{'gnupg_path'}/gpg";
$self->{'COMMAND'} .= " -a" if $self->{'armor'};
$self->{'COMMAND'} .= " --config $self->{'config'}" if $self->{'config'};
$self->{'COMMAND'} .= " --homedir $self->{'homedir'}" if $self->{'homedir'};
$self->{'COMMAND'} .= " --batch";
$self->{'COMMAND'} .= " --no-comment";
$self->{'COMMAND'} .= " --no-version";
$self->{'COMMAND'} .= ' '; # so i dont forget the spaces later :-)
if ($self->{'debug'}) {
print "\n********************************************************************\n";
# warning() : same code as for error(), but otherwise :-)
sub warning { my ($this,$string) = @_;
$string
? $this->{'warning'}
? $this->{'warning'} .= "\n$string"
: $this->{'warning'} = "$string"
: return $this->{'warning'} || '';
}
sub start_gpg { my ($this,$command,$input) = @_;
my ($stdin,$stdout,$stderr) = (IO::Handle->new(),IO::Handle->new(),IO::Handle->new());
my $pid = open3($stdin,$stdout,$stderr, $command);
if (!$pid) {
$this->error("Cannot fork [COMMAND: '$command'].");
return (0);
}
print $stdin $input;
close $stdin;
$script .= "Key-Length: $key_size\n";
$script .= "Name-Real: $real_name\n";
$script .= "Name-Comment: $comment\n" if $comment;
$script .= "Name-Email: $email\n";
$script .= "Expire-Date: 0\n";
$script .= "Passphrase: $passphrase\n";
$script .= "\%pubring $pubring\n";
$script .= "\%secring $secring\n";
$script .= "\%commit\n";
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --gen-key', $script);
return if !$pid;
# output of "gen_key" comes on stderr, we cannot stop here...
#$this->error($error) and return if $error;
open(*PUBRING,"$pubring");
my @pubring = <PUBRING>;
close PUBRING;
unlink "$pubring" || die "cannot unlink '$pubring'";
open(*SECRING,"$secring");
close SECRING;
unlink "$secring" || die "cannot unlink '$secring'";;
return(join('',@pubring),join('',@secring));
}
### list_packets ################################################
sub list_packets { my ($this,$string) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --list-packets', $string);
return if !$pid;
return [] if $output !~ /^\s*\:\S+ key packet\:/; # no key found.
$output =~ s/^\s*\:\S+ key packet\:\s*//;
my @pubkeys = split(/\s*\n\:\S+ key packet\:\s*/,$output);
my $res = [];
for my $i (@pubkeys) { # for each keys found...
my $hash = {};
my @part = split(/\s*\n\:signature packet\:\s*/,$i);
}
$msg =~ /Total number processed\:\s+(\d+)\s/;
$ret->{total_found} = $1 if $1;
return $ret;
}
# import is a Perl reserved keyword, sorry...
sub import_keys { my ($this,$import) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --import', $import);
return if !$pid;
my $res = read_import_key_result($error);
#$this->error($error) and return if !$res;
return $res;
}
sub fast_import { my ($this,$import) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --fast-import', $import);
return if !$pid;
my $res = read_import_key_result($error);
#$this->error($error) and return if !$res;
return $res;
}
sub update_trustdb { my ($this) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --update-trustdb', '');
return if !$pid;
$error =~ s/^gpg: (\d+) keys processed\s*//;
my $number_processed = $1 || '0';
$this->error($error) and return if $error;
return $number_processed;
}
### fingerprint ############################################
sub fingerprint { my ($this,$key_id) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--fingerprint $key_id", "");
return if !$pid;
$this->error($error) and return if $error;
my $fingerprint = [];
my @text = split(/\s*\n/,$output);
for(my $i = 0; $i < $#text; $i++) {
if ($text[$i] =~ /^pub\s+.*\/(\w+)\s+\S+\s+(.*)\s*$/) {
my $hash = {};
}
}
return $fingerprint;
}
### sign_key ###############################################
sub sign_key { my ($this,$key_id,$passphrase,$key_to_sign) = @_;
return "gpg: can't do that in batchmode (thanks gnupg...)";
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0 --default-key $key_id --sign-key $key_to_sign","$passphrase");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
sub lsign_key { my ($this,$key_id) = @_;
return "gpg: can't do that in batchmode (thanks gnupg...)";
}
### export_key #############################################
sub export_key { my ($this,$key_id) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--export-all $key_id", "");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
sub export_secret_key { my ($this,$key_id) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--export-secret-key $key_id", "");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### clearsign ##############################################
sub clearsign { my ($this,$key_id,$passphrase,$text) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0 --default-key $key_id --clearsign", "$passphrase\n$text");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### detach_sign ############################################
sub detach_sign { my ($this,$key_id,$passphrase,$text) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0 --default-key $key_id --detach-sign", "$passphrase\n$text");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### verify #################################################
$hash->{'key_user'} = $1 if $1;
push @$verify, $hash;
$i++;
}
}
return $verify;
}
sub verify { my ($this,$string) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--verify", "$string");
return if !$pid;
return check_verify_result($error);
}
### verify_files ###########################################
sub verify_files { my ($this,$string) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--verify", "$string");
return if !$pid;
return check_verify_result($error);
}
### encrypt ################################################
sub encrypt { my ($this,$text,@dest) = @_;
my $dest = '-r '.join(' -r ',@dest);
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"$dest --encrypt", "$text");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### decrypt ################################################
sub decrypt { my ($this,$passphrase,$text) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0 --decrypt", "$passphrase\n$text");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### sign_encrypt ###########################################
sub sign_encrypt { my ($this,$key_id,$passphrase,$text,@dest) = @_;
my $dest = '-r '.join(' -r ',@dest);
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0 $dest --default-key $key_id -se", "$passphrase\n$text");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### decrypt_verify #########################################
sub decrypt_verify { my ($this,$passphrase,$text) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0", "$passphrase\n$text");
return if !$pid;
my $verify = {};
$verify->{'ok'} = $error =~ /\sGood signature from \"/m ? 1 : 0;
$error =~ / signature from \"(.*)\"\s/m;
$verify->{'key_user'} = $1 if $1;
$error =~ /\susing \w+ key ID (\w+)\s/m;
$verify->{'key_id'} = $1 if $1;
$error =~ /\sSignature made (.*) using\s/m;
$hash->{'trust'} = 0 if !$line[1] || ($line[1] ne 'm' && $line[1] ne 'f' && $line[1] ne 'u'); # no trust
$hash->{'sig'} = [] and $last_key_sig = $hash->{'sig'} if $hash->{'type'} ne 'sig';
push @$last_key_sig,$hash and next if $hash->{'type'} eq 'sig';
push @$list,$hash;
}
return $list;
}
sub list_keys { my ($this) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--with-colons --list-keys", "");
return if !$pid;
$this->error($error) and return if $error;
return build_list_keys($output);
}
### list_sig ##############################################
sub list_sig { my ($this) = @_;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--with-colons --list-sig", "");
return if !$pid;
$this->error($error) and return if $error;
return build_list_keys($output);
}
### PROTOTYPE ##############################################
sub prototype { my ($this) = @_;
return; # XXX 'prototype' : only as example if you would add new function
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--passphrase-fd 0", "passphrase here...");
return if !$pid;
$this->error($error) and return if $error;
return $output;
}
### delete_key #############################################
sub delete_key { my ($this,$key_id) = @_;
CORE::warn "Not yet implemented - read the doc please." and return;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--delete-key $key_id", "y\n");
return if !$pid;
$this->error($error) and return if $error;
}
### delete_secret_key ######################################
sub delete_secret_key { my ($this,$key_id) = @_;
CORE::warn "Not yet implemented - read the doc please." and return;
my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
"--delete-secret-key $key_id", "y\n");
return if !$pid;
$this->error($error) and return if $error;
}
=head1 NAME
GPG - a Perl2GnuPG interface
as opposed to the existing Perl5 modules (GnuPG.pm and GnuPG::Interface, which
communicate with gnupg through filehandles or filenames)
=head1 SYNOPSIS
use GPG;
my ($passphrase,$key_id) = ("1234567890123456",'');
my $gpg = new GPG(homedir => './test'); # Creation
die $gpg->error() if $gpg->error(); # Error handling
my ($pubring,$secring) = $gpg->gen_key(key_size => "512",
real_name => "Joe Test",
email => 'nobody@yahoo.com',
comment => "",
passphrase => $passphrase);
my $pubkey = $gpg->list_packets($pubring);
my $seckey = $gpg->list_packets($secring);
$key_id = $pubkey->[0]{'key_id'};
$gpg->import_keys($secring);
$gpg->import_keys($pubring);
my $signed = $gpg->clearsign($key_id,$passphrase,"TEST_TEXT");
my $verify = $gpg->verify($signed);
my $TEST_TEXT = $gpg->encrypt("TEST_TEXT",$key_id);
$TEST_TEXT = $gpg->decrypt($passphrase,$TEST_TEXT);
$TEST_TEXT = $gpg->sign_encrypt($key_id,$passphrase,$TEST_TEXT,$key_id);
my $decrypt_verify = $gpg->decrypt_verify($passphrase,$TEST_TEXT);
my $keys = $gpg->list_keys();
my $sigd = $gpg->list_sig();
=head1 INSTALLATION
% perl Makefile.PL
% make
% make test
% make install
Tips :
- if you want secure memory, do not forget :
% chown root /usr/local/bin/gpg ; chmod 4755 /usr/local/bin/gpg
=head1 METHODS
Look at the "test.pl" and "quick_test.pl" for examples and futher explanations.
You can set "VERBOSE" in "test.pl" to "1" and restart the test, to see more extensive output.
=over 4
=item I<new %params>
Parameters are :
- gnupg_path (most of time, 'gpg' stand inside /usr/local/bin)
- homedir (gnupg homedir, default is $HOME/.gnupg)
- config (gnupg config file)
- armor (armored if 1, DEFAULT IS *1* !)
- debug (1 for debugging, default is 0)
=item I<gen_key %params>
Parameters are :
- key_size (see gnupg doc)
- real_name (usually first name and last name, must not be empty)
=item I<delete_key $key_id>
No yet implemented, gnupg doesn't accept this in batch mode.
=back
=head1 FAQ
Q: How does it work ?
A: it uses IPC::Open3 to connect the 'gpg' program.
IPC::Open3 is executing the fork and managing the filehandles for you.
Q: How secure is GPG ?
A: As secure as you want... Be carefull. First, GPG is no
more securer than 'gpg'.
Second, all passphrases are stored in non-secure memory, unless
you "chown root" and "chmod 4755" your script first. Third, your
script probably store passpharses somewhere on the disk, and
this is *not* secure.
Q: Why using GPG, and not GnuPG or GnuPG::Interface ??
A: Because of their input/output facilities,
GnuPG.pm only works on filenames.
GnuPG::Interface works with fileshandles, but is hard to use - all filehandle
management is left up to the user. GPG is working with $scalar only for both
input and output. Since I am developing for a web interface, I don't want to
write new files each time I need to communicate with gnupg.
=head1 KNOWN BUGS
Currently known bugs are caused by gnupg (www.gnupg.org) and *not* by GPG.pm :
- the methods "delete_key" and "delete_secret_key" do not work,
Not because of a bug but because gnupg cannot do that in batch mode.
- sign_key() and lsign_key() : "gpg: can't do that in batchmode"
- verify() and verify_files() output only the wrong file, even only one has
a wrong signature. Other files are ignored.
I hope a later version of gnupg will correct this issues...
=head1 TODO
see CHANGES.txt.
most of awaiting changes cannot be done until gnupg itself
Commercial support on demand, but for most problems read the "Support" section
on http://www.gnupg.org.
=head1 DOWNLOAD
CPAN : ${CPAN}/authors/id/M/MI/MILES/
sourceforge : https://sourceforge.net/project/filelist.php?group_id=8630
developpers info at https://sourceforge.net/projects/gpg
doc and home-page at http://gpg.sourceforge.net/ (this document)
=head1 DEVELOPPEMENT
CVS access :
look at http://acity.sourceforge.net/devel.html
... and replace "agora" or "acity" by "gpg".
=head1 SEE ALSO
GnuPG - http://www.gnupg.org
GnuPG.pm - input/output only through file_names
GnuPG::Interface - input/output only through file_handles
see http://GnuPG-Interface.sourceforge.net/ or CPAN
IPC::Open3 - communication with 'gpg', see "perldoc perlipc"
=head1 AUTHOR
miles@_REMOVE_THIS_users.sourceforge.net, pf@_REMOVE_THIS_spin.ch
extra thanks to tpo_at_spin
=cut
1; # End.
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker qw/prompt WriteMakefile/;
use strict;
my $orig_gpg_path = '/usr/local/bin';
my $gpg_path = $orig_gpg_path;
my $ok = 0;
while (!-f "$gpg_path/gpg") {
my @which = `which gpg`;
chomp(@which);
$which[0] =~ s/\/gpg$//;
$gpg_path = prompt("PATH to your gnupg ('gpg') executable ?",$which[0]);
}
if ($gpg_path ne $orig_gpg_path) {
`perl -pi.bak -e 's{$orig_gpg_path}{$gpg_path}' GPG.pm`;
}
my @uname = 'uname -a';
if ($uname[0] =~ /solaris/ || $uname[0] =~ /hpux/) {
print qq{
Warning for Solaris and HP-UX :
for the test suite, your gnupg probably use "entropy",
you must link \${HOME}/.gnupg/entropy to ./test/entropy
else your test will failed on step #2 and other.\n
};
GPG.pm is a Perl5 interface for using GnuPG. GPG works with
$scalar (string), as opposed to the existing Perl5 modules
(GnuPG.pm and GnuPG::Interface, which communicate with gnupg
through filehandles or filenames)
SYNOPSIS
use GPG;
my ($passphrase,$key_id) = ("1234567890123456",'');
my $gpg = new GPG(homedir => './test'); # Creation
die $gpg->error() if $gpg->error(); # Error handling
my ($pubring,$secring) = $gpg->gen_key(key_size => "512",
real_name => "Joe Test",
email => 'nobody@yahoo.com',
comment => "",
passphrase => $passphrase);
my $pubkey = $gpg->list_packets($pubring);
my $seckey = $gpg->list_packets($secring);
$key_id = $pubkey->[0]{'key_id'};
$gpg->import_keys($secring);
$gpg->import_keys($pubring);
my $signed = $gpg->clearsign($key_id,$passphrase,"TEST_TEXT");
my $verify = $gpg->verify($signed);
my $TEST_TEXT = $gpg->encrypt("TEST_TEXT",$key_id);
$TEST_TEXT = $gpg->decrypt($passphrase,$TEST_TEXT);
$TEST_TEXT = $gpg->sign_encrypt($key_id,$passphrase,$TEST_TEXT,$key_id);
my $decrypt_verify = $gpg->decrypt_verify($passphrase,$TEST_TEXT);
my $keys = $gpg->list_keys();
my $sigd = $gpg->list_sig();
INSTALLATION
% perl Makefile.PL
% make
% make test
% make install
Tips :
- if you want secure memory, do not forget :
% chown root /usr/local/bin/gpg ; chmod 4755 /usr/local/bin/gpg
METHODS
Look at the "test.pl" and "quick_test.pl" for examples and
futher explanations.
You can set "VERBOSE" in "test.pl" to "1" and restart the test,
to see more extensive output.
*new %params*
Parameters are :
- gnupg_path (most of time, 'gpg' stand inside /usr/local/bin)
- homedir (gnupg homedir, default is $HOME/.gnupg)
- config (gnupg config file)
- armor (armored if 1, DEFAULT IS *1* !)
- debug (1 for debugging, default is 0)
*gen_key %params*
Parameters are :
- key_size (see gnupg doc)
- real_name (usually first name and last name, must not be empty)
- email (email address, must not be empty)
List all keys and signatures from your standard pubring
*delete_secret_key $key_id*
No yet implemented, gnupg doesn't accpt this in batch mode.
*delete_key $key_id*
No yet implemented, gnupg doesn't accept this in batch mode.
FAQ
Q: How does it work ?
A: it uses IPC::Open3 to connect the 'gpg' program.
IPC::Open3 is executing the fork and managing the filehandles for you.
Q: How secure is GPG ?
A: As secure as you want... Be carefull. First, GPG is no
more securer than 'gpg'.
Second, all passphrases are stored in non-secure memory, unless
you "chown root" and "chmod 4755" your script first. Third, your
script probably store passpharses somewhere on the disk, and
this is *not* secure.
Q: Why using GPG, and not GnuPG or GnuPG::Interface ??
A: Because of their input/output facilities,
GnuPG.pm only works on filenames.
GnuPG::Interface works with fileshandles, but is hard to use - all filehandle
management is left up to the user. GPG is working with $scalar only for both
input and output. Since I am developing for a web interface, I don't want to
write new files each time I need to communicate with gnupg.
KNOWN BUGS
Currently known bugs are caused by gnupg (www.gnupg.org) and
*not* by GPG.pm :
- the methods "delete_key" and "delete_secret_key" do not work,
Not because of a bug but because gnupg cannot do that in batch mode.
- sign_key() and lsign_key() : "gpg: can't do that in batchmode"
- verify() and verify_files() output only the wrong file, even only one has
a wrong signature. Other files are ignored.
I hope a later version of gnupg will correct this issues...
TODO
see CHANGES.txt.
most of awaiting changes cannot be done until gnupg itself
get an extented batch mode (currently very limited)
Commercial support on demand, but for most problems read the
"Support" section on http://www.gnupg.org.
DOWNLOAD
CPAN : ${CPAN}/authors/id/M/MI/MILES/
sourceforge :
https://sourceforge.net/project/filelist.php?group_id=8630
developpers info at https://sourceforge.net/projects/gpg
doc and home-page at http://gpg.sourceforge.net/ (this document)
DEVELOPPEMENT
CVS access :
look at http://acity.sourceforge.net/devel.html
... and replace "agora" or "acity" by "gpg".
SEE ALSO
GnuPG - http://www.gnupg.org
GnuPG.pm - input/output only through file_names
GnuPG::Interface - input/output only through file_handles
see http://GnuPG-Interface.sourceforge.net/ or CPAN
IPC::Open3 - communication with 'gpg', see "perldoc perlipc"
AUTHOR
miles@_REMOVE_THIS_users.sourceforge.net, pf@_REMOVE_THIS_spin.ch
extra thanks to tpo_at_spin
quick_test.sh view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use GPG;
my ($passphrase,$key_id) = ("1234567890123456",'');
my $gpg = new GPG(homedir => './test'); # Creation
die $gpg->error() if $gpg->error(); # Error ?
warning $gpg->warn() if $gpg->warning(); # Warning ?
my ($pubring,$secring) = $gpg->gen_key(key_size => "512",
real_name => "Joe Test",
email => 'nobody@yahoo.com',
comment => "",
passphrase => $passphrase);
my $pubkey = $gpg->list_packets($pubring);
my $seckey = $gpg->list_packets($secring);
$key_id = $pubkey->[0]{'key_id'};
# After creating a public/secret key pair, you *MUST* import them
# if you want to use this key...
$gpg->import_keys($secring);
$gpg->import_keys($pubring);
# encrypt & sign operations
my $signed = $gpg->clearsign($key_id,$passphrase,"TEST_TEXT");
my $encrypted = $gpg->encrypt("TEST_TEXT",$key_id);
my $signed_encrypted = $gpg->sign_encrypt($key_id,$passphrase,"TEST_TEXT",$key_id);
# decrypt * verify operations
# $checked->{'ok'}
# $checked->{'key_user'}
# $checked->{'key_id'}
# $checked->{'sig_date'}
# $checked->{'clr_text'}
#
# ATTENTION - depending on operation not all variables are set!
my $verify = $gpg->verify($signed);
my $decrypt = $gpg->decrypt($passphrase,$encrypted);
my $decrypt_verify = $gpg->decrypt_verify($passphrase,$signed_encrypted);
# End.
my $VERBOSE = 0;
my $DEBUG = 0;
my @test = qw/ new gen_key list_packets
import_keys fast_import update_trustdb
fingerprint export_key export_secret_key
clearsign detach_sign verify verify_files
encrypt decrypt
sign_encrypt decrypt_verify
list_keys list_sig /;
# sign_key lsign_key : gpg: can't do that in batchmode
# delete_secret_key delete_key /; can *not* be implemented - read the doc please
my $gpg;
my ($pubring,$secring,$signed) = ('','');
my $passphrase = '1234567890123456';
my $key_id = '';
my $TEST_TEXT = "this is a text to encrypt/decrypt/sign/etc.\nand a second line...";
test();
######################################################
sub verbose { my ($msg) = @_;
}
else {
printf "Failed $failed test on $count (%2.2d \%).\n", 100 / $count * $failed;
}
}
######################################################
sub new {
$gpg = new GPG(homedir => './test',
armor => '1',
debug => $DEBUG);
die $gpg->error() if $gpg->error();
verbose("New GPG object successfully created");
}
sub gen_key {
($pubring,$secring) = $gpg->gen_key(key_size => "512",
real_name => "Joe Test",
email => 'nobody@yahoo.com',
comment => "",
passphrase => $passphrase);
die $gpg->error() if $gpg->error();
verbose("----> pubring:\n$pubring\n----> secring:\n$secring");
}
sub list_packets {
my $packet = $gpg->list_packets($pubring.$secring);
die $gpg->error() if $gpg->error();
$key_id = $packet->[0]{'key_id'};
if ($VERBOSE) {
my $dump = Data::Dumper->new([$packet]);
verbose($dump->Dump);
}
}
sub import_keys {
my $imported = $gpg->import_keys($pubring.$secring);
die $gpg->error() if $gpg->error();
if ($VERBOSE) {
my $dump = Data::Dumper->new([$imported]);
verbose("Keys imported :\n".$dump->Dump);
}
}
sub fast_import {
my $fast_import = $gpg->fast_import($pubring."\n".$secring);
die $gpg->error() if $gpg->error();
if ($VERBOSE) {
my $dump = Data::Dumper->new([$fast_import]);
verbose("Keys imported :\n".$dump->Dump);
}
}
sub update_trustdb {
my $updated = $gpg->update_trustdb();
die $gpg->error() if $gpg->error();
verbose("Ok: $updated key(s) updated into trustdb.");
}
sub fingerprint {
my $fingerprint = $gpg->fingerprint($key_id);
if ($VERBOSE) {
my $dump = Data::Dumper->new([$fingerprint]);
verbose("Fingerprint :\n".$dump->Dump);
}
}
sub sign_key {
my $sign = $gpg->sign_key($key_id,$passphrase,$key_id);
verbose("signed key :\n$sign");
}
sub lsign_key {
; # not yet implemented
}
sub export_key {
my $export_public = $gpg->export_key($key_id);
verbose("Exported public key :\n$export_public");
}
sub export_secret_key {
my $export_secret = $gpg->export_secret_key($key_id);
verbose("Exported secret key :\n$export_secret");
}
sub clearsign {
$signed = $gpg->clearsign($key_id,$passphrase,$TEST_TEXT);
verbose("signed text :\n$signed");
}
sub detach_sign {
my $sign = $gpg->detach_sign($key_id,$passphrase,$TEST_TEXT);
verbose("detached signature :\n$sign");
}
sub verify {
my $verify = $gpg->verify($signed);
if ($VERBOSE) {
my $dump = Data::Dumper->new([$verify]);
verbose($dump->Dump);
}
}
sub verify_files {
my $wrong_signature = substr($signed,0,60).'xx'.substr($signed,60);
my $verify = $gpg->verify_files($signed);
if ($VERBOSE) {
my $dump = Data::Dumper->new([$verify]);
verbose($dump->Dump);
}
}
sub encrypt {
$TEST_TEXT = $gpg->encrypt($TEST_TEXT,$key_id);
verbose("encrypted text :\n$TEST_TEXT");
}
sub decrypt {
$TEST_TEXT = $gpg->decrypt($passphrase,$TEST_TEXT);
verbose("decrypted text :\n$TEST_TEXT");
}
sub sign_encrypt {
$TEST_TEXT = $gpg->sign_encrypt($key_id,$passphrase,$TEST_TEXT,$key_id);
verbose("signed and encrypted text :\n$TEST_TEXT");
}
sub decrypt_verify {
my $decrypt_verify = $gpg->decrypt_verify($passphrase,$TEST_TEXT);
if ($VERBOSE) {
my $dump = Data::Dumper->new([$decrypt_verify]);
verbose($dump->Dump);
}
}
sub list_keys {
my $list_keys = $gpg->list_keys();
if ($VERBOSE) {
my $dump = Data::Dumper->new([$list_keys]);
verbose($dump->Dump);
}
}
sub list_sig {
my $list_sig = $gpg->list_sig();
if ($VERBOSE) {
my $dump = Data::Dumper->new([$list_sig]);
verbose($dump->Dump);
}
}
sub delete_secret_key {
$gpg->delete_secret_key($key_id);
verbose("secret key removed from key_ring");
}
sub delete_key {
$gpg->delete_key($key_id);
verbose("public key removed from key_ring");
}
# End of 'test.pl'.
( run in 1.220 second using v1.01-cache-2.11-cpan-e1769b4cff6 )