File Coverage

blib/lib/Crypt/OpenPGP.pm
Criterion Covered Total %
statement 323 423 76.3
branch 164 312 52.5
condition 35 82 42.6
subroutine 30 33 90.9
pod 7 12 58.3
total 559 862 64.8


line stmt bran cond sub pod time code
1             package Crypt::OpenPGP;
2 7     7   131540 use strict;
  7         12  
  7         256  
3 7     7   173 use 5.008_001;
  7         18  
4              
5             our $VERSION = '1.12'; # VERSION
6              
7 7     7   3166 use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER );
  7         16  
  7         38  
8 7     7   3242 use Crypt::OpenPGP::KeyRing;
  7         19  
  7         259  
9 7     7   3438 use Crypt::OpenPGP::Plaintext;
  7         17  
  7         190  
10 7     7   3084 use Crypt::OpenPGP::Message;
  7         18  
  7         234  
11 7     7   41 use Crypt::OpenPGP::PacketFactory;
  7         11  
  7         156  
12 7     7   3072 use Crypt::OpenPGP::Config;
  7         14  
  7         232  
13 7     7   42 use Crypt::OpenPGP::Util;
  7         11  
  7         379  
14              
15 7     7   40 use Crypt::OpenPGP::ErrorHandler;
  7         12  
  7         181  
16 7     7   68 use base qw( Crypt::OpenPGP::ErrorHandler );
  7         9  
  7         524  
17              
18 7     7   4384 use File::HomeDir;
  7         40818  
  7         513  
19 7     7   50 use File::Spec;
  7         13  
  7         172  
20              
21 7     7   30 use vars qw( %COMPAT );
  7         11  
  7         3143  
22              
23             ## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
24             ## signatures, only from cleartext signatures.
25             ## See:
26             ## http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
27             $Crypt::OpenPGP::Globals::Trim_trailing_ws = 1;
28              
29             {
30             my $env = sub {
31             my $dir = shift; my @paths;
32             if (exists $ENV{$dir}) { for (@_) { push @paths, "$ENV{$dir}/$_" } }
33             return @paths ? @paths : ();
34             };
35              
36             my $home = sub {
37             my( @path ) = @_;
38             my $home_dir = File::HomeDir->my_home or return;
39             return File::Spec->catfile( $home_dir, @path );
40             };
41              
42             %COMPAT = (
43             PGP2 => {
44             'sign' => { Digest => 'MD5', Version => 3 },
45             'encrypt' => { Cipher => 'IDEA', Compress => 'ZIP' },
46             'keygen' => { Type => 'RSA', Cipher => 'IDEA',
47             Version => 3, Digest => 'MD5' },
48             'PubRing' => [
49             $env->('PGPPATH','pubring.pgp'),
50             $home->( '.pgp', 'pubring.pgp' ),
51             ],
52             'SecRing' => [
53             $env->('PGPPATH','secring.pgp'),
54             $home->( '.pgp', 'secring.pgp' ),
55             ],
56             'Config' => [
57             $env->('PGPPATH', 'config.txt'),
58             $home->( '.pgp', 'config.txt' ),
59             ],
60             },
61              
62             PGP5 => {
63             'sign' => { Digest => 'SHA1', Version => 3 },
64             'encrypt' => { Cipher => 'DES3', Compress => 'ZIP' },
65             'keygen' => { Type => 'DSA', Cipher => 'DES3',
66             Version => 4, Digest => 'SHA1' },
67             'PubRing' => [
68             $env->('PGPPATH','pubring.pkr'),
69             $home->( '.pgp', 'pubring.pkr' ),
70             ],
71             'SecRing' => [
72             $env->('PGPPATH','secring.skr'),
73             $home->( '.pgp', 'secring.skr' ),
74             ],
75             'Config' => [
76             $env->('PGPPATH', 'pgp.cfg'),
77             $home->( '.pgp', 'pgp.cfg' ),
78             ],
79             },
80              
81             GnuPG => {
82             'sign' => { Digest => 'SHA256', Version => 4 },
83             'encrypt' => { Cipher => 'Rijndael', Compress => 'Zlib',
84             MDC => 1 },
85             'keygen' => { Type => 'RSA', Cipher => 'Rijndael',
86             Version => 4, Digest => 'SHA256' },
87             'Config' => [
88             $env->('GNUPGHOME', 'options'),
89             $home->( '.gnupg', 'options' ),
90             ],
91             'PubRing' => [
92             $env->('GNUPGHOME', 'pubring.gpg'),
93             $home->( '.gnupg', 'pubring.gpg' ),
94             ],
95             'SecRing' => [
96             $env->('GNUPGHOME', 'secring.gpg'),
97             $home->( '.gnupg', 'secring.gpg' ),
98             ],
99             },
100             );
101             }
102              
103 9     9 0 1761 sub version_string { __PACKAGE__ . ' ' . $VERSION }
104              
105 16     16 0 50 sub pubrings { $_[0]->{pubrings} }
106 14     14 0 75 sub secrings { $_[0]->{secrings} }
107              
108 7     7   41 use constant PUBLIC => 1;
  7         10  
  7         480  
109 7     7   47 use constant SECRET => 2;
  7         11  
  7         35938  
