1# -*-cperl-*-
2#
3# Crypt::GPG - An Object Oriented Interface to GnuPG.
4# Copyright (c) 2000-2007 Ashish Gulhati <crypt-gpg at neomailbox.com>
5#
6# All rights reserved. This code is free software; you can
7# redistribute it and/or modify it under the same terms as Perl
8# itself.
9#
10# $Id: GPG.pm,v 1.64 2014/09/18 12:21:25 ashish Exp $
11
12package Crypt::GPG;
13
14use Carp;
15use Fcntl;
16use strict;
17use English;
18use File::Path;
19use File::Spec ();
20use Date::Parse;
21use File::Temp qw( tempfile tempdir );
22use IPC::Run qw( start pump finish timeout );
23use vars qw( $VERSION $AUTOLOAD );
24
25File::Temp->safe_level( File::Temp::STANDARD );
26( $VERSION ) = '$Revision: 1.64 $' =~ /\s+([\d\.]+)/;
27
28sub new {
29  bless { GPGBIN         =>   '/usr/local/bin/gpg',
30	  FORCEDOPTS     =>   '--no-secmem-warning',
31	  GPGOPTS        =>   '--lock-multiple --compress-algo 1 ' .
32	                      '--cipher-algo cast5 --force-v3-sigs',
33	  VERSION        =>   $VERSION,
34	  DELAY          =>   0,
35	  PASSPHRASE     =>   '',
36	  COMMENT        =>   "Crypt::GPG v$VERSION",
37	  ARMOR          =>   1,
38	  MARGINALS      =>   3,
39	  DETACH         =>   1,
40	  ENCRYPTSAFE    =>   1,
41	  TEXT           =>   1,
42	  SECRETKEY      =>   '',
43	  DEBUG          =>   0,
44	  TMPFILES       =>   'fileXXXXXX',
45	  TMPDIRS        =>   'dirXXXXXX',
46	  TMPDIR         =>   File::Spec->tmpdir(),
47	  TMPSUFFIX      =>   '.dat',
48	  VKEYID         =>   '^.+$',
49	  VRCPT          =>   '^.*$',
50	  VPASSPHRASE    =>   '^.*$',
51	  VCOMMENT       =>   '^.*$',
52	  VNAME          =>   '^[a-zA-Z][\w\.\s\-\_]+$',
53	  VEXPIRE        =>   '^\d+$',
54	  VKEYSZ         =>   '^\d+$',
55	  VKEYTYPE       =>   '^ELG-E$',
56	  VTRUSTLEVEL    =>   '^[1-5]$',
57	  VEMAIL         =>   '^[\w\.\-]+\@[\w\.\-]+\.[A-Za-z]{2,3}$'
58	}, shift;
59}
60
61sub sign {
62  my $self = shift;
63
64  return unless (!$self->secretkey or $self->secretkey =~ /$self->{VKEYID}/)
65    and $self->passphrase =~ /$self->{VPASSPHRASE}/;
66
67  my $detach    = '-b' if $self->detach;
68  my $armor     = '-a' if $self->armor;
69  my @extras    = grep { $_ } ($detach, $armor);
70
71  my @secretkey = ('--default-key', ref($self->secretkey)?$self->secretkey->{ID}:$self->secretkey)
72    if $self->secretkey;;
73
74  my ($tmpfh, $tmpnam) =
75    tempfile( $self->tmpfiles, DIR => $self->tmpdir,
76	      SUFFIX => $self->tmpsuffix, UNLINK => 1);
77
78  my $message = join ('', @_);
79#  $message .= "\n" unless $message =~ /\n$/s;
80  $message =~ s/(?<!\r)\n/\r\n/sg;
81  print $tmpfh $message; close $tmpfh;
82
83  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
84  push (@opts, ('--comment', $self->comment)) if $self->comment;
85  my $signhow = $self->clearsign ? '--clearsign' : '--sign';
86  local $SIG{CHLD} = 'IGNORE';
87
88  my ($in, $out, $err, $in_q, $out_q, $err_q);
89  my $h = start ([$self->gpgbin, @opts, @secretkey,'--no-tty', '--status-fd', '2', '--command-fd',
90		  0, '-o-', $signhow, @extras, $tmpnam], \$in, \$out, \$err, timeout( 30 ));
91  my $skip = 1; my $i = 0;
92  local $SIG{CHLD} = 'IGNORE';
93  local $SIG{PIPE} = 'IGNORE';
94  while ($skip) {
95    pump $h until ($err =~ /NEED_PASSPHRASE (.{16}) (.{16}).*\n/g or
96		   $err =~ /GOOD_PASSPHRASE/g);
97    if ($2) {
98      $in .= $self->passphrase . "\n";
99      pump $h until $err =~ /(GOOD|BAD)_PASSPHRASE/g;
100      if ($1 eq 'GOOD') {
101	$skip = 0;
102      }
103      else {
104	$skip = 0 if $i++ == 2;
105      }
106    }
107    else {
108      finish $h;
109      last;
110    }
111  }
112  finish $h;
113
114  my $info;
115  if ($self->clearsign) {
116    $out =~ /(-----BEGIN PGP SIGNED MESSAGE-----.*-----END PGP SIGNATURE-----)/s;
117    $info = $1;
118  }
119  elsif ($detach) {
120    $out =~ /(-----BEGIN PGP SIGNATURE-----.*-----END PGP SIGNATURE-----)/s;
121    $info = $1;
122  }
123  else {
124    $out =~ /(-----BEGIN PGP MESSAGE-----.*-----END PGP MESSAGE-----)/s;
125    $info = $1;
126  }
127  unlink $tmpnam;
128  return $info;
129}
130
131sub decrypt { shift->verify(@_); }
132
133sub verify {
134  my $self = shift;
135  my ($tmpfh3, $tmpnam3);
136
137  return unless $self->secretkey || $_[1];
138  return unless $self->passphrase =~ /$self->{VPASSPHRASE}/;
139
140  my ($tf, $ts, $td) = ($self->tmpfiles, $self->tmpsuffix, $self->tmpdir);
141  my ($tmpfh, $tmpnam) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
142  my ($tmpfh2, $tmpnam2) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
143
144  my $ciphertext = ref($_[0]) ? join '', @{$_[0]} : $_[0];
145  $ciphertext .= "\n" unless $ciphertext =~ /\n$/s;
146  print $tmpfh $ciphertext; close $tmpfh;
147
148  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
149  push (@opts, ('--comment', $self->comment)) if $self->comment and !$_[1];
150  backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
151
152    local $SIG{CHLD} = 'IGNORE';
153    local $SIG{PIPE} = 'IGNORE';
154
155  my $x;
156  if ($_[1]) {
157    my $message = ref($_[1]) ? join '', @{$_[1]} : $_[1];
158#    $message .= "\n" unless $message =~ /\n$/s;
159    $message =~ s/(?<!\r)\n/\r\n/sg;
160    ($tmpfh3, $tmpnam3) = tempfile ($tf, DIR => $td, SUFFIX => $ts, UNLINK => 1);
161    print $tmpfh3 $message; close $tmpfh3;
162    my $y = $self->gpgbin . " @opts --marginals-needed " . $self->marginals . " --status-fd 1 --logger-fd 1 --command-fd 0 --no-tty --verify $tmpnam $tmpnam3";
163    $x = `$y`;
164  }
165
166  else {
167    my ($in, $out, $err, $in_q, $out_q, $err_q);
168    my $h = start ([$self->gpgbin, @opts, '--marginals-needed', $self->marginals,
169                    '--status-fd', '1', '--command-fd', 0, '--yes', '--no-tty',
170		    '--decrypt', '-o', $tmpnam2, $tmpnam],
171		   \$in, \$out, \$err, timeout( 30 ));
172
173    my $success = 0;
174    my $seckey = (ref($self->secretkey)?$self->secretkey->{ID}:$self->secretkey);
175
176    while (1) {
177      pump $h until ($out =~ /NEED_PASSPHRASE (.{16}) (.{16}).*\n/g
178		     or $out =~ /(GOOD_PASSPHRASE)/g
179		     or $out =~ /(D)(E)(C)RYPTION_FAILED/g or $out =~ /(N)(O)(D)ATA/g
180		     or $out =~ /(SIG_ID)/g
181		     or $out =~ /detached_signature.filename/g
182		    );
183      if ($3) {
184	finish $h;
185	last;
186      }
187      elsif ($2) {
188	if (substr($2,-1,8) eq substr($seckey,-1,8)) {
189	  $in .= $self->passphrase . "\n";
190	  pump $h until $out =~ /(GOOD|BAD)_PASSPHRASE/g;
191	  if ($1 eq 'GOOD') {
192	    $success = 1;
193	    pump $h;
194	    finish $h; $x = $out; last;
195	  }
196	  next;
197	}
198	else {
199	  $out = ''; $in .= "\n";
200	}
201      }
202      elsif ($1) {
203	$success = 1;
204	pump $h;
205	finish $h; $x = $out; last;
206      }
207    }
208
209
210    unless ($success || $_[1]) {
211      close $tmpfh2; unlink ($tmpnam2);
212      return undef;
213    }
214  }
215
216  my $plaintext = join ('',<$tmpfh2>) || '';
217  close $tmpfh2; unlink ($tmpnam2);
218
219  return ($plaintext)
220    unless $x =~ /(GOOD|BAD)SIG/s;
221
222  my @signatures;
223  $x =~ /Signature made (\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+).*(GOOD|BAD)SIG (\S{16}).*(TRUST_(\S+))?/sg;
224
225  my $signature = {'Validity' => $2, 'KeyID' => $3,
226		   'Time' => $1, 'Trusted' => $4};
227  $signature->{Time} = str2time ($signature->{Time});
228  bless $signature, 'Crypt::GPG::Signature';
229  return ($plaintext, $signature);
230}
231
232sub msginfo {
233  my $self = shift;
234  my @return;
235
236  my ($tmpfh, $tmpnam) =
237    tempfile( $self->tmpfiles, DIR => $self->tmpdir,
238 	      SUFFIX => $self->tmpsuffix, UNLINK => 1);
239  warn join '',@{$_[0]};
240  print $tmpfh join '',@{$_[0]}; close $tmpfh;
241
242  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
243  my ($info) = backtick ($self->gpgbin, @opts, '--status-fd', 1, '--no-tty', '--batch', $tmpnam);
244  $info =~ s/ENC_TO (.{16})/{push @return, $1}/sge;
245  unlink $tmpnam;
246  return @return;
247}
248
249sub encrypt {
250  my $self = shift;
251  my ($message, $rcpts) = @_;
252  my $info;
253
254  my $sign = $_[2] && $_[2] eq '-sign' ? '--sign' : '';
255  my $armor = $self->armor ? '-a' : '';
256
257  if ($sign) {
258    return unless (!$self->secretkey or $self->secretkey =~ /$self->{VKEYID}/)
259      and $self->passphrase =~ /$self->{VPASSPHRASE}/;
260  }
261
262  my @rcpts;
263  if (ref($rcpts) eq 'ARRAY') {
264    @rcpts = map {
265      return unless /$self->{VRCPT}/;
266      ('-r', $_) } @$rcpts;
267  }
268  else {
269    return unless $rcpts =~ /$self->{VRCPT}/;
270    @rcpts = ('-r', $rcpts);
271  }
272
273  my ($tmpfh, $tmpnam) =
274    tempfile( $self->tmpfiles, DIR => $self->tmpdir,
275	      SUFFIX => $self->tmpsuffix, UNLINK => 1);
276  my ($tmpfh2, $tmpnam2) =
277    tempfile( $self->tmpfiles, DIR => $self->tmpdir,
278	      SUFFIX => $self->tmpsuffix, UNLINK => 1);
279
280  $message = join ('', @$message) if ref($message) eq 'ARRAY';
281  print $tmpfh $message; close $tmpfh;
282
283  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
284  push (@opts, '--default-key', ref($self->secretkey)?$self->secretkey->{ID}:$self->secretkey) if $sign and $self->secretkey;
285  push (@opts, $sign) if $sign; push (@opts, $armor) if $armor;
286  push (@opts, ('--comment', $self->comment)) if $self->comment;
287
288  my ($in, $out, $err, $in_q, $out_q, $err_q);
289  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
290                  '-o', $tmpnam2, @rcpts, '--encrypt', $tmpnam], \$in, \$out, \$err, timeout( 30 ));
291  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
292  my $pos;
293  eval {
294    pump $h until ($out =~ /(o)penfile.overwrite.okay/g
295		   or $out =~ /(u)(n)trusted_key.override/g    #! Test
296		   or $out =~ /(k)(e)(y) not found/g           #! Test
297		   or $out =~ /(p)(a)(s)(s)phrase.enter/g);
298    $pos = 1 if $1; $pos = 2 if $2; $pos = 3 if $3; $pos = 4 if $4;
299  };
300  return if $@;
301  if ($pos == 4) {
302    undef $pos; $out = '';
303    $in .= $self->passphrase . "\n";
304    pump $h until ($out =~ /(o)penfile.overwrite.okay/g
305		   or $out =~ /(u)(n)trusted_key.override/g  #! Test
306		    or $out =~ /(I)(N)(V)_RECP/g              #! Test
307		   or $out =~ /(p)(a)(s)(s)phrase.enter/g);  #! Test
308    $pos = 1 if $1; $pos = 2 if $2; $pos = 3 if $3; $pos = 4 if $4;
309    finish $h, return undef if $pos == 4;                    #! Test
310  }
311
312  if ($pos == 2) {
313    if ($self->encryptsafe) {
314      $in .= "N\n";
315      finish $h;
316      unlink $tmpnam;
317      return;
318    }
319    else {
320      $in .= "Y\n";
321      #	finish $h;
322      pump $h until ($out =~ /(o)penfile.overwrite.okay/g
323		     or $out =~ /(o)(p)enfile.askoutname/g);  #! Test
324      #		       or $out =~ /(I)(N)(V)_RECP/g              #! Test
325      #		       or $out =~ /(p)(a)(s)(s)phrase.enter/g);  #! Test
326      $pos = 1 if $1; $pos = 2 if $2;
327    }
328  }
329  elsif ($pos == 3) {
330    finish $h;
331    unlink $tmpnam;
332    return;
333  }
334
335  if ($pos == 1) {
336    $in .= "Y\n";
337    finish $h;
338  }
339
340  my @info = <$tmpfh2>;
341  close $tmpfh2;
342  unlink $tmpnam2;
343  $info = join '', @info;
344
345  unlink $tmpnam;
346  return $info;
347}
348
349sub addkey {
350  my $self = shift;
351  my ($key, $pretend, @keyids) = @_;
352
353  $key = join ('', @$key) if ref($key) eq 'ARRAY';
354  return if grep { $_ !~ /^[a-f0-9]+$/i } @keyids;
355
356  my $tmpdir = tempdir( $self->tmpdirs,
357		     DIR => $self->tmpdir, CLEANUP => 1);
358  my ($tmpfh, $tmpnam) =
359    tempfile( $self->tmpfiles, DIR => $self->tmpdir,
360	      SUFFIX => $self->tmpsuffix, UNLINK => 1);
361  print $tmpfh $key;
362
363  my @pret1 = ('--options', '/dev/null', '--homedir', $tmpdir);
364  my @pret2 = ('--keyring', "$tmpdir/pubring.gpg",
365	       '--secret-keyring', "$tmpdir/secring.gpg");
366  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
367  my @listopts = qw(--fingerprint --fingerprint --with-colons);
368
369  backtick($self->gpgbin, @opts, @pret1, '-v', '--import', $tmpnam);
370  backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
371  my ($keylist) = backtick($self->gpgbin, @opts, @pret1, '--marginals-needed',
372			   $self->marginals, '--check-sigs', @listopts, @keyids);
373  my ($seclist) = backtick($self->gpgbin, @opts, @pret1,
374			   '--list-secret-keys', @listopts);
375
376  my @seckeys = grep { my $id = $_->{ID};
377		       (grep { $id eq $_ } @keyids) ? $_ : '' }
378    $self->parsekeys(split /\n/,$seclist);
379  my @ret = ($self->parsekeys(split /\n/,$keylist), @seckeys);
380
381  if ($pretend) {
382#! This hack needed to get real calc trusts for to-import keys. Test!
383    backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
384    ($keylist) = backtick($self->gpgbin, @opts, @pret2, '--marginals-needed',
385			  $self->marginals, '--check-sigs', @listopts);
386
387    my @realkeylist = grep { my $id = $_->{ID} if $_;
388			     $id and grep { $id eq $_->{ID} } @ret }
389#      map { ($_->{Keyring} eq "$tmpdir/secring.gpg"
390#	     or $_->{Keyring} eq "$tmpdir/pubring.gpg") ? $_ : 0 }
391	$self->parsekeys(split /\n/,$keylist);
392    @ret = (@realkeylist, @seckeys);
393  }
394  else {
395    if (@keyids) {
396      my ($out) = backtick($self->gpgbin, @opts, @pret1, "--export", '-a', @keyids);
397      print $tmpfh $out; close $tmpfh;
398    }
399    backtick($self->gpgbin, @opts, '-v', '--import', $tmpnam);
400  }
401  rmtree($tmpdir, 0, 1);
402  unlink($tmpnam);
403  return @ret;
404}
405
406sub export {
407  my $self = shift;
408  my $key = shift;
409  my $id = $key->{ID};
410  return unless $id =~ /$self->{VKEYID}/;
411
412  my $armor = $self->armor ? '-a' : '';
413  my $secret = $key->{Type} eq 'sec' ? '-secret-keys' : '';
414  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
415  push (@opts, ('--comment', $self->comment)) if $self->comment;
416  push (@opts, '--status-fd', '1');
417
418  my ($out) = backtick($self->gpgbin, @opts, "--export$secret", $armor, $id);
419  $out;
420}
421
422sub keygen {
423  my $self = shift;
424  my ($name, $email, $keytype, $keysize, $expire, $pass, $comment) = @_;
425
426  return unless $keysize =~ /$self->{VKEYSZ}/
427    and $keysize > 767 and $keysize < 4097
428      and $pass =~ /$self->{VPASSPHRASE}/
429	and $keytype =~ /$self->{VKEYTYPE}/
430	  and $expire =~ /$self->{VEXPIRE}/
431	    and $email =~ /$self->{VEMAIL}/
432	      and $name =~ /$self->{VNAME}/
433		and length ($name) > 4;
434
435  unless (defined ($comment) && $comment =~ /$self->{VCOMMENT}/) { $comment = ''; }
436
437  my $bigkey = ($keysize > 1536);
438  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
439  for (0..1) {
440    backtick ($self->{GPGBIN}, @opts, '--status-fd', '1', '--no-tty', '--gen-random', 0, 1);
441  }
442
443  if ($self->nofork) {
444    $self->_exec_gen_key(@_);
445  }
446  else {
447    my $pid = open(GPG, "-|");
448    return undef unless (defined $pid);
449
450    if ($pid) {
451      $SIG{CHLD} = 'IGNORE';
452      return \*GPG;
453    }
454    else {
455      $self->_exec_gen_key(@_, 'forked');
456      CORE::exit();
457    }
458  }
459}
460
461sub _exec_gen_key {
462  my $self = shift;
463  my ($name, $email, $keytype, $keysize, $expire, $pass, $comment, $forked) = @_;
464
465  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
466  my ($in, $out, $err, $in_q, $out_q, $err_q);
467  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
468                  '--gen-key'], \$in, \$out, \$err);
469  if ($forked) {
470    local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
471  }
472
473  pump $h until $out =~ /keygen\.algo/g; $in .= "1\n";
474  pump $h until $out =~ /keygen\.size/g; $in .= "$keysize\n";
475  pump $h until $out =~ /keygen\.valid/g; $in .= "$expire\n";
476  pump $h until $out =~ /keygen\.name/g; $in .= "$name\n";
477  pump $h until $out =~ /keygen\.email/g; $in .= "$email\n";
478  pump $h until $out =~ /keygen\.comment/g; $in .= "$comment\n";
479  pump $h until $out =~ /passphrase\.enter/g; $out = ''; $in .= "$pass\n";
480  pump $h until $out =~ /(PROGRESS primegen [\+\.\>\<\^]|KEY_CREATED)/g;
481  $out = ''; my $x = ''; my $y = $1;
482  while ($y !~ /KEY_CREATED/g) {
483    print "$x\n" if $forked;
484    pump $h until $out =~ /(PROGRESS primegen [\+\.\>\<\^]|KEY_CREATED)/g;
485    my $o = $out; $out = ''; $y .= $o;
486    my @progress = ($o =~ /[\+\.\>\<\^]/g);
487    $x = join "\n",@progress;
488  }
489  print "|\n" if $forked;
490  finish $h;
491}
492
493sub keydb {
494  my $self = shift;
495  my @ids = map { return unless /$self->{VKEYID}/; $_ } @_;
496  my @moreopts = qw(--fingerprint --fingerprint --with-colons);
497  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
498  backtick ($self->gpgbin, @opts, '--marginals-needed', $self->marginals, '--check-trustdb');
499  my ($keylist) = backtick($self->gpgbin, @opts, '--marginals-needed', $self->marginals,
500			   '--no-tty', '--check-sigs', @moreopts, @ids);
501  my ($seclist) = backtick($self->gpgbin, @opts,
502			   '--no-tty', '--list-secret-keys', @moreopts, @ids);
503  my @keylist = split /\n(\s*\n)?/, $keylist;
504  my @seclist = split /\n(\s*\n)?/, $seclist;
505  $self->parsekeys (@keylist, @seclist);
506}
507
508sub keyinfo {
509  shift->keydb(@_);
510}
511
512sub parsekeys {
513  my $self=shift; my @keylist = @_;
514  my @keys; my ($i, $subkey, $subnum, $uidnum) = (-1);
515  my $keyring = '';
516  $^W = 0;
517  foreach (@keylist) {
518    next if /^\-/;
519    next if /^(gpg|tru):/;
520    if (/^\//) {
521      $keyring = $_; chomp $keyring;
522      next;
523    }
524    if (/^(pub|sec)/) {
525      $uidnum=-1; $subnum=-1; $subkey=0;
526      my ($type, $trust, $size, $algorithm, $id, $created,
527	  $expires, $u2, $ownertrust, $uid) = split (':');
528      $keys[++$i] = {
529		     Keyring    =>    $keyring,
530		     Type       =>    $type,
531		     Ownertrust =>    $ownertrust,
532		     Bits       =>    $size,
533		     ID         =>    $id,
534		     Created    =>    $created,
535		     Expires    =>    $expires,
536		     Algorithm  =>    $algorithm,
537		     Use        =>    ''
538		    };
539      push (@{$keys[$i]->{UIDs}}, { 'UID' => $uid, 'Calctrust' => $trust }),
540	$uidnum++ if $uid;
541    }
542    else {
543      if (/^fpr:::::::::([^:]+):/) {
544	my $fingerprint = $1; my $l = length $fingerprint;
545	if ($l == 32) {
546	  my @f = $fingerprint =~ /(..)/g;
547	  $fingerprint = (join ' ', @f[0..7]) . '  ' .
548	    (join ' ', @f[8..15]);
549	}
550	elsif ($l == 40) {
551	  my @f = $fingerprint =~ /(....)/g;
552	  $fingerprint = (join ' ', @f[0..4]) . '  ' .
553	    (join ' ', @f[5..9]);
554	}
555	$subkey ?
556	  $keys[$i]->{Subkeys}->[$subnum]->{Fingerprint} :
557	  $keys[$i]->{Fingerprint} =  $fingerprint;
558      }
559      elsif (/^sub/) {
560	$subnum++; $subkey      =     1;
561	my ($type, $u1, $size, $algorithm, $id,
562	    $created, $expires) = split (':');
563	$keys[$i]->{Subkeys}->[$subnum] =
564	  {
565	   Bits                 =>    $size,
566	   ID                   =>    $id,
567	   Created              =>    $created,
568	   Expires              =>    $expires,
569	   Algorithm            =>    $algorithm
570	  };
571      }
572      elsif (/^sig/) {
573	my ($sig, $valid, $u2, $u3, $id, $date,
574	    $u4, $u5, $u6, $uid) = split (':');
575	my ($pushto, $pushnum) = $subkey ?
576	  ('Subkeys',$subnum) : ('UIDs',$uidnum);
577	push (@{$keys[$i]->{$pushto}->[$pushnum]->{Signatures}},
578	      {	ID              =>    $id,
579		Date            =>    $date,
580		UID             =>    $uid,
581		Valid           =>    $valid
582	      } );
583      }
584      elsif (/^uid:(.?):.*:([^:]+):$/) {
585	$subkey = 0; $uidnum++;
586	push (@{$keys[$i]->{UIDs}}, { UID => $2, Calctrust => $1 });
587      }
588    }
589  }
590  $^W = 1;
591  return map {bless $_, 'Crypt::GPG::Key'} @keys;
592}
593
594sub keypass {
595  my $self = shift;
596
597  my ($key, $oldpass, $newpass) = @_;
598  return unless $oldpass =~ /$self->{VPASSPHRASE}/
599    and $newpass =~ /$self->{VPASSPHRASE}/
600      and $key->{Type} eq 'sec';
601
602  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
603
604  my ($in, $out, $err, $in_q, $out_q, $err_q);
605  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
606                 '--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
607  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
608
609  pump $h until $out =~ /keyedit\.prompt/g; $in .= "passwd\n";
610  pump $h until ($out =~ /GOOD_PASSPHRASE/g
611		 or $out =~ /(passphrase\.enter)/g);
612
613  unless ($1) {
614    finish $h, return if $oldpass;
615  }
616  else {
617    $^W = 0; /()/; $^W = 1; $out = '';
618    $in .= "$oldpass\n";
619    pump $h until ($out =~ /BAD_PASSPHRASE/g                #! Test
620		   or $out =~ /(passphrase\.enter)/g);
621    unless ($1) {
622      finish $h;
623      return;
624    }
625  }
626  $^W = 0; /()/; $^W = 1; $out = '';
627  $in .= "$newpass\n";
628  pump $h until ($out =~ /change_passwd\.empty\.okay/g
629		 or $out =~ /(keyedit\.prompt)/g);
630  unless ($1) {
631    $in .= "Y\n";
632    pump $h until $out =~ /keyedit\.prompt/g;
633  }
634  $in .= "quit\n";
635  pump $h until $out =~ /keyedit\.save\.okay/g;
636  $in .= "Y\n";
637  finish $h;
638  return 1;
639}
640
641sub keytrust {
642  my $self = shift;
643  my ($key, $trustlevel) = @_;
644  return unless $trustlevel =~ /$self->{VTRUSTLEVEL}/;
645
646  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
647
648  my ($in, $out, $err, $in_q, $out_q, $err_q);
649  my $h = start ([$self->gpgbin, @opts, '--no-tty',
650                 '--status-fd', '1', '--command-fd', 0,
651                 '--edit-key', $key->{ID}],
652                 \$in, \$out, \$err, timeout( 30 ));
653  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
654  pump $h until $out =~ /keyedit\.prompt/g; $in .= "trust\n";
655  pump $h until $out =~ /edit_ownertrust\.value/g; $in .= "$trustlevel\n";
656  if ($trustlevel == 5) {
657    pump $h until $out =~ /edit_ownertrust\.set_ultimate\.okay/g; $in .= "Y\n";
658  }
659  pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
660  finish $h;
661  return 1;
662}
663
664sub keyprimary {
665}
666
667sub certify {
668  my $self = shift;
669  my ($key, $local, $class, @uids) = @_;
670
671  return unless (!$self->secretkey or $self->secretkey =~ /$self->{VKEYID}/)
672    and $self->passphrase =~ /$self->{VPASSPHRASE}/;
673
674  return unless @uids and !grep { $_ =~ /\D/; } @uids;
675  my $i = 0; my $ret = 0;
676
677  ($key) = $self->keydb($key);
678  my $signingkey = ($self->keydb($self->secretkey))[0]->{ID};
679
680  # Check if already signed.
681  return 1 unless grep { !grep { $signingkey eq $_->{ID} }
682			   @{$_->{Signatures}} }
683    (@{$key->{UIDs}})[@uids];
684
685  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
686  push (@opts, '--default-key', $self->secretkey) if $self->secretkey;;
687
688  my ($in, $out, $err, $in_q, $out_q, $err_q);
689
690  my $h = start ([$self->gpgbin, @opts, '--status-fd', '1', '--command-fd', 0, '--no-tty',
691                 '--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
692  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
693
694  for (@uids) {
695    my $uid = $_+1;
696    pump $h until ($out =~ /keyedit\.prompt/g);
697    $in .= "uid $uid\n";
698  }
699  pump $h until ($out =~ /keyedit\.prompt/g);
700  $out = '';
701  $in .= $local ? "lsign\n" : "sign\n";
702
703  pump $h until ($out =~ /sign_uid\.okay/g
704		 or $out =~ /(s)ign_uid\.class/g
705		 or $out =~ /(s)(i)gn_uid\.expire/g);
706
707  if ($2) {
708    $out = ''; $in .= "0\n";
709    pump $h until ($out =~ /sign_uid\.okay/g
710		   or $out =~ /(s)ign_uid\.class/g
711		   or $out =~ /passphrase\.enter/g);
712  }
713
714  if ($1) {
715    $out = ''; $in .= "$class\n";
716    pump $h until ($out =~ /sign_uid\.okay/g);
717  }
718
719  $^W = 0; /()/; $^W = 1; $out = ''; $in .= "Y\n";
720  pump $h until ($out =~ /passphrase\.enter/g
721		 or $out =~ /(keyedit.prompt)/g);
722  $ret=1;
723  unless ($1) {
724    $out = ''; $^W = 0; /()/; $^W = 1; $in .= $self->passphrase . "\n";
725    pump $h until ($out =~ /keyedit\.prompt/g
726		   or $out =~ /(BAD_PASSPHRASE)/g);
727    $ret=0 if $1;
728  }
729
730  $in .= "quit\n";
731  if ($ret) {
732    pump $h until ($out =~ /save\.okay/g or $out =~ /(k)eyedit\.prompt/g);
733    $in .= "Y\n";
734  }
735  finish $h;
736  $ret;
737}
738
739sub delkey {
740  my $self = shift;
741  my $key = shift;
742  return unless $key->{ID} =~ /$self->{VKEYID}/;
743
744  my $del = $key->{Type} eq 'sec' ?
745    '--delete-secret-and-public-key':'--delete-key';
746  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
747
748  my ($in, $out, $err, $in_q, $out_q, $err_q);
749  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
750                 $del, $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
751  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
752  pump $h until ($out =~ /delete it first\./g or $out =~ /(delete_key)(.secret)?.okay/g);
753                       #! ^^^^^^^^^^^^^^^^^ to-fix.
754  finish $h, return undef unless $1;
755  $in .= "Y\n";
756  if ($key->{Type} eq 'sec') {
757    pump $h until $out =~ /delete_key.okay/g; $in .= "Y\n";
758  }
759  finish $h;
760  return 1;
761}
762
763sub disablekey {
764  my $self = shift;
765  my $key = shift;
766  return unless $key->{ID} =~ /$self->{VKEYID}/;
767
768  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
769
770  my ($in, $out, $err, $in_q, $out_q, $err_q);
771  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
772                 '--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
773  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
774  pump $h until ($out =~ /been disabled/g or $out =~ /(keyedit\.prompt)/g);
775                       #! ^^^^^^^^^^^^^ to-fix.
776  finish $h, return undef unless $1;
777  $in .= "disable\n";
778  pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
779  finish $h;
780  return 1;
781}
782
783sub enablekey {
784  my $self = shift;
785  my $key = shift;
786  return unless $key->{ID} =~ /$self->{VKEYID}/;
787
788  my @opts = (split (/\s+/, "$self->{FORCEDOPTS} $self->{GPGOPTS}"));
789
790  my ($in, $out, $err, $in_q, $out_q, $err_q);
791  my $h = start ([$self->gpgbin, @opts, '--no-tty', '--status-fd', '1', '--command-fd', 0,
792                 '--edit-key', $key->{ID}], \$in, \$out, \$err, timeout( 30 ));
793  local $SIG{CHLD} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE';
794  pump $h until ($out =~ /been disabled/g or $out =~ /(keyedit\.prompt)/g);
795                       #! ^^^^^^^^^^^^^ to-fix.
796  finish $h, return undef unless $1;
797  $in .= "enable\n";
798  pump $h until $out =~ /keyedit\.prompt/g; $in .= "quit\n";
799  finish $h;
800  return 1;
801}
802
803sub backtick {
804  my ($in, $out, $err, $in_q, $out_q, $err_q);
805  my $h = start ([@_], \$in, \$out, \$err, timeout( 10 ));
806  local $SIG{CHLD} = 'IGNORE';
807  local $SIG{PIPE} = 'IGNORE';
808  finish $h;
809  return ($out, $err);
810}
811
812sub debug {
813  my $self = shift;
814  return $self->{DEBUG} unless defined $_[0];
815  unless ($_[0] == $self->{DEBUG}) { $ENV{IPCRUNDEBUG} = $_[0] ? 'data' : ''; }
816  $self->{DEBUG} = $_[0];
817}
818
819sub AUTOLOAD {
820  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
821  if ($auto =~ /^(passphrase|secretkey|armor|gpgbin|gpgopts|delay|marginals|
822                  detach|clearsign|encryptsafe|version|comment|tmpdir|tmpdirs|
823                  tmpfiles|tmpsuffix|nofork)$/x) {
824    return $self->{"\U$auto"} unless defined $_[0];
825    $self->{"\U$auto"} = shift;
826  }
827  elsif ($auto eq 'DESTROY') {
828  }
829  else {
830    croak "Could not AUTOLOAD method $auto.";
831  }
832}
833
834package Crypt::GPG::Signature;
835use vars qw( $AUTOLOAD );
836use Carp;
837
838sub AUTOLOAD {
839  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
840  if ($auto =~ /^(validity|keyid|time|trusted)$/) {
841    return $self->{"KeyID"} if ( $auto eq "keyid" );
842    return $self->{"\u$auto"};
843  }
844  elsif ($auto eq 'DESTROY') {
845  }
846  else {
847    croak "Could not AUTOLOAD method $auto.";
848  }
849}
850
851'True Value';
852__END__
853
854=head1 NAME
855
856Crypt::GPG - An Object Oriented Interface to GnuPG.
857
858=head1 VERSION
859
860 $Revision: 1.64 $
861 $Date: 2007/04/02 13:34:25 $
862
863=head1 SYNOPSIS
864
865  use Crypt::GPG;
866  my $gpg = new Crypt::GPG;
867
868  $gpg->gpgbin('/usr/bin/gpg');      # The GnuPG executable.
869  $gpg->secretkey('0x2B59D29E');     # Set ID of default secret key.
870  $gpg->passphrase('just testing');  # Set passphrase.
871
872  # Sign a message:
873
874  my $sign = $gpg->sign('testing again');
875
876  # Encrypt a message:
877
878  my @encrypted = $gpg->encrypt ('top secret', 'test@bar.com');
879
880  # Get message info:
881
882  my @recipients = $gpg->msginfo($encrypted);
883
884  # Decrypt a message.
885
886  my ($plaintext, $signature) = $gpg->verify($encrypted);
887
888  # Key generation:
889
890  $status = $gpg->keygen
891    ('Test', 'test@foo.com', 'ELG-E', 2048, 0, 'test passphrase');
892  print while (<$status>); close $status;
893
894  # Key database manipulation:
895
896  $gpg->addkey($key, @ids);
897  @keys = $gpg->keydb(@ids);
898
899  # Key manipulation:
900
901  $key = $keys[0];
902
903  $gpg->delkey($key);
904  $gpg->disablekey($key);
905  $gpg->enablekey($key);
906  $gpg->keypass($key, $oldpassphrase, $newpassphrase);
907  $keystring = $gpg->export($key);
908
909=head1 DESCRIPTION
910
911The Crypt::GPG module provides access to the functionality of the
912GnuPG (www.gnupg.org) encryption tool through an object oriented
913interface.
914
915It provides methods for encryption, decryption, signing, signature
916verification, key generation, key certification, export and
917import. Key-server access is on the todo list.
918
919This release of the module may create compatibility issues with
920previous versions. If you find any such problems, or any bugs or
921documentation errors, please do report them to
922crypt-gpg at neomailbox.com.
923
924=head1 CONSTRUCTOR
925
926=over 2
927
928=item B<new()>
929
930Creates and returns a new Crypt::GPG object.
931
932=back
933
934=head1 DATA METHODS
935
936=over 2
937
938=item B<gpgbin($path)>
939
940Sets the B<GPGBIN> instance variable which gives the path to the GnuPG
941binary.
942
943=item B<gpgopts($opts)>
944
945Sets the B<GPGOPTS> instance variable which may be used to pass
946additional options to the GnuPG binary. For proper functioning of this
947module, it is advisable to always include '--lock-multiple' in the
948GPGOPTS string.
949
950=item B<delay($seconds)>
951
952Sets the B<DELAY> instance variable. This is no longer necessary (nor
953used) in the current version of the module, but remains so existing
954scripts don't break.
955
956=item B<secretkey($keyid)>
957
958Sets the B<SECRETKEY> instance variable which may be a KeyID or a
959username. This is the ID of the default key to use for signing.
960
961=item B<passphrase($passphrase)>
962
963Sets the B<PASSPHRASE> instance variable, required for signing and
964decryption.
965
966=item B<text($boolean)>
967
968Sets the B<TEXT> instance variable. If set true, GnuPG will use
969network-compatible line endings for proper cross-platform
970compatibility and the plaintext will gain a newline at the end, if it
971does not already have one.
972
973=item B<armor($boolean)>
974
975Sets the B<ARMOR> instance variable, controlling the ASCII armoring of
976output. The default is to use ascii-armoring. The module has not been
977tested with this option turned off, and most likely will not work if
978you switch this off.
979
980=item B<detach($boolean)>
981
982Sets the B<DETACH> instance variable. If set true, the sign method
983will produce detached signature certificates, else it won't. The
984default is to produce detached signatures.
985
986=item B<encryptsafe($boolean)>
987
988Sets the B<ENCRYPTSAFE> instance variable. If set true, encryption
989will fail if trying to encrypt to a key which is not trusted. This is
990the default. Turn this off if you want to encrypt to untrusted keys.
991
992=item B<version($versionstring)>
993
994Sets the B<VERSION> instance variable which can be used to change the
995Version: string on the GnuPG output to whatever you like.
996
997=item B<comment($commentstring)>
998
999Sets the B<COMMENT> instance variable which can be used to change the
1000Comment: string on the GnuPG output to whatever you like.
1001
1002=item B<nofork($flag)>
1003
1004Sets the B<NOFORK> instance variable which if set to a true value will
1005cause keygen() not to fork a separate process for key generation.
1006
1007=item B<debug($boolean)>
1008
1009Sets the B<DEBUG> instance variable which causes the raw output of
1010Crypt::GPG's interaction with the GnuPG binary to be dumped to
1011STDOUT. By default, debugging is off.
1012
1013=back
1014
1015=head1 OBJECT METHODS
1016
1017=over 2
1018
1019=item B<sign(@message)>
1020
1021Signs B<@message> with the secret key specified with B<secretkey()>
1022and returns the result as a string.
1023
1024=item B<decrypt(\@message, [\@signature])>
1025
1026This is just an alias for B<verify()>
1027
1028=item B<verify(\@message, [\@signature])>
1029
1030Decrypts and/or verifies the message in B<@message>, optionally using
1031the detached signature in B<@signature>, and returns a list whose
1032first element is plaintext message as a string. If the message was
1033signed, a Crypt::GPG::Signature object is returned as the second
1034element of the list.
1035
1036The Crypt::GPG::Signature object can be queried with the following
1037methods:
1038
1039   $sig->validity();    # 'GOOD', 'BAD', or 'UNKNOWN'
1040   $sig->keyid();       # ID of signing key
1041   $sig->time();        # Time the signature was made
1042   $sig->trusted();     # Signature trust level
1043
1044
1045=item B<msginfo(@ciphertext)>
1046
1047Returns a list of the recipient key IDs that B<@ciphertext> is
1048encrypted to.
1049
1050=item B<encrypt($plaintext, $keylist, [-sign] )>
1051
1052Encrypts B<$plaintext> with the public keys of the recipients listed
1053in B<$keylist> and returns the result in a string, or B<undef> if
1054there was an error while processing. Returns undef if any of the keys
1055are not found.
1056
1057Either $plaintext or $keylist may be specified as either an arrayref
1058or a simple scalar.
1059
1060If $plaintext is a an arrayref, it will be join()ed without
1061newlines.
1062
1063If you want to encrypt to multiple recipients, you must use the
1064arrayref version of $keylist. A scalar $keylist works for only a
1065single key ID.
1066
1067If the -sign option is provided, the message will be signed before
1068encryption. The secret key and passphrase must be set for signing to
1069work. They can be set with the secretkey() and passphrase() methods.
1070
1071=item B<addkey($key, $pretend, @keyids)>
1072
1073Adds the keys given in B<$key> to the user's key ring and returns a
1074list of Crypt::GPG::Key objects corresponding to the keys that were
1075added. $key may be a string or an array reference.
1076
1077If B<$pretend> is true, it pretends to add the key and creates the key
1078object, but doesn't actually perform the key addition.
1079
1080Optionally, a list of key IDs may be specified. If a list of key IDs
1081is specified, only keys that match those IDs will be imported. The
1082rest will be ignored.
1083
1084=item B<export($key)>
1085
1086Exports the key specified by the Crypt::GPG::Key object B<$key> and
1087returns the result as a string.
1088
1089=item B<keygen($name, $email, $keytype, $keysize, $expire, $passphrase)>
1090
1091Creates a new keypair with the parameters specified. The only
1092supported B<$keytype> currently is 'ELG-E'. B<$keysize> can be any of
10931024, 2048, 3072 or 4096. Returns undef if there was an error,
1094otherwise returns a filehandle that reports the progress of the key
1095generation process similar to the way GnuPG does. The key generation
1096is not complete till you read an EOF from the returned filehandle.
1097
1098=item B<certify($keyid, $local, @uids)>
1099
1100Certifies to the authenticity of UIDs of the key with ID $keyid. If
1101$local is true, the certification will be non-exportable. The @uids
1102parameter should contain the list of UIDs to certify (the first UID of
1103a key is 0).
1104
1105=item B<keydb(@keyids)>
1106
1107Returns an array of Crypt::GPG::Key objects corresponding to the Key
1108IDs listed in B<@keyids>. This method used to be called B<keyinfo> and
1109that is still an alias to this method.
1110
1111=item B<parsekeys(@keylist)>
1112
1113Parses a raw GnuPG formatted key listing in B<@keylist> and returns an
1114array of Crypt::GPG::Key objects.
1115
1116=item B<keypass($key, $oldpass, $newpass)>
1117
1118Change the passphrase for a key. Returns true if the passphrase change
1119succeeded, false if not, or undef if there was an error.
1120
1121=item B<delkey($keyid)>
1122
1123Deletes the key specified by the Crypt::GPG::Key object B<$key> from
1124the user's key ring. Returns undef if there was an error, or 1 if the
1125key was successfully deleted.
1126
1127=item B<disablekey($keyid)>
1128
1129Disables the key specified by the Crypt::GPG::Key object B<$key>.
1130
1131=item B<enablekey($keyid)>
1132
1133Enables the key specified by the Crypt::GPG::Key object B<$key>.
1134
1135=back
1136
1137=head1 Crypt::GPG::Signature
1138
1139=over 2
1140
1141  Documentation coming soon.
1142
1143=back
1144
1145=head1 Crypt::GPG::Key
1146
1147=over 2
1148
1149  Documentation coming soon.
1150
1151=back
1152
1153=head1 TODO
1154
1155=over 2
1156
1157=item *
1158
1159Key server access.
1160
1161=item *
1162
1163More complete key manipulation interface.
1164
1165=item *
1166
1167Filehandle interface to handle large messages.
1168
1169=back
1170
1171=head1 BUGS
1172
1173=over 2
1174
1175=item *
1176
1177Error checking needs work.
1178
1179=item *
1180
1181Some key manipulation functions are missing.
1182
1183=item *
1184
1185The method call interface is subject to change in future versions.
1186
1187=item *
1188
1189The current implementation will probably eat up all your RAM if you
1190try to operate on huge messages. In future versions, this will be
1191addressed by reading from and returning filehandles, rather than using
1192in-core data.
1193
1194=item *
1195
1196Methods may break if you don't use ASCII armoring.
1197
1198=back
1199
1200=head1 CHANGELOG
1201
1202=over 2
1203
1204$Log: GPG.pm,v $
1205
1206Revision 1.64  2014/09/18 12:21:25  ashish
1207
1208  - Applied Fix for RT 68339 (thanks to Todd Rinaldo)
1209
1210Revision 1.63  2007/04/02 13:34:25  ashish
1211
1212  - Fixed a bug introduced by the changes in 1.62 wrt default signing key
1213
1214Revision 1.62  2007/03/31 11:28:12  ashish
1215
1216  - Fixed debug()
1217
1218  - Fixed regex for signature line
1219
1220  - Non-forking version of keygen() (thanks to Greg Hill)
1221
1222  - Enabled use of default Key ID for signing
1223
1224  - Allow for GPG returning 8 or 16 bit KeyIDs (thanks to Roberto Jimenoca)
1225
1226  - Fixed tempfiles being left around after decrypt()
1227
1228  - Changed exit() to CORE::exit() (suggested by Jonathan R. Baker)
1229
1230Revision 1.61  2006/12/21 12:36:28  ashish
1231
1232  - Skip tests if gpg not found.
1233
1234  - Use File::Spec to determine tmpdir. Suggested by Craig Manley.
1235
1236Revision 1.59  2006/12/19 12:51:54  ashish
1237
1238  - Documentation fixes.
1239
1240  - Removed tests for obsolete 768 bit keys.
1241
1242  - Bugfixes.
1243
1244  - Tested with gpg 1.4.6.
1245
1246Revision 1.57  2005/12/15 17:09:17  ashish
1247
1248  - Fixed bug in decrypt
1249
1250  - Fixed small key certification bugs.
1251
1252Revision 1.50  2005/02/10 12:32:51  cvs
1253
1254 - Overhauled to use IPC::Run instead of Expect.
1255
1256 - Test suite split up into multiple scripts.
1257
1258Revision 1.42  2002/12/11 03:33:19  cvs
1259
1260 - Fixed bug in certify() when trying to certify revoked a key.
1261
1262 - Applied dharris\x40drh.net's patch to allow for varying date formats
1263   between gpg versions, and fix time parsing and the
1264   Crypt::GPG::Signature autoloaded accessor functions.
1265
1266Revision 1.40  2002/09/23 23:01:53  cvs
1267
1268 - Fixed a bug in keypass()
1269
1270 - Documentation fixes.
1271
1272Revision 1.37  2002/09/21 02:37:49  cvs
1273
1274 - Fixed signing option in encrypt.
1275
1276Revision 1.36  2002/09/21 00:03:29  cvs
1277
1278 - Added many tests and fixed a bunch of bugs.
1279
1280Revision 1.34  2002/09/20 19:07:11  cvs
1281
1282 - Extensively modified formatting to make the code easier to
1283   read. All lines are now < 80 chars.
1284
1285 - Removed all instances of invoking a shell.
1286
1287 - Misc. other stuff.
1288
1289Revision 1.31  2002/09/20 16:38:45  cvs
1290
1291 - Cleaned up export and addkey. Fixed(?) addkey clobbering trustdb
1292   problem (thanks to jrray\x40spacemeat.com for the patch). Added
1293   support for signature verification on addkey pretend.
1294
1295 - No calls to POSIX::tmpnam remain (thanks to radek\x40karnet.pl and
1296   jrray\x40spacemeat.com for suggesting File::Temp).
1297
1298Revision 1.30  2002/09/20 15:25:47  cvs
1299
1300 - Fixed up tempfile handling and eliminated calls to the shell in
1301   encrypt(), sign() and msginfo(). Passing all currently defined
1302   tests.
1303
1304 - Hopefully also fixed signing during encryption and verification of
1305   detached signatures. Not tested this yet.
1306
1307Revision 1.29  2002/09/20 11:19:02  cvs
1308
1309 - Removed hack to Version: string. Only the Comment: string in GPG
1310   output is now modified by Crypt::GPG. (Thanks to
1311   eisen\x40schlund.de for pointing out the bug here)
1312
1313 - Removed code that incorrectly replaced 'PGP MESSAGE' with 'PGP
1314   SIGNATURE' on detached signatures. (Thanks to ddcc\x40mit.edu for
1315   pointing this out).
1316
1317 - Fixed up addkey() to properly handle pretend mode and to
1318   selectively import only requested key IDs from a key block.
1319
1320 - parsekeys() now also figures out which keyring a key belongs to.
1321
1322 - Added certify() method, to enable certifying keys.
1323
1324 - Added Crypt::GPG::Signature methods - validity(), keyid(), time()
1325   and trusted().
1326
1327=back
1328
1329=head1 AUTHOR
1330
1331Crypt::GPG is Copyright (c) 2000-2007 Ashish Gulhati
1332<crypt-gpg at neomailbox.com>. All Rights Reserved.
1333
1334=head1 ACKNOWLEDGEMENTS
1335
1336Thanks to Barkha, for inspiration; to the GnuPG team; and to everyone
1337who writes free software.
1338
1339=head1 LICENSE
1340
1341This code is free software; you can redistribute it and/or modify it
1342under the same terms as Perl itself.
1343
1344=head1 BUGS REPORTS, PATCHES, FEATURE REQUESTS
1345
1346Are very welcome. Email crypt-gpg at neomailbox.com.
1347
1348=cut
1349
1350