110              
111             sub add_ring {
112 5     5 0 11 my $pgp = shift;
113 5         10 my($type, $ring) = @_;
114 5 50       19 unless (ref($ring) eq 'Crypt::OpenPGP::KeyRing') {
115 5 100       51 $ring = Crypt::OpenPGP::KeyRing->new( Filename => $ring )
116             or return Crypt::OpenPGP::KeyRing->errstr;
117             }
118 4 100       12 if ($type == SECRET) {
119 2         3 push @{ $pgp->{secrings} }, $ring;
  2         8  
120             } else {
121 2         5 push @{ $pgp->{pubrings} }, $ring;
  2         9  
122             }
123 4         10 $ring;
124             }
125              
126             sub new {
127 6     6 1 9087 my $class = shift;
128 6         28 my $pgp = bless { }, $class;
129 6         42 $pgp->init(@_);
130             }
131              
132             sub _first_exists {
133 15     15   21 my($list) = @_;
134 15         25 for my $f (@$list) {
135 15 50       32 next unless $f;
136 15 50       234 return $f if -e $f;
137             }
138             }
139              
140             sub init {
141 6     6 0 14 my $pgp = shift;
142 6         55 $pgp->{pubrings} = [];
143 6         25 $pgp->{secrings} = [];
144 6         30 my %param = @_;
145 6         20 my $cfg_file = delete $param{ConfigFile};
146 6 50       75 my $cfg = $pgp->{cfg} = Crypt::OpenPGP::Config->new(%param) or
147             return Crypt::OpenPGP::Config->errstr;
148 6 50 66     51 if (!$cfg_file && (my $compat = $cfg->get('Compat'))) {
149 0         0 $cfg_file = _first_exists($COMPAT{$compat}{Config});
150             }
151 6 100       21 if ($cfg_file) {
152 2         8 $cfg->read_config($param{Compat}, $cfg_file);
153             }
154             ## Load public and secret keyrings.
155 6         24 for my $s (qw( PubRing SecRing )) {
156 12 100       41 unless (defined $cfg->get($s)) {
157 7 100       38 my @compats = $param{Compat} ? ($param{Compat}) : keys %COMPAT;
158 7         14 for my $compat (@compats) {
159 15         44 my $ring = _first_exists($COMPAT{$compat}{$s});
160 15 50       43 $cfg->set($s, $ring), last if $ring;
161             }
162             }
163 12 100       37 if (my $ring = $cfg->get($s)) {
164 5 100       40 $pgp->add_ring($s eq 'PubRing' ? PUBLIC : SECRET, $ring);
165             }
166             }
167 6         24 $pgp;
168             }
169              
170             sub handle {
171 0     0 1 0 my $pgp = shift;
172 0         0 my %param = @_;
173 0         0 my($data);
174 0 0       0 unless ($data = $param{Data}) {
175             my $file = $param{Filename} or
176 0 0       0 return $pgp->error("Need either 'Data' or 'Filename' to decrypt");
177 0 0       0 $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
178             }
179 0 0       0 my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
180             return $pgp->error("Reading data packets failed: " .
181             Crypt::OpenPGP::Message->errstr);
182 0         0 my @pieces = $msg->pieces;
183 0 0       0 return $pgp->error("No packets found in message") unless @pieces;
184 0         0 while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') {
185 0         0 shift @pieces;
186             }
187 0 0       0 if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
188 0 0       0 $data = $pieces[0]->decompress or
189             return $pgp->error("Decompression error: " . $pieces[0]->errstr);
190 0 0       0 $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
191             return $pgp->error("Reading decompressed data failed: " .
192             Crypt::OpenPGP::Message->errstr);
193 0         0 @pieces = $msg->pieces;
194             }
195 0         0 my $class = ref($pieces[0]);
196 0         0 my(%res);
197 0 0 0     0 if ($class eq 'Crypt::OpenPGP::OnePassSig' ||
198             $class eq 'Crypt::OpenPGP::Signature') {
199 0         0 my($valid, $sig) = $pgp->verify( Signature => $data );
200 0 0       0 return $pgp->error("Error verifying signature: " . $pgp->errstr)
201             if !defined $valid;
202 0         0 $res{Validity} = $valid;
203 0         0 $res{Signature} = $sig;
204             } else {
205 0   0     0 my $cb = $param{PassphraseCallback} || \&_default_passphrase_cb;
206 0         0 my($pt, $valid, $sig) = $pgp->decrypt(
207             Data => $data,
208             PassphraseCallback => $cb,
209             );
210 0 0       0 return $pgp->error("Decryption failed: " . $pgp->errstr)
211             unless defined $pt;
212 0 0 0     0 return $pgp->error("Error verifying signature: " . $pgp->errstr)
213             if !defined($valid) && $pgp->errstr !~ /^No Signature/;
214 0         0 $res{Plaintext} = $pt;
215 0 0       0 $res{Validity} = $valid if defined $valid;
216 0 0       0 $res{Signature} = $sig if defined $sig;
217             }
218 0         0 \%res;
219             }
220              
221             sub _default_passphrase_cb {
222 0     0   0 my($cert) = @_;
223 0         0 my $prompt;
224 0 0       0 if ($cert) {
225 0         0 $prompt = sprintf qq(
226             You need a passphrase to unlock the secret key for
227             user "%s".
228             %d-bit %s key, ID %s
229              
230             Enter passphrase: ), $cert->uid,
231             $cert->key->size,
232             $cert->key->alg,
233             substr($cert->key_id_hex, -8, 8);
234             } else {
235 0         0 $prompt = "Enter passphrase: ";
236             }
237 0         0 _prompt($prompt, '', 1);
238             }
239              
240             sub _prompt {
241 0     0   0 my($prompt, $def, $noecho) = @_;
242 0         0 require Term::ReadKey;
243 0         0 Term::ReadKey->import;
244 0 0       0 print STDERR $prompt . ($def ? "[$def] " : "");
245 0 0       0 if ($noecho) {
246 0         0 ReadMode('noecho');
247             }
248 0         0 chomp(my $ans = ReadLine(0));
249 0         0 ReadMode('restore');
250 0         0 print STDERR "\n";
251 0 0       0 $ans ? $ans : $def;
252             }
253              
254             sub sign {
255 6     6 1 4861 my $pgp = shift;
256 6         47 my %param = @_;
257 6 50       34 $pgp->_merge_compat(\%param, 'sign') or
258             return $pgp->error( $pgp->errstr );
259 6         14 my($cert, $data);
260 6         991 require Crypt::OpenPGP::Signature;
261 6 50       33 unless ($data = $param{Data}) {
262             my $file = $param{Filename} or
263 0 0       0 return $pgp->error("Need either 'Data' or 'Filename' to sign");
264 0 0       0 $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
265             }
266 6 100       28 unless ($cert = $param{Key}) {
267 5 50       21 my $kid = $param{KeyID} or return $pgp->error("No KeyID specified");
268 5 50       21 my $ring = $pgp->secrings->[0]
269             or return $pgp->error("No secret keyrings");
270 5 50       61 my $kb = $ring->find_keyblock_by_keyid(pack 'H*', $kid) or
271             return $pgp->error("Could not find secret key with KeyID $kid");
272 5         31 $cert = $kb->signing_key;
273 5         23 $cert->uid($kb->primary_uid);
274             }
275 6 100       26 if ($cert->is_protected) {
276 2         7 my $pass = $param{Passphrase};
277 2 50 33     11 if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
278 0         0 $pass = $cb->($cert);
279             }
280 2 50       24 return $pgp->error("Need passphrase to unlock secret key")
281             unless $pass;
282 2 50       12 $cert->unlock($pass) or
283             return $pgp->error("Secret key unlock failed: " . $cert->errstr);
284             }
285 6         20 my @ptarg;
286 6 50       27 push @ptarg, ( Filename => $param{Filename} ) if $param{Filename};
287 6 100       39 if ($param{Clearsign}) {
288 1         6 push @ptarg, ( Mode => 't' );
289             ## In clear-signed messages, the line ending before the signature
290             ## is not considered part of the signed text.
291 1         12 (my $tmp = $data) =~ s!\r?\n$!!;
292 1         3 push @ptarg, ( Data => $tmp );
293             } else {
294 5         16 push @ptarg, ( Data => $data );
295             }
296 6         59 my $pt = Crypt::OpenPGP::Plaintext->new(@ptarg);
297 6         13 my @sigarg;
298 6 50       27 if (my $hash_alg = $param{Digest}) {
299 0 0       0 my $dgst = Crypt::OpenPGP::Digest->new($hash_alg) or
300             return $pgp->error( Crypt::OpenPGP::Digest->errstr );
301 0         0 @sigarg = ( Digest => $dgst->alg_id );
302             }
303 6 100       72 push @sigarg, (Type => 0x01) if $param{Clearsign};
304             my $sig = Crypt::OpenPGP::Signature->new(
305             Data => $pt,
306             Key => $cert,
307             Version => $param{Version},
308 6         85 @sigarg,
309             );
310 6 100       42 if ($param{Clearsign}) {
311 1         3 $param{Armour} = $param{Detach} = 1;
312             }
313             my $sig_data = Crypt::OpenPGP::PacketFactory->save($sig,
314 6 100       74 $param{Detach} ? () : ($pt));
315 6 100       33 if ($param{Armour}) {
316 3         764 require Crypt::OpenPGP::Armour;
317             $sig_data = Crypt::OpenPGP::Armour->armour(
318             Data => $sig_data,
319 3 100       41 Object => ($param{Detach} ? 'SIGNATURE' : 'MESSAGE'),
    50          
320             ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr );
321             }
322 6 100       24 if ($param{Clearsign}) {
323 1         7 require Crypt::OpenPGP::Util;
324 1         8 my $hash = Crypt::OpenPGP::Digest->alg($sig->{hash_alg});
325 1         6 my $data = Crypt::OpenPGP::Util::dash_escape($data);
326 1 50       7 $data .= "\n" unless $data =~ /\n$/;
327 1 50       8 $sig_data = "-----BEGIN PGP SIGNED MESSAGE-----\n" .
328             ($hash eq 'MD5' ? '' : "Hash: $hash\n") .
329             "\n" .
330             $data .
331             $sig_data;
332             }
333 6         136 $sig_data;
334             }
335              
336             sub verify {
337 7     7 1 3931 my $pgp = shift;
338 7         34 my %param = @_;
339 7         16 my $wants_object = wantarray;
340 7         14 my($data, $sig);
341 7         61 require Crypt::OpenPGP::Signature;
342             $param{Signature} or $param{SigFile} or
343 7 0 33     36 return $pgp->error("Need Signature or SigFile to verify");
344             my %arg = $param{Signature} ? (Data => $param{Signature}) :
345 7 50       38 (Filename => $param{SigFile});
346 7 100       29 $arg{IsPacketStream} = 1 if $param{IsPacketStream};
347 7 50       65 my $msg = Crypt::OpenPGP::Message->new( %arg ) or
348             return $pgp->error("Reading signature failed: " .
349             Crypt::OpenPGP::Message->errstr);
350 7         31 my @pieces = $msg->pieces;
351 7 50       33 if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
352 0 0       0 $data = $pieces[0]->decompress or
353             return $pgp->error("Decompression error: " . $pieces[0]->errstr);
354 0 0       0 $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
355             return $pgp->error("Reading decompressed data failed: " .
356             Crypt::OpenPGP::Message->errstr);
357 0         0 @pieces = $msg->pieces;
358             }
359 7 50       42 if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig') {
    50          
360 0         0 ($data, $sig) = @pieces[1,2];
361             } elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
362 7         21 ($sig, $data) = @pieces[0,1];
363             } else {
364 0         0 return $pgp->error("SigFile contents are strange");
365             }
366 7 100       21 unless ($data) {
367 2 100       9 if ($param{Data}) {
368 1         12 $data = Crypt::OpenPGP::Plaintext->new( Data => $param{Data} );
369             }
370             else {
371             ## if no Signature or detached sig in SigFile
372 0         0 my @files = ref($param{Files}) eq 'ARRAY' ? @{ $param{Files} } :
373 1 50       16 $param{Files};
374 1         6 my $fdata = $pgp->_read_files(@files);
375 1 50       11 return $pgp->error("Reading data files failed: " . $pgp->errstr)
376             unless defined $fdata;
377 0         0 $data = Crypt::OpenPGP::Plaintext->new( Data => $fdata );
378             }
379             }
380 6         13 my($cert, $kb);
381 6 100       21 unless ($cert = $param{Key}) {
382 5         68 my $key_id = $sig->key_id;
383 5         24 my $ring = $pgp->pubrings->[0];
384 5 50 33     48 unless ($ring && ($kb = $ring->find_keyblock_by_keyid($key_id))) {
385 0         0 my $cfg = $pgp->{cfg};
386 0 0 0     0 if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) {
387 0         0 require Crypt::OpenPGP::KeyServer;
388 0         0 my $server = Crypt::OpenPGP::KeyServer->new(
389             Server => $cfg->get('KeyServer'),
390             );
391 0         0 $kb = $server->find_keyblock_by_keyid($key_id);
392             }
393 0 0       0 return $pgp->error("Could not find public key with KeyID " .
394             unpack('H*', $key_id))
395             unless $kb;
396             }
397 5         30 $cert = $kb->signing_key;
398             }
399              
400             ## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
401             ## signatures, only from cleartext signatures. So we first try to verify
402             ## the signature using proper RFC4880 canonical text, then if that fails,
403             ## retry without trimming trailing whitespace.
404             ## See:
405             ## http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
406 6         16 my($dgst, $found);
407 6         14 for (1, 0) {
408 6         14 local $Crypt::OpenPGP::Globals::Trim_trailing_ws = $_;
409 6 50       37 $dgst = $sig->hash_data($data) or
410             return $pgp->error( $sig->errstr );
411 6 50       47 $found++, last if substr($dgst, 0, 2) eq $sig->{chk};
412             }
413 6 50       20 return $pgp->error("Message hash does not match signature checkbytes")
414             unless $found;
415 6 100 66     38 my $valid = $cert->key->public_key->verify($sig, $dgst) ?
    50          
416             ($kb && $kb->primary_uid ? $kb->primary_uid : 1) : 0;
417              
418 6 100       2303859 $wants_object ? ($valid, $sig) : $valid;
419             }
420              
421             sub encrypt {
422 23     23 1 14665 my $pgp = shift;
423 23         111 my %param = @_;
424 23 50       108 $pgp->_merge_compat(\%param, 'encrypt') or
425             return $pgp->error( $pgp->errstr );
426 23         42 my($data);
427 23         1406 require Crypt::OpenPGP::Cipher;
428 23         909 require Crypt::OpenPGP::Ciphertext;
429 23 50       84 unless ($data = $param{Data}) {
430             my $file = $param{Filename} or
431 0 0       0 return $pgp->error("Need either 'Data' or 'Filename' to encrypt");
432 0 0       0 $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
433             }
434 23         38 my $ptdata;
435 23 100       65 if ($param{SignKeyID}) {
436             $ptdata = $pgp->sign(
437             Data => $data,
438             KeyID => $param{SignKeyID},
439             Compat => $param{Compat},
440             Armour => 0,
441             Passphrase => $param{SignPassphrase},
442             PassphraseCallback => $param{SignPassphraseCallback},
443             )
444 1 50       8 or return;
445             } else {
446             my $pt = Crypt::OpenPGP::Plaintext->new( Data => $data,
447 22 50       139 $param{Filename} ? (Filename => $param{Filename}) : () );
448 22         108 $ptdata = Crypt::OpenPGP::PacketFactory->save($pt);
449             }
450 23 100       85 if (my $alg = $param{Compress}) {
451 1         593 require Crypt::OpenPGP::Compressed;
452 1         5 $alg = Crypt::OpenPGP::Compressed->alg_id($alg);
453 1 50       4 my $cdata = Crypt::OpenPGP::Compressed->new( Data => $ptdata,
454             Alg => $alg ) or return $pgp->error("Compression error: " .
455             Crypt::OpenPGP::Compressed->errstr);
456 1         12 $ptdata = Crypt::OpenPGP::PacketFactory->save($cdata);
457             }
458 23         100 my $key_data = Crypt::OpenPGP::Util::get_random_bytes(32);
459             my $sym_alg = $param{Cipher} ?
460 23 50       462470172 Crypt::OpenPGP::Cipher->alg_id($param{Cipher}) : DEFAULT_CIPHER;
461 23         34 my(@sym_keys);
462 23 100 100     136 if ($param{Recipients} && !ref($param{Recipients})) {
463 3         10 $param{Recipients} = [ $param{Recipients} ];
464             }
465 23 100       84 if (my $kid = delete $param{KeyID}) {
466 4 50       16 my @kid = ref $kid eq 'ARRAY' ? @$kid : $kid;
467 4         6 push @{ $param{Recipients} }, @kid;
  4         18  
468             }
469 23 100 66     152 if ($param{Key} || $param{Recipients}) {
    50          
470 12         489 require Crypt::OpenPGP::SessionKey;
471 12         21 my @keys;
472 12 100       51 if (my $recips = $param{Recipients}) {
473 11 50       63 my @recips = ref $recips eq 'ARRAY' ? @$recips : $recips;
474 11         50 my $ring = $pgp->pubrings->[0];
475 11         19 my %seen;
476             my $server;
477 11         40 my $cfg = $pgp->{cfg};
478 11 50 33     41 if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) {
479 0         0 require Crypt::OpenPGP::KeyServer;
480 0         0 $server = Crypt::OpenPGP::KeyServer->new(
481             Server => $cfg->get('KeyServer'),
482             );
483             }
484 11         32 for my $r (@recips) {
485 15         41 my($lr, @kb) = (length($r));
486 15 100 100     150 if (($lr == 8 || $lr == 16) && $r !~ /[^\da-fA-F]/) {
      66        
487 14         65 my $id = pack 'H*', $r;
488 14 50       84 @kb = $ring->find_keyblock_by_keyid($id) if $ring;
489 14 50 33     74 @kb = $server->find_keyblock_by_keyid($id)
490             if !@kb && $server;
491             } else {
492 1 50       9 @kb = $ring->find_keyblock_by_uid($r) if $ring;
493 1 50 33     8 @kb = $server->find_keyblock_by_uid($r)
494             if !@kb && $server;
495             }
496 15         37 for my $kb (@kb) {
497 15 50       79 next unless my $cert = $kb->encrypting_key;
498 15 100       65 next if $seen{ $cert->key_id }++;
499 14         66 $cert->uid($kb->primary_uid);
500 14         75 push @keys, $cert;
501             }
502             }
503 11 50       51 if (my $cb = $param{RecipientsCallback}) {
504 0         0 @keys = @{ $cb->(\@keys) };
  0         0  
505             }
506             }
507 12 100       39 if ($param{Key}) {
508 0         0 push @keys, ref $param{Key} eq 'ARRAY' ? @{$param{Key}} :
509 1 50       8 $param{Key};
510             }
511 12 50       43 return $pgp->error("No known recipients for encryption")
512             unless @keys;
513 12         32 for my $key (@keys) {
514 15 50       131 push @sym_keys, Crypt::OpenPGP::SessionKey->new(
515             Key => $key,
516             SymKey => $key_data,
517             Cipher => $sym_alg,
518             ) or
519             return $pgp->error( Crypt::OpenPGP::SessionKey->errstr );
520             }
521             }
522             elsif (my $pass = $param{Passphrase}) {
523 11         1509 require Crypt::OpenPGP::SKSessionKey;
524 11         38 require Crypt::OpenPGP::S2k;
525 11         25 my $s2k;
526 11 50 33     39 if ($param{Compat} && $param{Compat} eq 'PGP2') {
527 0         0 $s2k = Crypt::OpenPGP::S2k->new('Simple');
528 0         0 $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5');
529             } else {
530 11         44 $s2k = Crypt::OpenPGP::S2k->new('Salt_Iter');
531             }
532 11 50       42 my $cipher = Crypt::OpenPGP::Cipher->new($sym_alg) or
533             return $pgp->error( Crypt::OpenPGP::Cipher->errstr );
534 11         31 my $keysize = $cipher->keysize;
535 11         39 $key_data = $s2k->generate($pass, $keysize);
536 11 50       83 push @sym_keys, Crypt::OpenPGP::SKSessionKey->new(
537             Passphrase => $pass,
538             SymKey => $key_data,
539             Cipher => $sym_alg,
540             S2k => $s2k,
541             ) or
542             return $pgp->error( Crypt::OpenPGP::SKSessionKey->errstr );
543             } else {
544 0         0 return $pgp->error("Need something to encrypt with");
545             }
546             my $enc = Crypt::OpenPGP::Ciphertext->new(
547             MDC => $param{MDC},
548 23         265 SymKey => $key_data,
549             Data => $ptdata,
550             Cipher => $sym_alg,
551             );
552             my $enc_data = Crypt::OpenPGP::PacketFactory->save(
553 23 50 33     259 $param{Passphrase} && $param{Compat} && $param{Compat} eq 'PGP2' ?
554             $enc : (@sym_keys, $enc)
555             );
556 23 100       97 if ($param{Armour}) {
557 1         583 require Crypt::OpenPGP::Armour;
558 1 50       6 $enc_data = Crypt::OpenPGP::Armour->armour(
559             Data => $enc_data,
560             Object => 'MESSAGE',
561             ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr );
562             }
563 23         402 $enc_data;
564             }
565              
566             sub decrypt {
567 23     23 1 11285 my $pgp = shift;
568 23         104 my %param = @_;
569 23         44 my $wants_verify = wantarray;
570 23         40 my($data);
571 23 50       93 unless ($data = $param{Data}) {
572             my $file = $param{Filename} or
573 0 0       0 return $pgp->error("Need either 'Data' or 'Filename' to decrypt");
574 0 0       0 $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
575             }
576 23 50       202 my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
577             return $pgp->error("Reading data packets failed: " .
578             Crypt::OpenPGP::Message->errstr);
579 23         84 my @pieces = $msg->pieces;
580 23 50       73 return $pgp->error("No packets found in message") unless @pieces;
581 23         93 while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') {
582 0         0 shift @pieces;
583             }
584 23         29 my($key, $alg);
585 23 100       120 if (ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey') {
    50          
586 12         27 my($sym_key, $cert, $ring) = (shift @pieces);
587 12 100       49 unless ($cert = $param{Key}) {
588 9 50       42 $ring = $pgp->secrings->[0]
589             or return $pgp->error("No secret keyrings");
590             }
591 12         27 my($kb);
592 12         43 while (ref($sym_key) eq 'Crypt::OpenPGP::SessionKey') {
593 14 100       35 if ($cert) {
594 4 100       24 if ($cert->key_id eq $sym_key->key_id) {
595             shift @pieces
596 3         16 while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey';
597 3         6 last;
598             }
599             } else {
600 10 100       44 if ($kb = $ring->find_keyblock_by_keyid($sym_key->key_id)) {
601             shift @pieces
602 9         40 while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey';
603 9         18 last;
604             }
605             }
606 2         12 $sym_key = shift @pieces;
607             }
608 12 50 66     77 return $pgp->error("Can't find a secret key to decrypt message")
609             unless $kb || $cert;
610 12 100       54 if ($kb) {
611 9         53 $cert = $kb->encrypting_key;
612 9         44 $cert->uid($kb->primary_uid);
613             }
614 12 100       64 if ($cert->is_protected) {
615 1         7 my $pass = $param{Passphrase};
616 1 50 33     5 if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
617 0         0 $pass = $cb->($cert);
618             }
619 1 50       5 return $pgp->error("Need passphrase to unlock secret key")
620             unless $pass;
621 1 50       6 $cert->unlock($pass) or
622             return $pgp->error("Seckey unlock failed: " . $cert->errstr);
623             }
624 12 50       71 ($key, $alg) = $sym_key->decrypt($cert) or
625             return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr);
626             }
627             elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::SKSessionKey') {
628 11         17 my $sym_key = shift @pieces;
629 11         19 my $pass = $param{Passphrase};
630 11 50 33     51 if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
631 0         0 $pass = $cb->();
632             }
633 11 50       23 return $pgp->error("Need passphrase to decrypt session key")
634             unless $pass;
635 11 50       32 ($key, $alg) = $sym_key->decrypt($pass) or
636             return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr);
637             }
638 23         58 my $enc = $pieces[0];
639              
640             ## If there is still no symkey and symmetric algorithm, *and* the
641             ## first packet is a Crypt::OpenPGP::Ciphertext packet, assume that
642             ## the packet is encrypted using a symmetric key, using a 'Simple' s2k.
643 23 50 33     113 if (!$key && !$alg && ref($enc) eq 'Crypt::OpenPGP::Ciphertext') {
      33        
644             my $pass = $param{Passphrase} or
645 0 0       0 return $pgp->error("Need passphrase to decrypt session key");
646 0         0 require Crypt::OpenPGP::Cipher;
647 0         0 require Crypt::OpenPGP::S2k;
648 0         0 my $ciph = Crypt::OpenPGP::Cipher->new('IDEA');
649 0         0 my $s2k = Crypt::OpenPGP::S2k->new('Simple');
650 0         0 $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5');
651 0         0 $key = $s2k->generate($pass, $ciph->keysize);
652 0         0 $alg = $ciph->alg_id;
653             }
654              
655 23 50       138 $data = $enc->decrypt($key, $alg) or
656             return $pgp->error("Ciphertext decrypt failed: " . $enc->errstr);
657              
658             ## This is a special hack: if decrypt gets a signed, encrypted message,
659             ## it needs to be able to pass back the decrypted text *and* a flag
660             ## saying whether the signature is valid or not. But in some cases,
661             ## you don't know ahead of time if there is a signature at all--and if
662             ## there isn't, there is no way of knowing whether the signature is valid,
663             ## or if there isn't a signature at all. So this prepopulates the internal
664             ## errstr with the string "No Signature\n"--if there is a signature, and
665             ## there is an error during verification, the second return value will be
666             ## undef, and the errstr will contain the error that occurred. If there is
667             ## *not* a signature, the second return value will still be undef, but
668             ## the errstr is guaranteed to be "No Signature\n".
669 23         137 $pgp->error("No Signature");
670              
671 23         34 my($valid, $sig);
672 23         139 $msg = Crypt::OpenPGP::Message->new( Data => $data,
673             IsPacketStream => 1 );
674 23         202 @pieces = $msg->pieces;
675              
676             ## If the first packet in the decrypted data is compressed,
677             ## decompress it and set the list of packets to the result.
678 23 100       99 if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
679 1 50       5 $data = $pieces[0]->decompress or
680             return $pgp->error("Decompression error: " . $pieces[0]->errstr);
681 1         5 $msg = Crypt::OpenPGP::Message->new( Data => $data,
682             IsPacketStream => 1 );
683 1         5 @pieces = $msg->pieces;
684             }
685              
686 23         40 my($pt);
687 23 100 66     151 if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig' ||
688             ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
689 1         4 $pt = $pieces[1];
690 1 50       5 if ($wants_verify) {
691 1         8 ($valid, $sig) =
692             $pgp->verify( Signature => $data, IsPacketStream => 1 );
693             }
694             } else {
695 22         33 $pt = $pieces[0];
696             }
697              
698 23 100       107 $wants_verify ? ($pt->data, $valid, $sig) : $pt->data;
699             }
700              
701             sub keygen {
702 2     2 1 1830 my $pgp = shift;
703 2         17 my %param = @_;
704 2         749 require Crypt::OpenPGP::Certificate;
705 2         20 require Crypt::OpenPGP::Key;
706 2         22 require Crypt::OpenPGP::KeyBlock;
707 2         822 require Crypt::OpenPGP::Signature;
708 2         782 require Crypt::OpenPGP::UserID;
709              
710             $param{Type} or
711 2 50       17 return $pgp->error("Need a Type of key to generate");
712 2   50     8 $param{Size} ||= 1024;
713 2   50     21 $param{Version} ||= 4;
714 2 100       10 $param{Version} = 3 if $param{Type} eq 'RSA';
715              
716 2         24 my $kb_pub = Crypt::OpenPGP::KeyBlock->new;
717 2         9 my $kb_sec = Crypt::OpenPGP::KeyBlock->new;
718              
719 2         27 my($pub, $sec) = Crypt::OpenPGP::Key->keygen($param{Type}, %param);
720 2 50 33     24 die Crypt::OpenPGP::Key->errstr unless $pub && $sec;
721             my $pubcert = Crypt::OpenPGP::Certificate->new(
722             Key => $pub,
723             Version => $param{Version}
724 2 50       25 ) or
725             die Crypt::OpenPGP::Certificate->errstr;
726             my $seccert = Crypt::OpenPGP::Certificate->new(
727             Key => $sec,
728             Passphrase => $param{Passphrase},
729             Version => $param{Version}
730 2 50       19 ) or
731             die Crypt::OpenPGP::Certificate->errstr;
732 2         15 $kb_pub->add($pubcert);
733 2         11 $kb_sec->add($seccert);
734              
735 2         36 my $id = Crypt::OpenPGP::UserID->new( Identity => $param{Identity} );
736 2         12 $kb_pub->add($id);
737 2         9 $kb_sec->add($id);
738              
739             my $sig = Crypt::OpenPGP::Signature->new(
740             Data => [ $pubcert, $id ],
741             Key => $seccert,
742             Version => $param{Version},
743 2         32 Type => 0x13,
744             );
745 2         15 $kb_pub->add($sig);
746 2         6 $kb_sec->add($sig);
747              
748 2         22 ($kb_pub, $kb_sec);
749             }
750              
751             sub _read_files {
752 1     1   3 my $pgp = shift;
753 1 50       4 return $pgp->error("No files specified") unless @_;
754 1         3 my @files = @_;
755 1         2 my $data = '';
756 1         6 for my $file (@files) {
757 1   50     9 $file ||= '';
758 1         4 local *FH;
759 1 50       43 open FH, $file or return $pgp->error("Error opening $file: $!");
760 0         0 binmode FH;
761 0         0 { local $/; $data .= <FH> }
  0         0  
  0         0  
762 0 0       0 close FH or warn "Warning: Got error closing $file: $!";
763             }
764 0         0 $data;
765             }
766              
767             {
768             my @MERGE_CONFIG = qw( Cipher Armour Digest );
769             sub _merge_compat {
770 29     29   60 my $pgp = shift;
771 29         71 my($param, $meth) = @_;
772 29   50     263 my $compat = $param->{Compat} || $pgp->{cfg}->get('Compat') || return 1;
773 0 0         my $ref = $COMPAT{$compat}{$meth} or
774             return $pgp->error("No settings for Compat class '$compat'");
775 0           for my $arg (keys %$ref) {
776 0 0         $param->{$arg} = $ref->{$arg} unless exists $param->{$arg};
777             }
778 0           for my $key (@MERGE_CONFIG) {
779             $param->{$key} = $pgp->{cfg}->get($key)
780 0 0         unless exists $param->{$key};
781             }
782 0           1;
783             }
784             }
785              
786             1;
787              
788             __END__
789              
790             =head1 NAME
791              
792             Crypt::OpenPGP - Pure-Perl OpenPGP implementation
793              
794             =head1 SYNOPSIS
795              
796             my $pgp = Crypt::OpenPGP->new;
797              
798             # Given an input stream (could be a signature, ciphertext, etc),
799             # do the "right thing" to it.
800             my $message_body; $message_body .= $_ while <STDIN>;
801             my $result = $pgp->handle( Data => $message_body );
802              
803             # Create a detached, ASCII-armoured signature of $file using the
804             # secret key $key_id, protected with the passphrase $pass.
805             my $file = 'really-from-me.txt';
806             my $key_id = '...';
807             my $pass = 'foo bar';
808             my $signature = $pgp->sign(
809             Filename => $file,
810             KeyID => $key_id,
811             Passphrase => $pass,
812             Detach => 1,
813             Armour => 1,
814             );
815              
816             # Verify the detached signature $signature, which should be of the
817             # source file $file.
818             my $is_valid = $pgp->verify(
819             Signature => $signature,
820             Files => [ $file ],
821             );
822              
823             # Using the public key associated with $key_id, encrypt the contents
824             # of the file $file, and ASCII-armour the ciphertext.
825             my $ciphertext = $pgp->encrypt(
826             Filename => $file,
827             Recipients => $key_id,
828             Armour => 1,
829             );
830              
831             # Decrypt $ciphertext using the secret key used to encrypt it,
832             # which key is protected with the passphrase $pass.
833             my $plaintext = $pgp->decrypt(
834             Data => $ciphertext,
835             Passphrase => $pass,
836             );
837              
838             =head1 DESCRIPTION
839              
840             I<Crypt::OpenPGP> is a pure-Perl implementation of the OpenPGP
841             standard[1]. In addition to support for the standard itself,
842             I<Crypt::OpenPGP> claims compatibility with many other PGP implementations,
843             both those that support the standard and those that preceded it.
844              
845             I<Crypt::OpenPGP> provides signing/verification, encryption/decryption,
846             keyring management, and key-pair generation; in short it should provide
847             you with everything you need to PGP-enable yourself. Alternatively it
848             can be used as part of a larger system; for example, perhaps you have
849             a web-form-to-email generator written in Perl, and you'd like to encrypt
850             outgoing messages, because they contain sensitive information.
851             I<Crypt::OpenPGP> can be plugged into such a scenario, given your public
852             key, and told to encrypt all messages; they will then be readable only
853             by you.
854              
855             This module currently supports C<RSA> and C<DSA> for digital signatures,
856             and C<RSA> and C<ElGamal> for encryption/decryption. It supports the
857             symmetric ciphers C<3DES>, C<Blowfish>, C<IDEA>, C<Twofish>, C<CAST5>, and
858             C<Rijndael> (C<AES>). C<Rijndael> is supported for key sizes of C<128>,
859             C<192>, and C<256> bits. I<Crypt::OpenPGP> supports the digest algorithms
860             C<MD5>, C<SHA-1>, and C<RIPE-MD/160>. And it supports C<ZIP> and C<Zlib>
861             compression.
862              
863             =head1 COMPATIBILITY
864              
865             One of the highest priorities for I<Crypt::OpenPGP> is compatibility with
866             other PGP implementations, including PGP implementations that existed
867             before the OpenPGP standard.
868              
869             As a means towards that end, some of the high-level I<Crypt::OpenPGP>
870             methods can be used in compatibility mode; given an argument I<Compat>
871             and a PGP implementation with which they should be compatible, these
872             method will do their best to choose ciphers, digest algorithms, etc. that
873             are compatible with that implementation. For example, PGP2 only supports
874             C<IDEA> encryption, C<MD5> digests, and version 3 signature formats; if
875             you tell I<Crypt::OpenPGP> that it must be compatible with PGP2, it will
876             only use these algorithms/formats when encrypting and signing data.
877              
878             To use this feature, supply either I<sign> or I<encrypt> with the
879             I<Compat> parameter, giving it one of the values from the list below.
880             For example:
881              
882             my $ct = $pgp->encrypt(
883             Compat => 'PGP2',
884             Filename => 'foo.pl',
885             Recipients => $key_id,
886             );
887              
888             Because I<PGP2> was specified, the data will automatically be encrypted
889             using the C<IDEA> cipher, and will be compressed using C<ZIP>.
890              
891             Here is a list of the current compatibility sets and the algorithms and
892             formats they support.
893              
894             =over 4
895              
896             =item * PGP2
897              
898             Encryption: symmetric cipher = C<IDEA>, compression = C<ZIP>,
899             modification detection code (MDC) = C<0>
900              
901             Signing: digest = C<MD5>, packet format = version 3
902              
903             =item * PGP5
904              
905             Encryption: symmetric cipher = C<3DES>, compression = C<ZIP>,
906             modification detection code (MDC) = C<0>
907              
908             Signing: digest = C<SHA-1>, packet format = version 3
909              
910             =item * GnuPG
911              
912             Encryption: symmetric cipher = C<Rijndael>, compression = C<Zlib>,
913             modification detection code (MDC) = C<1>
914              
915             Signing: digest = C<RIPE-MD/160>, packet format = version 4
916              
917             =back
918              
919             If the compatibility setting is unspecified (that is, if no I<Compat>
920             argument is supplied), the settings (ciphers, digests, etc.) fall
921             back to their default settings.
922              
923             =head1 USAGE
924              
925             I<Crypt::OpenPGP> has the following high-level interface. On failure,
926             all methods will return C<undef> and set the I<errstr> for the object;
927             look below at the I<ERROR HANDLING> section for more information.
928              
929             =head2 Crypt::OpenPGP->new( %args )
930              
931             Constructs a new I<Crypt::OpenPGP> instance and returns that object.
932             Returns C<undef> on failure.
933              
934             I<%args> can contain:
935              
936             =over 4
937              
938             =item * Compat
939              
940             The compatibility mode for this I<Crypt::OpenPGP> object. This value will
941             propagate down into method calls upon this object, meaning that it will be
942             applied for all method calls invoked on this object. For example, if you set
943             I<Compat> here, you do not have to set it again when calling I<encrypt>
944             or I<sign> (below), unless, of course, you want to set I<Compat> to a
945             different value for those methods.
946              
947             I<Compat> influences several factors upon object creation, unless otherwise
948             overridden in the constructor arguments: if you have a configuration file
949             for this compatibility mode (eg. F<~/.gnupg/options> for GnuPG), it will
950             be automatically read in, and I<Crypt::OpenPGP> will set any options
951             relevant to its execution (symmetric cipher algorithm, etc.); I<PubRing>
952             and I<SecRing> (below) are set according to the default values for this
953             compatibility mode (eg. F<~/.gnupg/pubring.gpg> for the GnuPG public
954             keyring).
955              
956             =item * SecRing
957              
958             Path to your secret keyring. If unspecified, I<Crypt::OpenPGP> will look
959             for your keyring in a number of default places.
960              
961             As an alternative to passing in a path to the keyring file, you can pass in
962             a I<Crypt::OpenPGP::KeyRing> object representing a secret keyring.
963              
964             =item * PubRing
965              
966             Path to your public keyring. If unspecified, I<Crypt::OpenPGP> will look
967             for your keyring in a number of default places.
968              
969             As an alternative to passing in a path to the keyring file, you can pass in
970             a I<Crypt::OpenPGP::KeyRing> object representing a public keyring.
971              
972             =item * ConfigFile
973              
974             Path to a PGP/GnuPG config file. If specified, you must also pass in a
975             value for the I<Compat> parameter, stating what format config file you are
976             passing in. For example, if you are passing in the path to a GnuPG config
977             file, you should give a value of C<GnuPG> for the I<Compat> flag.
978              
979             If you leave I<ConfigFile> unspecified, but you have specified a value for
980             I<Compat>, I<Crypt::OpenPGP> will try to find your config file, based on
981             the value of I<Compat> that you pass in (eg. F<~/.gnupg/options> if
982             I<Compat> is C<GnuPG>).
983              
984             NOTE: if you do not specify a I<Compat> flag, I<Crypt::OpenPGP> cannot read
985             any configuration files, even if you I<have> specified a value for the
986             I<ConfigFile> parameter, because it will not be able to determine the proper
987             config file format.
988              
989             =item * KeyServer
990              
991             The hostname of the HKP keyserver. You can get a list of keyservers through
992              
993             % host -l pgp.net | grep wwwkeys
994              
995             If I<AutoKeyRetrieve> is set to a true value,
996             keys will be automatically retrieved from the keyserver if they are not found
997             in your local keyring.
998              
999             =item * AutoKeyRetrieve
1000              
1001             If set to a true value, and if I<KeyServer> is set to a keyserver name,
1002             I<encrypt> and I<verify> will automatically try to fetch public keys from
1003             the keyserver if they are not found in your local keyring.
1004              
1005             =back
1006              
1007             =head2 $pgp->handle( %args )
1008              
1009             A do-what-I-mean wrapper around I<decrypt> and I<verify>. Given either a
1010             filename or a block of data--for example, data from an incoming email
1011             message--I<handle> "handles" it as appropriate for whatever encryption or
1012             signing the message contains. For example, if the data is encrypted, I<handle>
1013             will return the decrypted data (after prompting you for the passphrase). If
1014             the data is signed, I<handle> will check the validity of the signature and
1015             return indication of the validity of the signature.
1016              
1017             The return value is a reference to a hash, which may contain the following
1018             keys, depending on the data passed to the method:
1019              
1020             =over 4
1021              
1022             =item * Plaintext
1023              
1024             If the data is encrypted, the decrypted message.
1025              
1026             =item * Validity
1027              
1028             If the data is signed, a true value if the signature is valid, a false value
1029             otherwise. The true value will be either the signer's email address, if
1030             available, or C<1>, if not.
1031              
1032             =item * Signature
1033              
1034             If the data is signed, the I<Crypt::OpenPGP::Signature> object representing
1035             the signature.
1036              
1037             =back
1038              
1039             If an error occurs, the return value will be C<undef>, and the error message
1040             can be obtained by calling I<errstr> on the I<Crypt::OpenPGP> object.
1041              
1042             I<%args> can contain:
1043              
1044             =over 4
1045              
1046             =item * Data
1047              
1048             The data to be "handled". This should be a simple scalar containing an
1049             arbitrary amount of data.
1050              
1051             I<Data> is optional; if unspecified, you should specify a filename (see
1052             I<Filename>, below).
1053              
1054             =item * Filename
1055              
1056             The path to a file to "handle".
1057              
1058             I<Filename> is optional; if unspecified, you should specify the data
1059             in I<Data>, above. If both I<Data> and I<Filename> are specified, the
1060             data in I<Data> overrides that in I<Filename>.
1061              
1062             =item * PassphraseCallback
1063              
1064             If the data is encrypted, you will need to supply I<handle> with the proper
1065             passphrase to unlock the private key, or the password to decrypt the
1066             symmetrically-encrypted data (depending on the method of encryption used).
1067             If you do not specify this parameter, this default passphrase callback will be
1068             used:
1069              
1070             sub _default_passphrase_cb {
1071             my($cert) = @_;
1072             my $prompt;
1073             if ($cert) {
1074             $prompt = sprintf qq(
1075             You need a passphrase to unlock the secret key for
1076             user "%s".
1077             %d-bit %s key, ID %s
1078            
1079             Enter passphrase: ), $cert->uid,
1080             $cert->key->size,
1081             $cert->key->alg,
1082             substr($cert->key_id_hex, -8, 8);
1083             } else {
1084             $prompt = "Enter passphrase: ";
1085             }
1086             _prompt($prompt, '', 1);
1087             }
1088              
1089             If you do specify this parameter, make sure that your callback function can
1090             handle both asymmetric and symmetric encryption.
1091              
1092             See the I<PassphraseCallback> parameter for I<decrypt>, below.
1093              
1094             =back
1095              
1096             =head2 $pgp->encrypt( %args )
1097              
1098             Encrypts a block of data. The encryption is actually done with a symmetric
1099             cipher; the key for the symmetric cipher is then encrypted with either
1100             the public key of the recipient or using a passphrase that you enter. The
1101             former case is using public-key cryptography, the latter, standard
1102             symmetric ciphers. In the first case, the session key can only be
1103             unlocked by someone with the corresponding secret key; in the second, it
1104             can only be unlocked by someone who knows the passphrase.
1105              
1106             Given the parameter I<SignKeyID> (see below), I<encrypt> will first sign
1107             the message before encrypting it, adding a Signature packet to the
1108             encrypted plaintext.
1109              
1110             Returns a block of data containing two PGP packets: the encrypted
1111             symmetric key and the encrypted data.
1112              
1113             On failure returns C<undef>.
1114              
1115             I<%args> can contain:
1116              
1117             =over 4
1118              
1119             =item * Compat
1120              
1121             Specifies the PGP compatibility setting. See I<COMPATIBILITY>, above.
1122              
1123             =item * Data
1124              
1125             The plaintext to be encrypted. This should be a simple scalar containing
1126             an arbitrary amount of data.
1127              
1128             I<Data> is optional; if unspecified, you should specify a filename (see
1129             I<Filename>, below).
1130              
1131             =item * Filename
1132              
1133             The path to a file to encrypt.
1134              
1135             I<Filename> is optional; if unspecified, you should specify the data
1136             in I<Data>, above. If both I<Data> and I<Filename> are specified, the
1137             data in I<Data> overrides that in I<Filename>.
1138              
1139             =item * Recipients
1140              
1141             The intended recipients of the encrypted message. In other words,
1142             either the key IDs or user IDs of the public keys that should be used
1143             to encrypt the message. Each recipient specified should be either a
1144             key ID--an 8-digit or 16-digit hexadecimal number--or part of a user
1145             ID that can be used to look up the user's public key in your keyring.
1146             Examples:
1147              
1148             8-digit hex key ID: 123ABC45
1149             16-digit hex key ID: 678DEF90123ABC45
1150             (Part of) User ID: foo@bar
1151              
1152             Note that the 8-digit hex key ID is the last 8 digits of the (long)
1153             16-digit hex key ID.
1154              
1155             If you wish to encrypt the message for multiple recipients, the value
1156             of I<Recipients> should be a reference to a list of recipients (as
1157             defined above). For each recipient in the list, the public key will be
1158             looked up in your public keyring, and an encrypted session key packet
1159             will be added to the encrypted message.
1160              
1161             This argument is optional; if not provided you should provide the
1162             I<Passphrase> option (below) to perform symmetric-key encryption when
1163             encrypting the session key.
1164              
1165             =item * KeyID
1166              
1167             A deprecated alias for I<Recipients> (above). There is no need to use
1168             I<KeyID>, as its functionality has been completely subsumed into the
1169             I<Recipients> parameter.
1170              
1171             =item * Passphrase
1172              
1173             The mechanism to use symmetric-key, or "conventional", encryption,
1174             when encrypting the session key. In other words, this allows you to
1175             use I<Crypt::OpenPGP> for encryption/decryption without using public-key
1176             cryptography; this can be useful in certain circumstances (for example,
1177             when encrypting data locally on disk).
1178              
1179             This argument is optional; if not provided you should provide the
1180             I<Recipients> option (above) to perform public-key encryption when
1181             encrypting the session key.
1182              
1183             =item * RecipientsCallback
1184              
1185             After the list of recipients for a message (as given in I<Recipients>,
1186             above) has been mapped into a set of keys from your public keyring,
1187             you can use I<RecipientsCallback> to review/modify that list of keys.
1188             The value of I<RecipientsCallback> should be a reference to a
1189             subroutine; when invoked that routine will be handed a reference to
1190             an array of I<Crypt::OpenPGP::Certificate> objects. It should then
1191             return a reference to a list of such objects.
1192              
1193             This can be useful particularly when supplying user IDs in the list
1194             of I<Recipients> for an encrypted message. Since user IDs are looked
1195             up using partial matches (eg. I<b> could match I<b>, I<abc>, I<bar>,
1196             etc.), one intended recipient may actually turn up multiple keys.
1197             You can use I<RecipientsCallback> to audit that list before actually
1198             encrypting the message:
1199              
1200             my %BAD_KEYS = (
1201             ABCDEF1234567890 => 1,
1202             1234567890ABCDEF => 1,
1203             );
1204             my $cb = sub {
1205             my $keys = shift;
1206             my @return;
1207             for my $cert (@$keys) {
1208             push @return, $cert unless $BAD_KEYS{ $cert->key_id_hex };
1209             }
1210             \@returns;
1211             };
1212             my $ct = $pgp->encrypt( ..., RecipientsCallback => $cb, ... );
1213              
1214             =item * Cipher
1215              
1216             The name of a symmetric cipher with which the plaintext will be
1217             encrypted. Valid arguments are C<DES3>, C<CAST5>, C<Blowfish>, C<IDEA>,
1218             C<Twofish>, C<Rijndael>, C<Rijndael192>, and C<Rijndael256> (the last
1219             two are C<Rijndael> with key sizes of 192 and 256 bits, respectively).
1220              
1221             This argument is optional; if you have provided a I<Compat> parameter,
1222             I<Crypt::OpenPGP> will use the appropriate cipher for the supplied
1223             compatibility mode. Otherwise, I<Crypt::OpenPGP> currently defaults to
1224             C<DES3>; this could change in the future.
1225              
1226             =item * Compress
1227              
1228             The name of a compression algorithm with which the plaintext will be
1229             compressed before it is encrypted. Valid values are C<ZIP> and
1230             C<Zlib>.
1231              
1232             By default text is not compressed.
1233              
1234             =item * Armour
1235              
1236             If true, the data returned from I<encrypt> will be ASCII-armoured. This
1237             can be useful when you need to send data through email, for example.
1238              
1239             By default the returned data is not armoured.
1240              
1241             =item * SignKeyID
1242              
1243             If you wish to sign the plaintext message before encrypting it, provide
1244             I<encrypt> with the I<SignKeyID> parameter and give it a key ID with
1245             which the message can be signed. This allows recipients of your message
1246             to verify its validity.
1247              
1248             By default messages not signed.
1249              
1250             =item * SignPassphrase
1251              
1252             The passphrase to unlock the secret key to be used when signing the
1253             message.
1254              
1255             If you are signing the message--that is, if you have provided the
1256             I<SignKeyID> parameter--either this argument or I<SignPassphraseCallback>
1257             is required.
1258              
1259             =item * SignPassphraseCallback
1260              
1261             The callback routine to enable the passphrase being passed in through
1262             some user-defined routine. See the I<PassphraseCallback> parameter for
1263             I<sign>, below.
1264              
1265             If you are signing the message--that is, if you have provided the
1266             I<SignKeyID> parameter--either this argument or I<SignPassphrase> is
1267             required.
1268              
1269             =item * MDC
1270              
1271             When set to a true value, instructs I<encrypt> to use encrypted MDC
1272             (modification detection code) packets instead of standard encrypted
1273             data packets. These are a newer form of encrypted data packets that
1274             are followed by a C<SHA-1> hash of the plaintext data. This prevents
1275             attacks that modify the encrypted text by using a message digest to
1276             detect changes.
1277              
1278             By default I<MDC> is set to C<0>, and I<encrypt> generates standard
1279             encrypted data packets. Set it to a true value to turn on MDC packets.
1280             Note that I<MDC> will automatically be turned on if you are using a
1281             I<Compat> mode that is known to support it.
1282              
1283             =back
1284              
1285             =head2 $pgp->decrypt( %args )
1286              
1287             Decrypts a block of ciphertext. The ciphertext should be of the sort
1288             returned from I<encrypt>, in either armoured or non-armoured form.
1289             This is compatible with all other implementations of PGP: the output
1290             of their encryption should serves as the input to this method.
1291              
1292             When called in scalar context, returns the plaintext (that is, the
1293             decrypted ciphertext), or C<undef> on failure. When called in list
1294             context, returns a three-element list containing the plaintext and the
1295             result of signature verification (see next paragraph), or the empty
1296             list on failure. Either of the failure conditions listed here indicates
1297             that decryption failed.
1298              
1299             If I<decrypt> is called in list context, and the encrypted text
1300             contains a signature over the plaintext, I<decrypt> will attempt to
1301             verify the signature and will return the result of that verification
1302             as the second element in the return list, and the actual
1303             I<Crypt::OpenPGP::Signature> object as the third element in the return
1304             list. If you call I<decrypt> in
1305             list context and the ciphertext does I<not> contain a signature, that
1306             second element will be C<undef>, and the I<errstr> will be set to
1307             the string C<No Signature\n>. The second element in the return list can
1308             have one of three possible values: C<undef>, meaning that either an
1309             error occurred in verifying the signature, I<or> the ciphertext did
1310             not contain a signature; C<0>, meaning that the signature is invalid;
1311             or a true value of either the signer's user ID or C<1>, if the user ID
1312             cannot be determined. Note that these are the same values returned from
1313             I<verify> (below).
1314              
1315             For example, to decrypt a message that may contain a signature that you
1316             want verified, you might use code like this:
1317              
1318             my($pt, $valid, $sig) = $pgp->decrypt( ... );
1319             die "Decryption failed: ", $pgp->errstr unless $pt;
1320             die "Signature verification failed: ", $pgp->errstr
1321             unless defined $valid || $pgp->errstr !~ /^No Signature/;
1322             print "Signature created at ", $sig->timestamp, "\n";
1323              
1324             This checks for errors in decryption, as well as errors in signature
1325             verification, excluding the error denoting that the plaintext was
1326             not signed.
1327              
1328             I<%args> can contain:
1329              
1330             =over 4
1331              
1332             =item * Data
1333              
1334             The ciphertext to be decrypted. This should be a simple scalar containing
1335             an arbitrary amount of data.
1336              
1337             I<Data> is optional; if unspecified, you should specify a filename (see
1338             I<Filename>, below).
1339              
1340             =item * Filename
1341              
1342             The path to a file to decrypt.
1343              
1344             I<Filename> is optional; if unspecified, you should specify the data
1345             in I<Data>, above. If both I<Data> and I<Filename> are specified, the
1346             data in I<Data> overrides that in I<Filename>.
1347              
1348             =item * Passphrase
1349              
1350             The passphrase to unlock your secret key, or to decrypt a
1351             symmetrically-encrypted message; the usage depends on how the message is
1352             encrypted.
1353              
1354             This argument is optional if your secret key is protected; if not
1355             provided you should supply the I<PassphraseCallback> parameter (below).
1356              
1357             =item * PassphraseCallback
1358              
1359             A callback routine to allow interactive users (for example) to enter the
1360             passphrase for the specific key being used to decrypt the ciphertext, or
1361             the passphrase used to encrypt a symmetrically-encrypted message. This
1362             is useful when your ciphertext is encrypted to several recipients, if
1363             you do not necessarily know ahead of time the secret key that will be used
1364             to decrypt it. It is also useful when you wish to provide an interactive
1365             user with some feedback about the key being used to decrypt the message,
1366             or when you don't know what type of encryption (symmetric or public-key)
1367             will be used to encrypt a message.
1368              
1369             The value of this parameter should be a reference to a subroutine. This
1370             routine will be called when a passphrase is needed from the user, and
1371             it will be given either zero arguments or one argument, depending on
1372             whether the message is encrypted symmetrically (zero arguments) or using
1373             public-key encryption (one argument). If the latter, the one argument is
1374             a I<Crypt::OpenPGP::Certificate> object representing the secret key. You
1375             can use the information in this object to present details about the key to
1376             the user.
1377              
1378             In either case, the callback routine should return the passphrase, a
1379             scalar string.
1380              
1381             Your callback routine can use the number of arguments to determine how to
1382             prompt the user for a passphrase; for example:
1383              
1384             sub passphrase_cb {
1385             if (my $cert = $_[0]) {
1386             printf "Enter passphrase for secret key %s: ",
1387             $cert->key_id_hex;
1388             } else {
1389             print "Enter passphrase: ";
1390             }
1391             }
1392              
1393             This argument is optional if your secret key is protected; if not
1394             provided you should supply the I<Passphrase> parameter (above).
1395              
1396             =back
1397              
1398             =head2 $pgp->sign( %args )
1399              
1400             Creates and returns a digital signature on a block of data.
1401              
1402             On failure returns C<undef>.
1403              
1404             I<%args> can contain:
1405              
1406             =over 4
1407              
1408             =item * Compat
1409              
1410             Specifies the PGP compatibility setting. See I<COMPATIBILITY>, above.
1411              
1412             =item * Data
1413              
1414             The text to be signed. This should be a simple scalar containing an
1415             arbitrary amount of data.
1416              
1417             I<Data> is optional; if unspecified, you should specify a filename (see
1418             I<Filename>, below).
1419              
1420             =item * Filename
1421              
1422             The path to a file to sign.
1423              
1424             I<Filename> is optional; if unspecified, you should specify the data
1425             in I<Data>, above. If both I<Data> and I<Filename> are specified, the
1426             data in I<Data> overrides that in I<Filename>.
1427              
1428             =item * Detach
1429              
1430             If set to a true value the signature created will be a detached
1431             signature; that is, a signature that does not contain the original
1432             text. This assumes that the person who will be verifying the signature
1433             can somehow obtain the original text (for example, if you sign the text
1434             of an email message, the original text is the message).
1435              
1436             By default signatures are not detached.
1437              
1438             =item * Armour
1439              
1440             If true, the data returned from I<sign> will be ASCII-armoured. This
1441             can be useful when you need to send data through email, for example.
1442              
1443             By default the returned signature is not armoured.
1444              
1445             =item * Clearsign
1446              
1447             If true, the signature created on the data is a clear-text signature.
1448             This form of signature displays the clear text of the signed data,
1449             followed by the ASCII-armoured signature on that data. Such a format
1450             is desirable when sending signed messages to groups of users who may
1451             or may not have PGP, because it allows the text of the message to be
1452             readable without special software.
1453              
1454             When I<Clearsign> is set to true, I<Armour> and I<Detach> are
1455             automatically turned on, because the signature created is a detached,
1456             armoured signature.
1457              
1458             By default I<Clearsign> is false.
1459              
1460             =item * KeyID
1461              
1462             The ID of the secret key that should be used to sign the message. The
1463             value of the key ID should be specified as a 16-digit hexadecimal number.
1464              
1465             This argument is mandatory.
1466              
1467             =item * Passphrase
1468              
1469             The passphrase to unlock your secret key.
1470              
1471             This argument is optional if your secret key is protected; if not
1472             provided you should supply the I<PassphraseCallback> parameter (below).
1473              
1474             =item * PassphraseCallback
1475              
1476             A callback routine to allow interactive users (for example) to enter the
1477             passphrase for the specific key being used to sign the message. This is
1478             useful when you wish to provide an interactive user with some feedback
1479             about the key being used to sign the message.
1480              
1481             The value of this parameter should be a reference to a subroutine. This
1482             routine will be called when a passphrase is needed from the user, and
1483             it will be given one argument: a I<Crypt::OpenPGP::Certificate> object
1484             representing the secret key. You can use the information in this object
1485             to present details about the key to the user. The callback routine
1486             should return the passphrase, a scalar string.
1487              
1488             This argument is optional if your secret key is protected; if not
1489             provided you should supply the I<Passphrase> parameter (above).
1490              
1491             =item * Digest
1492              
1493             The digest algorithm to use when creating the signature; the data to be
1494             signed is hashed by a message digest algorithm, then signed. Possible
1495             values are C<MD5>, C<SHA1>, and C<RIPEMD160>.
1496              
1497             This argument is optional; if not provided, the digest algorithm will be
1498             set based on the I<Compat> setting provided to I<sign> or I<new>. If you
1499             have not provided a I<Compat> setting, I<SHA1> will be used.
1500              
1501             =item * Version
1502              
1503             The format version of the created signature. The two possible values
1504             are C<3> and C<4>; version 4 signatures will not be compatible with
1505             older PGP implementations.
1506              
1507             The default value is C<4>, although this could change in the future.
1508              
1509             =back
1510              
1511             =head2 $pgp->verify( %args )
1512              
1513             Verifies a digital signature. Returns true for a valid signature, C<0>
1514             for an invalid signature, and C<undef> if an error occurs (in which
1515             case you should call I<errstr> to determine the source of the error).
1516             The 'true' value returned for a successful signature will be, if available,
1517             the PGP User ID of the person who created the signature. If that
1518             value is unavailable, the return value will be C<1>.
1519              
1520             If called in list context, the second element returned in the return list
1521             will be the I<Crypt::OpenPGP::Signature> object representing the actual
1522             signature.
1523              
1524             I<%args> can contain:
1525              
1526             =over 4
1527              
1528             =item * Signature
1529              
1530             The signature data, as returned from I<sign>. This data can be either
1531             a detached signature or a non-detached signature. If the former, you
1532             will need to specify the list of files comprising the original signed
1533             data (see I<Data> or I<Files>, below).
1534              
1535             Either this argument or I<SigFile> is required.
1536              
1537             =item * SigFile
1538              
1539             The path to a file containing the signature data. This data can be either
1540             a detached signature or a non-detached signature. If the former, you
1541             will need to specify the list of files comprising the original signed
1542             data (see I<Data> or I<Files>, below).
1543              
1544             Either this argument or I<SigFile> is required.
1545              
1546             =item * Data
1547              
1548             Specifies the original signed data.
1549              
1550             If the signature (in either I<Signature> or I<SigFile>) is a detached
1551             signature, either I<Data> or I<Files> is a mandatory argument.
1552              
1553             =item * Files
1554              
1555             Specifies a list of files comprising the original signed data. The
1556             value should be a reference to a list of file paths; if there is only
1557             one file, the value can be specified as a scalar string, rather than
1558             a reference to a list.
1559              
1560             If the signature (in either I<Signature> or I<SigFile>) is a detached
1561             signature, either I<Data> or I<Files> is a mandatory argument.
1562              
1563             =back
1564              
1565             =head2 $pgp->keygen( %args )
1566              
1567             NOTE: this interface is alpha and could change in future releases!
1568              
1569             Generates a public/secret PGP keypair. Returns two keyblocks (objects
1570             of type I<Crypt::OpenPGP::KeyBlock>), a public and a secret keyblock,
1571             respectively. A keyblock is essentially a block of keys, subkeys,
1572             signatures, and user ID PGP packets.
1573              
1574             I<%args> can contain:
1575              
1576             =over 4
1577              
1578             =item * Type
1579              
1580             The type of key to generate. Currently there are two valid values:
1581             C<RSA> and C<DSA>. C<ElGamal> key generation is not supported at the
1582             moment.
1583              
1584             This is a required argument.
1585              
1586             =item * Size
1587              
1588             Bitsize of the key to be generated. This should be an even integer;
1589             there is no low end currently implemented in I<Crypt::OpenPGP>, but
1590             for the sake of security I<Size> should be at least 1024 bits.
1591              
1592             This is a required argument.
1593              
1594             =item * Identity
1595              
1596             A string that identifies the owner of the key. Typically this is the
1597             combination of the user's name and an email address; for example,
1598              
1599             Foo Bar <foo@bar.com>
1600              
1601             The I<Identity> is used to build a User ID packet that is stored in
1602             each of the returned keyblocks.
1603              
1604             This is a required argument.
1605              
1606             =item * Passphrase
1607              
1608             String with which the secret key will be encrypted. When read in from
1609             disk, the key can then only be unlocked using this string.
1610              
1611             This is a required argument.
1612              
1613             =item * Version
1614              
1615             Specifies the key version; defaults to version C<4> keys. You should
1616             only set this to version C<3> if you know why you are doing so (for
1617             backwards compatibility, most likely). Version C<3> keys only support
1618             RSA.
1619              
1620             =item * Verbosity
1621              
1622             Set to a true value to enable a status display during key generation;
1623             since key generation is a relatively lengthy process, it is helpful
1624             to have an indication that some action is occurring.
1625              
1626             I<Verbosity> is 0 by default.
1627              
1628             =back
1629              
1630             =head1 ERROR HANDLING
1631              
1632             If an error occurs in any of the above methods, the method will return
1633             C<undef>. You should then call the method I<errstr> to determine the
1634             source of the error:
1635              
1636             $pgp->errstr
1637              
1638             In the case that you do not yet have a I<Crypt::OpenPGP> object (that
1639             is, if an error occurs while creating a I<Crypt::OpenPGP> object),
1640             the error can be obtained as a class method:
1641              
1642             Crypt::OpenPGP->errstr
1643              
1644             For example, if you try to decrypt some encrypted text, and you do
1645             not give a passphrase to unlock your secret key:
1646              
1647             my $pt = $pgp->decrypt( Filename => "encrypted_data" )
1648             or die "Decryption failed: ", $pgp->errstr;
1649              
1650             =head1 SAMPLES/TUTORIALS
1651              
1652             Take a look at F<bin/pgplet> for an example of usage of I<Crypt::OpenPGP>.
1653             It gives you an example of using the four main major methods (I<encrypt>,
1654             I<sign>, I<decrypt>, and I<verify>), as well as the various parameters to
1655             those methods. It also demonstrates usage of the callback parameters (eg.
1656             I<PassphraseCallback>).
1657              
1658             F<bin/pgplet> currently does not have any documentation, but its interface
1659             mirrors that of I<gpg>.
1660              
1661             =head1 LICENSE
1662              
1663             Crypt::OpenPGP is free software; you may redistribute it and/or modify
1664             it under the same terms as Perl itself.
1665              
1666             =head1 AUTHOR & COPYRIGHT
1667              
1668             Except where otherwise noted, Crypt::OpenPGP is Copyright 2001 Benjamin
1669             Trott, cpan@stupidfool.org. All rights reserved.
1670              
1671             =head1 REFERENCES
1672              
1673             =over 4
1674              
1675             =item 1 RFC4880 - OpenPGP Message Format (2007). http://www.faqs.org/rfcs/rfc4880.html
1676              
1677             =back
1678              
1679             =cut