File Coverage

blib/lib/GnuPG/Interface.pm
Criterion Covered Total %
statement 316 345 91.5
branch 99 144 68.7
path n/a
condition 46 62 74.1
subroutine 43 46 93.4
pod 21 28 75.0
total 525 625 84.0


line stmt bran path cond sub pod time code
1               # Interface.pm
2               # - providing an object-oriented approach to interacting with GnuPG
3               #
4               # Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
5               #
6               # This module is free software; you can redistribute it and/or modify it
7               # under the same terms as Perl itself.
8               #
9               # This program is distributed in the hope that it will be useful,
10               # but WITHOUT ANY WARRANTY; without even the implied warranty of
11               # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12               #
13                
14               package GnuPG::Interface;
15 75       75   4151499 use Moo;
  75           672754  
  75           420  
16 75       75   150803 use MooX::late;
  75           2028352  
  75           527  
17               with qw(GnuPG::HashInit);
18                
19 75       75   10003459 use English qw( -no_match_vars );
  75           218  
  75           1167  
20 75       75   30232 use Carp;
  75           310  
  75           4191  
21 75       75   487 use Fcntl;
  75           170  
  75           18367  
22 75       75   578 use vars qw( $VERSION );
  75           172  
  75           4174  
23 75       75   3695 use Fatal qw( open close pipe fcntl );
  75           59059  
  75           670  
24 75       75   155497 use Class::Struct;
  75           8091  
  75           695  
25 75       75   7945 use IO::Handle;
  75           193  
  75           3526  
26                
27 75       75   95247 use Math::BigInt try => 'GMP';
  75           1967353  
  75           422  
28 75       75   1854474 use GnuPG::Options;
  75           1525  
  75           3130  
29 75       75   43061 use GnuPG::Handles;
  75           295  
  75           2978  
30 75       75   672 use Scalar::Util 'tainted';
  75           161  
  75           158071  
31                
32               $VERSION = '1.02';
33                
34               has passphrase => (
35               isa => 'Any',
36               is => 'rw',
37               clearer => 'clear_passphrase',
38               );
39                
40               has call => (
41               isa => 'Any',
42               is => 'rw',
43               trigger => 1,
44               clearer => 'clear_call',
45               );
46                
47               # NB: GnuPG versions
48               #
49               # There are now two supported versions of GnuPG: legacy 1.4 and stable 2.2
50               # They are detected and each behave slightly differently.
51               #
52               # When using features specific to branches, check that the system's
53               # version of gpg corresponds to the branch.
54               #
55               # legacy: 1.4
56               # stable: >= 2.2
57               #
58               # You can find examples of version comparison in the tests.
59               has version => (
60               isa => 'Str',
61               is => 'ro',
62               reader => 'version',
63               writer => '_set_version',
64               );
65                
66               has options => (
67               isa => 'GnuPG::Options',
68               is => 'rw',
69               lazy_build => 1,
70               );
71                
72 81       81   22884 sub _build_options { GnuPG::Options->new() }
73                
74               # deprecated!
75 4       4 0 1286 sub gnupg_call { shift->call(@_); }
76                
77               sub BUILD {
78 89       89 0 403279 my ( $self, $args ) = @_;
79 89           1271 $self->hash_init( call => 'gpg', %$args );
80               }
81                
82               struct(
83               fh_setup => {
84               parent_end => '$', child_end => '$',
85               direct => '$', is_std => '$',
86               parent_is_source => '$', name_shows_dup => '$',
87               }
88               );
89                
90               # Update version if "call" is updated
91               sub _trigger_call {
92 115       115   30672 my ( $self, $gpg ) = @_;
93 115           685 $self->_set_version( $self->_version() );
94               }
95                
96               #################################################################
97               # real worker functions
98                
99               # This function does any 'extra' stuff that the user might
100               # not want to handle himself, such as passing in the passphrase
101               sub wrap_call( $% ) {
102 236       236 1 25466 my ( $self, %args ) = @_;
103                
104               my $handles = $args{handles}
105 236 50         2689 or croak 'error: no handles defined';
106                
107 236 100         5839 $handles->stdin('<&STDIN') unless $handles->stdin();
108 236 50         11980 $handles->stdout('>&STDOUT') unless $handles->stdout();
109 236 100         7072 $handles->stderr('>&STDERR') unless $handles->stderr();
110                
111 236 100         12324 $self->passphrase("\n") unless $self->passphrase();
112                
113 236 100   66     7864 my $needs_passphrase_handled
114               = ( $self->passphrase() =~ m/\S/ and not $handles->passphrase() ) ? 1 : 0;
115                
116 236 100         9877 if ($needs_passphrase_handled) {
117 187           1195 $handles->passphrase( IO::Handle->new() );
118               }
119                
120 236           16078 my $pid = $self->fork_attach_exec(%args);
121                
122 183 100         3120 if ($needs_passphrase_handled) {
123 146           9165 my $passphrase_handle = $handles->passphrase();
124 146           9004 print $passphrase_handle $self->passphrase();
125 146           10405 close $passphrase_handle;
126                
127               # We put this in in case the user wants to re-use this object
128 146           7945 $handles->clear_passphrase();
129               }
130                
131 183           9169 return $pid;
132               }
133                
134               # does does command-line creation, forking, and execcing
135               # the reasing cli creation is done here is because we should
136               # fork before finding the fd's for stuff like --status-fd
137               sub fork_attach_exec( $% ) {
138 236       236 0 1089 my ( $self, %args ) = @_;
139                
140 236 50         1030 my $handles = $args{handles} or croak 'no GnuPG::Handles passed';
141 236           621 my $use_loopback_pinentry = 0;
142                
143               # Don't use loopback pintentry for legacy (1.4) GPG
144               #
145               # Check that $version is populated before running cmp_version. If
146               # we are invoked as part of BUILD to populate $version, then any
147               # methods that depend on $version will fail. We don't care about
148               # loopback when we're called just to check gpg version.
149 236 50   100     5289 $use_loopback_pinentry = 1
        66        
150               if ($handles->passphrase() && $self->version && $self->cmp_version($self->version, '2.2') > 0 );
151                
152               # deprecation support
153 236     66     2314 $args{commands} ||= $args{gnupg_commands};
154                
155               my @commands
156 236           1417 = ref $args{commands} ? @{ $args{commands} } : ( $args{commands} )
157 236 50         2087 or croak "no gnupg commands passed";
    50            
158                
159               # deprecation support
160 236     100     2295 $args{command_args} ||= $args{gnupg_command_args};
161                
162               my @command_args
163               = ref $args{command_args}
164 24           139 ? @{ $args{command_args} }
165 236 100   100     1544 : ( $args{command_args} || () );
166 236 100   66     1355 unshift @command_args, "--"
167               if @command_args and $command_args[0] ne "--";
168                
169 236           525 my %fhs;
170 236           887 foreach my $fh_name (
171               qw( stdin stdout stderr status
172               logger passphrase command
173               )
174               ) {
175 1652 100         43882 my $fh = $handles->$fh_name() or next;
176 904           21595 $fhs{$fh_name} = fh_setup->new();
177 904           62340 $fhs{$fh_name}->parent_end($fh);
178               }
179                
180 236           2634 foreach my $fh_name (qw( stdin stdout stderr )) {
181 708           13320 $fhs{$fh_name}->is_std(1);
182               }
183                
184 236           2036 foreach my $fh_name (qw( stdin passphrase command )) {
185 708 100         4554 my $entry = $fhs{$fh_name} or next;
186 428           6454 $entry->parent_is_source(1);
187               }
188                
189               # Below is code derived heavily from
190               # Marc Horowitz's IPC::Open3, a base Perl module
191 236           1197 foreach my $fh_name ( keys %fhs ) {
192 904           17351 my $entry = $fhs{$fh_name};
193                
194 904           13963 my $parent_end = $entry->parent_end();
195 904           9665 my $name_shows_dup = ( $parent_end =~ s/^[<>]&// );
196 904           14187 $entry->parent_end($parent_end);
197                
198 904           17704 $entry->name_shows_dup($name_shows_dup);
199                
200               $entry->direct( $name_shows_dup
201               || $handles->options($fh_name)->{direct}
202 904     100     13094 || 0 );
203               }
204                
205 236           5543 foreach my $fh_name ( keys %fhs ) {
206 904           28614 $fhs{$fh_name}->child_end( IO::Handle->new() );
207               }
208                
209 236           9553 foreach my $fh_name ( keys %fhs ) {
210 904           28836 my $entry = $fhs{$fh_name};
211 904 100         16276 next if $entry->direct();
212                
213 634           5373 my $reader_end;
214               my $writer_end;
215 634 100         9604 if ( $entry->parent_is_source() ) {
216 293           6414 $reader_end = $entry->child_end();
217 293           5841 $writer_end = $entry->parent_end();
218               }
219               else {
220 341           7442 $reader_end = $entry->parent_end();
221 341           7101 $writer_end = $entry->child_end();
222               }
223                
224 634           14108 pipe $reader_end, $writer_end;
225               }
226                
227 236           373596 my $pid = fork;
228                
229 236 50         15668 die "fork failed: $ERRNO" unless defined $pid;
230                
231 236 100         8000 if ( $pid == 0 ) # child
232               {
233                
234               # these are for safety later to help lessen autovifying,
235               # speed things up, and make the code smaller
236 53           4532 my $stdin = $fhs{stdin};
237 53           1708 my $stdout = $fhs{stdout};
238 53           1694 my $stderr = $fhs{stderr};
239                
240               # Paul Walmsley says:
241               # Perl 5.6's POSIX.pm has a typo in it that prevents us from
242               # importing STDERR_FILENO. So we resort to requiring it.
243 53           103008 require POSIX;
244                
245 53           427358 my $standard_out
246               = IO::Handle->new_from_fd( &POSIX::STDOUT_FILENO, 'w' );
247 53           15689 my $standard_in
248               = IO::Handle->new_from_fd( &POSIX::STDIN_FILENO, 'r' );
249                
250               # Paul Walmsley says:
251               # this mess is due to a typo in POSIX.pm on Perl 5.6
252 53           4633 my $stderr_fd = eval {&POSIX::STDERR_FILENO};
  53           479  
253 53 50         460 $stderr_fd = 2 unless defined $stderr_fd;
254 53           412 my $standard_err = IO::Handle->new_from_fd( $stderr_fd, 'w' );
255                
256               # If she wants to dup the kid's stderr onto her stdout I need to
257               # save a copy of her stdout before I put something else there.
258 53 50   66     7426 if ( $stdout->parent_end() ne $stderr->parent_end()
        66        
259               and $stderr->direct()
260               and my_fileno( $stderr->parent_end() )
261               == my_fileno($standard_out) ) {
262 0           0 my $tmp = IO::Handle->new();
263 0           0 open $tmp, '>&' . my_fileno( $stderr->parent_end() );
264 0           0 $stderr->parent_end($tmp);
265               }
266                
267 53 100         7989 if ( $stdin->direct() ) {
268 19 100         646 open $standard_in, '<&' . my_fileno( $stdin->parent_end() )
269               unless my_fileno($standard_in)
270               == my_fileno( $stdin->parent_end() );
271               }
272               else {
273 34           1230 close $stdin->parent_end();
274 34           5301 open $standard_in, '<&=' . my_fileno( $stdin->child_end() );
275               }
276                
277 53 100         4727 if ( $stdout->direct() ) {
278 5 50         84 open $standard_out, '>&' . my_fileno( $stdout->parent_end() )
279               unless my_fileno($standard_out)
280               == my_fileno( $stdout->parent_end() );
281               }
282               else {
283 48           1336 close $stdout->parent_end();
284 48           4246 open $standard_out, '>&=' . my_fileno( $stdout->child_end() );
285               }
286                
287 53 50         3802 if ( $stdout->parent_end() ne $stderr->parent_end() ) {
288                
289               # I have to use a fileno here because in this one case
290               # I'm doing a dup but the filehandle might be a reference
291               # (from the special case above).
292 53 100         1886 if ( $stderr->direct() ) {
293 14 50         182 open $standard_err, '>&' . my_fileno( $stderr->parent_end() )
294               unless my_fileno($standard_err)
295               == my_fileno( $stderr->parent_end() );
296               }
297               else {
298 39           1340 close $stderr->parent_end();
299 39           2863 open $standard_err, '>&=' . my_fileno( $stderr->child_end() );
300               }
301               }
302               else {
303 0 0         0 open $standard_err, '>&STDOUT'
304               unless my_fileno($standard_err) == my_fileno($standard_out);
305               }
306                
307 53           2411 foreach my $fh_name ( keys %fhs ) {
308 203           8938 my $entry = $fhs{$fh_name};
309 203 100         4206 next if $entry->is_std();
310                
311 44           1058 my $parent_end = $entry->parent_end();
312 44           1018 my $child_end = $entry->child_end();
313                
314 44 100         1031 if ( $entry->direct() ) {
315 1 50         38 if ( $entry->name_shows_dup() ) {
316 0 0         0 my $open_prefix
317               = $entry->parent_is_source() ? '<&' : '>&';
318 0           0 open $child_end, $open_prefix . $parent_end;
319               }
320               else {
321 1           14 $child_end = $parent_end;
322 1           15 $entry->child_end($child_end);
323               }
324               }
325               else {
326 43           1070 close $parent_end;
327               }
328                
329               # we want these fh's to stay open after the exec
330 44           2702 fcntl $child_end, F_SETFD, 0;
331                
332               # now set the options for the call to GnuPG
333 44           1547 my $fileno = my_fileno($child_end);
334 44           230 my $option = $fh_name . '_fd';
335 44           2481 $self->options->$option($fileno);
336               }
337                
338 53           4333 my @args = $self->options->get_args();
339                
340               # Get around a bug in 2.2, see also https://dev.gnupg.org/T4667
341               # this covers both --delete-secret-key(s) and --delete-secret-and-public-key(s)
342 53 50   100     3457 if ( $self->version && $self->cmp_version( $self->version, 2.2 ) >= 0 && $commands[0] =~ /^--delete-secret-.*keys?$/ ) {
        66        
343 0           0 push @args, '--yes';
344               }
345                
346 53 50         277 push @args, '--pinentry-mode', 'loopback'
347               if $use_loopback_pinentry;
348                
349 53           2894 my @command = (
350               $self->call(), @args,
351               @commands, @command_args
352               );
353                
354 53 50         2931 local $ENV{PATH} if tainted $ENV{PATH};
355 53 0         0 exec @command or die "exec() error: $ERRNO";
356               }
357                
358               # parent
359                
360               # close the child end of any pipes (non-direct stuff)
361 183           16909 foreach my $fh_name ( keys %fhs ) {
362 701           50808 my $entry = $fhs{$fh_name};
363 701 100         57035 close $entry->child_end() unless $entry->direct();
364               }
365                
366 183           9328 foreach my $fh_name ( keys %fhs ) {
367 701           4094 my $entry = $fhs{$fh_name};
368 701 100         14439 next unless $entry->parent_is_source();
369                
370 332           10311 my $parent_end = $entry->parent_end();
371                
372               # close any writing handles if they were a dup
373               #any real reason for this? It bombs if we're doing
374               #the automagic >& stuff.
375               #close $parent_end if $entry->direct();
376                
377               # unbuffer pipes
378 332 50         13312 select( ( select($parent_end), $OUTPUT_AUTOFLUSH = 1 )[0] )
379               if $parent_end;
380               }
381                
382 183           45709 return $pid;
383               }
384                
385               sub my_fileno {
386 75       75   919 no strict 'refs';
  75           162  
  75           244667  
387 283       283 0 4603 my ($fh) = @_;
388 283 50         927 croak "fh is undefined" unless defined $fh;
389 283 50         2668 return $1 if $fh =~ /^=?(\d+)$/; # is it a fd in itself?
390 283           972 my $fileno = fileno $fh;
391 283 50         706 croak "error determining fileno for $fh: $ERRNO" unless defined $fileno;
392 283           5865 return $fileno;
393               }
394                
395                
396               sub unescape_string {
397 19       19 0 65 my($str) = splice(@_);
398 19           53 $str =~ s/\\x(..)/chr(hex($1))/eg;
  0           0  
399 19           383 return $str;
400               }
401                
402               ###################################################################
403                
404               sub get_public_keys ( $@ ) {
405 4       4 1 5968 my ( $self, @key_ids ) = @_;
406                
407 4           104 return $self->get_keys(
408               commands => ['--list-public-keys'],
409               command_args => [@key_ids],
410               );
411               }
412                
413               sub get_secret_keys ( $@ ) {
414 2       2 1 2254 my ( $self, @key_ids ) = @_;
415                
416 2           20 return $self->get_keys(
417               commands => ['--list-secret-keys'],
418               command_args => [@key_ids],
419               );
420               }
421                
422               sub get_public_keys_with_sigs ( $@ ) {
423 2       2 1 2226 my ( $self, @key_ids ) = @_;
424                
425 2           18 return $self->get_keys(
426               commands => ['--check-sigs'],
427               command_args => [@key_ids],
428               );
429               }
430                
431               sub get_keys {
432 8       8 0 78 my ( $self, %args ) = @_;
433                
434 8           260 my $saved_options = $self->options();
435 8           298 my $new_options = $self->options->copy();
436 8           476 $self->options($new_options);
437 8           682 $self->options->push_extra_args(
438               '--with-colons',
439               '--fixed-list-mode',
440               '--with-fingerprint',
441               '--with-fingerprint',
442               '--with-key-data',
443               );
444                
445 8           1026 my $stdin = IO::Handle->new();
446 8           250 my $stdout = IO::Handle->new();
447                
448 8           364 my $handles = GnuPG::Handles->new(
449               stdin => $stdin,
450               stdout => $stdout,
451               );
452                
453 8           390 my $pid = $self->wrap_call(
454               handles => $handles,
455               %args,
456               );
457                
458 5           306 my @returned_keys;
459               my $current_primary_key;
460 5           0 my $current_signed_item;
461 5           0 my $current_key;
462                
463 5           6685 require GnuPG::PublicKey;
464 5           3159 require GnuPG::SecretKey;
465 5           1948 require GnuPG::SubKey;
466 5           3227 require GnuPG::Fingerprint;
467 5           2943 require GnuPG::UserId;
468 5           3125 require GnuPG::UserAttribute;
469 5           3061 require GnuPG::Signature;
470 5           3113 require GnuPG::Revoker;
471                
472 5           2598722 while (<$stdout>) {
473 75           116387 my $line = $_;
474 75           207 chomp $line;
475 75           453 my @fields = split ':', $line, -1;
476 75 50         285 next unless @fields > 3;
477                
478 75           160 my $record_type = $fields[0];
479                
480 75 100   100     1121 if ( $record_type eq 'pub' or $record_type eq 'sec' ) {
    100   66        
    100   100        
    100   33        
    50            
    100            
    100            
    100            
    50            
481 5 50         24 push @returned_keys, $current_primary_key
482               if $current_primary_key;
483                
484               my (
485 5           68 $user_id_validity, $key_length, $algo_num, $hex_key_id,
486               $creation_date, $expiration_date,
487               $local_id, $owner_trust, $user_id_string,
488               $sigclass, #unused
489               $usage_flags,
490               ) = @fields[ 1 .. $#fields ];
491                
492               # --fixed-list-mode uses epoch time for creation and expiration date strings.
493               # For backward compatibility, we convert them back using GMT;
494 5           21 my $expiration_date_string;
495 5 50         39 if ($expiration_date eq '') {
496 5           21 $expiration_date = undef;
497               } else {
498 0           0 $expiration_date_string = $self->_downrez_date($expiration_date);
499               }
500 5           69 my $creation_date_string = $self->_downrez_date($creation_date);
501                
502 5 100         230 $current_primary_key = $current_key
503               = $record_type eq 'pub'
504               ? GnuPG::PublicKey->new()
505               : GnuPG::SecretKey->new();
506                
507 5           79 $current_primary_key->hash_init(
508               length => $key_length,
509               algo_num => $algo_num,
510               hex_id => $hex_key_id,
511               local_id => $local_id,
512               owner_trust => $owner_trust,
513               creation_date => $creation_date,
514               expiration_date => $expiration_date,
515               creation_date_string => $creation_date_string,
516               expiration_date_string => $expiration_date_string,
517               usage_flags => $usage_flags,
518               );
519                
520 5           309 $current_signed_item = $current_primary_key;
521               }
522               elsif ( $record_type eq 'fpr' ) {
523 10           41 my $hex = $fields[9];
524 10           210 my $f = GnuPG::Fingerprint->new( as_hex_string => $hex );
525 10           2108 $current_key->fingerprint($f);
526               }
527               elsif ( $record_type eq 'sig' or
528               $record_type eq 'rev'
529               ) {
530               my (
531 9           32 $validity,
532               $algo_num, $hex_key_id,
533               $signature_date,
534               $expiration_date,
535               $user_id_string,
536               $sig_type,
537               ) = @fields[ 1, 3 .. 6, 9, 10 ];
538                
539 9           14 my $expiration_date_string;
540 9 50         19 if ($expiration_date eq '') {
541 9           14 $expiration_date = undef;
542               } else {
543 0           0 $expiration_date_string = $self->_downrez_date($expiration_date);
544               }
545 9           24 my $signature_date_string = $self->_downrez_date($signature_date);
546                
547 9           17 my ($sig_class, $is_exportable);
548 9 50         38 if ($sig_type =~ /^([[:xdigit:]]{2})([xl])$/ ) {
549 9           25 $sig_class = hex($1);
550 9           21 $is_exportable = ('x' eq $2);
551               }
552                
553 9           24 my $signature = GnuPG::Signature->new(
554               validity => $validity,
555               algo_num => $algo_num,
556               hex_id => $hex_key_id,
557               date => $signature_date,
558               date_string => $signature_date_string,
559               expiration_date => $expiration_date,
560               expiration_date_string => $expiration_date_string,
561               user_id_string => unescape_string($user_id_string),
562               sig_class => $sig_class,
563               is_exportable => $is_exportable,
564               );
565                
566 9 50   100     7326 if ( $current_signed_item->isa('GnuPG::Key') ||
        66        
        33        
567               $current_signed_item->isa('GnuPG::UserId') ||
568               $current_signed_item->isa('GnuPG::Revoker') ||
569               $current_signed_item->isa('GnuPG::UserAttribute')) {
570 9 50         25 if ($record_type eq 'sig') {
    0            
571 9           37 $current_signed_item->push_signatures($signature);
572               } elsif ($record_type eq 'rev') {
573 0           0 $current_signed_item->push_revocations($signature);
574               }
575               } else {
576 0           0 warn "do not know how to handle signature line: $line\n";
577               }
578               }
579               elsif ( $record_type eq 'uid' ) {
580 10           88 my ( $validity, $user_id_string ) = @fields[ 1, 9 ];
581                
582 10           52 $current_signed_item = GnuPG::UserId->new(
583               validity => $validity,
584               as_string => unescape_string($user_id_string),
585               );
586                
587 10           639 $current_primary_key->push_user_ids($current_signed_item);
588               }
589               elsif ( $record_type eq 'uat' ) {
590 0           0 my ( $validity, $subpacket ) = @fields[ 1, 9 ];
591                
592 0           0 my ( $subpacket_count, $subpacket_total_size ) = split(/ /,$subpacket);
593                
594 0           0 $current_signed_item = GnuPG::UserAttribute->new(
595               validity => $validity,
596               subpacket_count => $subpacket_count,
597               subpacket_total_size => $subpacket_total_size,
598               );
599                
600 0           0 $current_primary_key->push_user_attributes($current_signed_item);
601               }
602               elsif ( $record_type eq 'sub' or $record_type eq 'ssb' ) {
603               my (
604 5           46 $validity, $key_length, $algo_num, $hex_id,
605               $creation_date, $expiration_date,
606               $local_id,
607               $dummy0, $dummy1, $dummy2, #unused
608               $usage_flags,
609               ) = @fields[ 1 .. 11 ];
610                
611 5           41 my $expiration_date_string;
612 5 50         27 if ($expiration_date eq '') {
613 5           15 $expiration_date = undef;
614               } else {
615 0           0 $expiration_date_string = $self->_downrez_date($expiration_date);
616               }
617 5           39 my $creation_date_string = $self->_downrez_date($creation_date);
618                
619 5           65 $current_signed_item = $current_key
620               = GnuPG::SubKey->new(
621               validity => $validity,
622               length => $key_length,
623               algo_num => $algo_num,
624               hex_id => $hex_id,
625               creation_date => $creation_date,
626               expiration_date => $expiration_date,
627               creation_date_string => $creation_date_string,
628               expiration_date_string => $expiration_date_string,
629               local_id => $local_id,
630               usage_flags => $usage_flags,
631               );
632                
633 5           458 $current_primary_key->push_subkeys($current_signed_item);
634               }
635               elsif ($record_type eq 'rvk') {
636 4           35 my ($algo_num, $fpr, $class) = @fields[ 3,9,10 ];
637 4           40 my $rvk = GnuPG::Revoker->new(
638               fingerprint => GnuPG::Fingerprint->new( as_hex_string => $fpr ),
639               algo_num => ($algo_num + 0),
640               class => hex($class),
641               );
642               # pushing to either primary key or subkey, to handle
643               # designated revokers to the subkeys too:
644 4           142 $current_key->push_revokers($rvk);
645               # revokers should be bound to the key with signatures:
646 4           87 $current_signed_item = $rvk;
647               }
648               elsif ($record_type eq 'pkd') {
649 28           102 my ($pos, $size, $data) = @fields[ 1,2,3 ];
650 28           314 $current_key->pubkey_data->[$pos+0] = Math::BigInt->from_hex('0x'.$data);
651               }
652               elsif ( $record_type ne 'tru' and $record_type ne 'grp' ) {
653 0           0 warn "unknown record type $record_type";
654               }
655               }
656                
657 5           13860 waitpid $pid, 0;
658                
659 5 50         39 push @returned_keys, $current_primary_key
660               if $current_primary_key;
661                
662 5           160 $self->options($saved_options);
663                
664 5           1003 return @returned_keys;
665               }
666                
667               sub _downrez_date {
668 19       19   41 my $self = shift;
669 19           43 my $date = shift;
670 19 50         188 if ($date =~ /^\d+$/) {
671 19           372 my ($year,$month,$day) = (gmtime($date))[5,4,3];
672 19           76 $year += 1900;
673 19           33 $month += 1;
674 19           178 return sprintf('%04d-%02d-%02d', $year, $month, $day);
675               }
676 0           0 return $date;
677               }
678                
679                
680               ################################################################
681                
682               sub list_public_keys {
683 9       9 1 8474 my ( $self, %args ) = @_;
684 9           104 return $self->wrap_call(
685               %args,
686               commands => ['--list-public-keys'],
687               );
688               }
689                
690               sub list_sigs {
691 9       9 1 8764 my ( $self, %args ) = @_;
692 9           99 return $self->wrap_call(
693               %args,
694               commands => ['--list-sigs'],
695               );
696               }
697                
698               sub list_secret_keys {
699 9       9 1 9920 my ( $self, %args ) = @_;
700 9           138 return $self->wrap_call(
701               %args,
702               commands => ['--list-secret-keys'],
703               );
704               }
705                
706               sub encrypt( $% ) {
707 10       10 1 804 my ( $self, %args ) = @_;
708 10           213 return $self->wrap_call(
709               %args,
710               commands => ['--encrypt']
711               );
712               }
713                
714               sub encrypt_symmetrically( $% ) {
715 5       5 1 3232 my ( $self, %args ) = @_;
716               # Strip the homedir and put it back after encrypting;
717 5           128 my $homedir = $self->options->homedir;
718 5 50         249 $self->options->clear_homedir
719               unless $self->cmp_version($self->version, '2.2') >= 0;
720 5           214 my $pid = $self->wrap_call(
721               %args,
722               commands => ['--symmetric']
723               );
724 3 50         216 $self->options->homedir($homedir)
725               unless $self->cmp_version($self->version, '2.2') >= 0;
726 3           705 return $pid;
727               }
728                
729               sub sign( $% ) {
730 14       14 1 10426 my ( $self, %args ) = @_;
731 14           170 return $self->wrap_call(
732               %args,
733               commands => ['--sign']
734               );
735               }
736                
737               sub clearsign( $% ) {
738 5       5 1 3072 my ( $self, %args ) = @_;
739 5           35 return $self->wrap_call(
740               %args,,
741               commands => ['--clearsign']
742               );
743               }
744                
745               sub detach_sign( $% ) {
746 5       5 1 3137 my ( $self, %args ) = @_;
747 5           86 return $self->wrap_call(
748               %args,
749               commands => ['--detach-sign']
750               );
751               }
752                
753               sub sign_and_encrypt( $% ) {
754 5       5 1 231 my ( $self, %args ) = @_;
755 5           47 return $self->wrap_call(
756               %args,
757               commands => [
758               '--sign',
759               '--encrypt'
760               ]
761               );
762               }
763                
764               sub decrypt( $% ) {
765 5       5 1 3169 my ( $self, %args ) = @_;
766 5           80 return $self->wrap_call(
767               %args,
768               commands => ['--decrypt']
769               );
770               }
771                
772               sub verify( $% ) {
773 5       5 1 3528 my ( $self, %args ) = @_;
774 5           109 return $self->wrap_call(
775               %args,
776               commands => ['--verify']
777               );
778               }
779                
780               sub import_keys( $% ) {
781 7       7 1 5421 my ( $self, %args ) = @_;
782 7           74 return $self->wrap_call(
783               %args,
784               commands => ['--import']
785               );
786               }
787                
788               sub export_keys( $% ) {
789 5       5 1 3279 my ( $self, %args ) = @_;
790 5           53 return $self->wrap_call(
791               %args,
792               commands => ['--export']
793               );
794               }
795                
796               sub recv_keys( $% ) {
797 0       0 1 0 my ( $self, %args ) = @_;
798 0           0 return $self->wrap_call(
799               %args,
800               commands => ['--recv-keys']
801               );
802               }
803                
804               sub send_keys( $% ) {
805 0       0 1 0 my ( $self, %args ) = @_;
806 0           0 return $self->wrap_call(
807               %args,
808               commands => ['--send-keys']
809               );
810               }
811                
812               sub search_keys( $% ) {
813 0       0 1 0 my ( $self, %args ) = @_;
814 0           0 return $self->wrap_call(
815               %args,
816               commands => ['--search-keys']
817               );
818               }
819                
820               sub _version {
821 115       115   389 my ( $self ) = @_;
822                
823 115           1804 my $out = IO::Handle->new;
824 115           7681 my $handles = GnuPG::Handles->new( stdout => $out );
825 115           6109 my $pid = $self->wrap_call( commands => [ '--no-options', '--version' ], handles => $handles );
826 105           7557 my $line = $out->getline;
827 105           57921630 $line =~ /(\d+\.\d+\.\d+)/;
828                
829 105           1584 my $version = $1;
830 105 50   33     2327 unless ($self->cmp_version($version, '2.2') >= 0 or
        66        
831               ($self->cmp_version($version, '1.4') >= 0 and $self->cmp_version($version, '1.5') < 0 )) {
832 0           0 croak "GnuPG Version 1.4 or 2.2+ required";
833               }
834 105           7500 waitpid $pid, 0;
835                
836 105           22568 return $version;
837               }
838                
839               sub cmp_version($$) {
840 496       496 0 2397799 my ( $self, $a, $b ) = (@_);
841 496           13489 my @a = split '\.', $a;
842 496           3505 my @b = split '\.', $b;
843 496 50         3763 @a > @b
844               ? push @b, (0) x (@a-@b)
845               : push @a, (0) x (@b-@a);
846 496           2641 for ( my $i = 0; $i < @a; $i++ ) {
847 802 100         8742 return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
848               }
849 0           0 return 0;
850               }
851                
852               sub test_default_key_passphrase() {
853 4       4 1 4284 my ($self) = @_;
854                
855               # We can't do something like let the user pass
856               # in a passphrase handle because we don't exist
857               # anymore after the user runs off with the
858               # attachments
859 4 50         80 croak 'No passphrase defined to test!'
860               unless defined $self->passphrase();
861                
862 4           88 my $stdin = IO::Handle->new();
863 4           84 my $stdout = IO::Handle->new();
864 4           68 my $stderr = IO::Handle->new();
865 4           64 my $status = IO::Handle->new();
866                
867 4           136 my $handles = GnuPG::Handles->new(
868               stdin => $stdin,
869               stdout => $stdout,
870               stderr => $stderr,
871               status => $status
872               );
873                
874               # save this setting since we need to be in non-interactive mode
875 4           308 my $saved_meta_interactive_option = $self->options->meta_interactive();
876 4           204 $self->options->clear_meta_interactive();
877                
878 4           108 my $pid = $self->sign( handles => $handles );
879                
880 3           207 close $stdin;
881                
882               # restore this setting to its original setting
883 3           216 $self->options->meta_interactive($saved_meta_interactive_option);
884                
885               # all we realy want to check is the status fh
886 3           1677228 while (<$status>) {
887 9 100         7431 if (/^\[GNUPG:\]\s*(GOOD_PASSPHRASE|SIG_CREATED)/) {
888 3           12810 waitpid $pid, 0;
889 3           900 return 1;
890               }
891               }
892                
893               # If we didn't catch the regexp above, we'll assume
894               # that the passphrase was incorrect
895 0             waitpid $pid, 0;
896 0             return 0;
897               }
898                
899               1;
900                
901               ##############################################################
902                
903               =head1 NAME
904                
905               GnuPG::Interface - Perl interface to GnuPG
906                
907               =head1 SYNOPSIS
908                
909               # A simple example
910               use IO::Handle;
911               use GnuPG::Interface;
912                
913               # setting up the situation
914               my $gnupg = GnuPG::Interface->new();
915               $gnupg->options->hash_init( armor => 1,
916               homedir => '/home/foobar' );
917                
918               # Note you can set the recipients even if you aren't encrypting!
919               $gnupg->options->push_recipients( 'ftobin@cpan.org' );
920               $gnupg->options->meta_interactive( 0 );
921                
922               # how we create some handles to interact with GnuPG
923               my $input = IO::Handle->new();
924               my $output = IO::Handle->new();
925               my $handles = GnuPG::Handles->new( stdin => $input,
926               stdout => $output );
927                
928               # Now we'll go about encrypting with the options already set
929               my @plaintext = ( 'foobar' );
930               my $pid = $gnupg->encrypt( handles => $handles );
931                
932               # Now we write to the input of GnuPG
933               print $input @plaintext;
934               close $input;
935                
936               # now we read the output
937               my @ciphertext = <$output>;
938               close $output;
939                
940               waitpid $pid, 0;
941                
942               =head1 DESCRIPTION
943                
944               GnuPG::Interface and its associated modules are designed to
945               provide an object-oriented method for interacting with GnuPG,
946               being able to perform functions such as but not limited
947               to encrypting, signing,
948               decryption, verification, and key-listing parsing.
949                
950               =head2 How Data Member Accessor Methods are Created
951                
952               Each module in the GnuPG::Interface bundle relies
953               on Moo to generate the get/set methods
954               used to set the object's data members.
955               I<This is very important to realize.> This means that
956               any data member which is a list has special
957               methods assigned to it for pushing, popping, and
958               clearing the list.
959                
960               =head2 Understanding Bidirectional Communication
961                
962               It is also imperative to realize that this package
963               uses interprocess communication methods similar to
964               those used in L<IPC::Open3>
965               and L<perlipc/"Bidirectional Communication with Another Process">,
966               and that users of this package
967               need to understand how to use this method because this package
968               does not abstract these methods for the user greatly.
969               This package is not designed
970               to abstract this away entirely (partly for security purposes), but rather
971               to simply help create 'proper', clean calls to GnuPG, and to implement
972               key-listing parsing.
973               Please see L<perlipc/"Bidirectional Communication with Another Process">
974               to learn how to deal with these methods.
975                
976               Using this package to do message processing generally
977               invovlves creating a GnuPG::Interface object, creating
978               a GnuPG::Handles object,
979               setting some options in its B<options> data member,
980               and then calling a method which invokes GnuPG, such as
981               B<clearsign>. One then interacts with with the handles
982               appropriately, as described in
983               L<perlipc/"Bidirectional Communication with Another Process">.
984                
985               =head1 GnuPG Versions
986                
987               As of this version of GnuPG::Interface, there are two supported
988               versions of GnuPG: 1.4.x and 2.2.x. The
989               L<GnuPG download page|https://gnupg.org/download/index.html> has
990               updated information on the currently supported versions.
991                
992               GnuPG released 2.0 and 2.1 versions in the past and some packaging
993               systems may still provide these if you install the default C<gpg>,
994               C<gnupg>, C<gnupg2>, etc. packages. This modules supports only
995               version 2.2.x, so you may need to find additional package
996               repositories or build from source to get the updated version.
997                
998               =head1 OBJECT METHODS
999                
1000               =head2 Initialization Methods
1001                
1002               =over 4
1003                
1004               =item new( I<%initialization_args> )
1005                
1006               This methods creates a new object. The optional arguments are
1007               initialization of data members.
1008                
1009               =item hash_init( I<%args> ).
1010                
1011                
1012               =back
1013                
1014               =head2 Object Methods which use a GnuPG::Handles Object
1015                
1016               =over 4
1017                
1018               =item list_public_keys( % )
1019                
1020               =item list_sigs( % )
1021                
1022               =item list_secret_keys( % )
1023                
1024               =item encrypt( % )
1025                
1026               =item encrypt_symmetrically( % )
1027                
1028               =item sign( % )
1029                
1030               =item clearsign( % )
1031                
1032               =item detach_sign( % )
1033                
1034               =item sign_and_encrypt( % )
1035                
1036               =item decrypt( % )
1037                
1038               =item verify( % )
1039                
1040               =item import_keys( % )
1041                
1042               =item export_keys( % )
1043                
1044               =item recv_keys( % )
1045                
1046               =item send_keys( % )
1047                
1048               =item search_keys( % )
1049                
1050               These methods each correspond directly to or are very similar
1051               to a GnuPG command described in L<gpg>. Each of these methods
1052               takes a hash, which currently must contain a key of B<handles>
1053               which has the value of a GnuPG::Handles object.
1054               Another optional key is B<command_args> which should have the value of an
1055               array reference; these arguments will be passed to GnuPG as command arguments.
1056               These command arguments are used for such things as determining the keys to
1057               list in the B<export_keys> method. I<Please note that GnuPG command arguments
1058               are not the same as GnuPG options>. To understand what are options and
1059               what are command arguments please read L<gpg/"COMMANDS"> and L<gpg/"OPTIONS">.
1060                
1061               Each of these calls returns the PID for the resulting GnuPG process.
1062               One can use this PID in a C<waitpid> call instead of a C<wait> call
1063               if more precise process reaping is needed.
1064                
1065               These methods will attach the handles specified in the B<handles> object
1066               to the running GnuPG object, so that bidirectional communication
1067               can be established. That is, the optionally-defined B<stdin>,
1068               B<stdout>, B<stderr>, B<status>, B<logger>, and
1069               B<passphrase> handles will be attached to
1070               GnuPG's input, output, standard error,
1071               the handle created by setting B<status-fd>, the handle created by setting B<logger-fd>, and the handle created by setting
1072               B<passphrase-fd> respectively.
1073               This tying of handles of similar to the process
1074               done in I<IPC::Open3>.
1075                
1076               If you want the GnuPG process to read or write directly to an already-opened
1077               filehandle, you cannot do this via the normal I<IPC::Open3> mechanisms.
1078               In order to accomplish this, set the appropriate B<handles> data member
1079               to the already-opened filehandle, and then set the option B<direct> to be true
1080               for that handle, as described in L<GnuPG::Handles/options>. For example,
1081               to have GnuPG read from the file F<input.txt> and write to F<output.txt>,
1082               the following snippet may do:
1083                
1084               my $infile = IO::File->new( 'input.txt' );
1085               my $outfile = IO::File->new( '>output.txt' );
1086               my $handles = GnuPG::Handles->new( stdin => $infile,
1087               stdout => $outfile,
1088               );
1089               $handles->options( 'stdin' )->{direct} = 1;
1090               $handles->options( 'stdout' )->{direct} = 1;
1091                
1092               If any handle in the B<handles> object is not defined, GnuPG's input, output,
1093               and standard error will be tied to the running program's standard error,
1094               standard output, or standard error. If the B<status> or B<logger> handle
1095               is not defined, this channel of communication is never established with GnuPG,
1096               and so this information is not generated and does not come into play.
1097                
1098               If the B<passphrase> data member handle of the B<handles> object
1099               is not defined, but the the B<passphrase> data member handle of GnuPG::Interface
1100               object is, GnuPG::Interface will handle passing this information into GnuPG
1101               for the user as a convenience. Note that this will result in
1102               GnuPG::Interface storing the passphrase in memory, instead of having
1103               it simply 'pass-through' to GnuPG via a handle.
1104                
1105               If neither the B<passphrase> data member of the GnuPG::Interface nor
1106               the B<passphrase> data member of the B<handles> object is defined,
1107               then GnuPG::Interface assumes that access and control over the secret
1108               key will be handled by the running gpg-agent process. This represents
1109               the simplest mode of operation with the GnuPG "stable" suite (version
1110               2.2 and later). It is also the preferred mode for tools intended to
1111               be user-facing, since the user will be prompted directly by gpg-agent
1112               for use of the secret key material. Note that for programmatic use,
1113               this mode requires the gpg-agent and pinentry to already be correctly
1114               configured.
1115                
1116               =back
1117                
1118               =head2 Other Methods
1119                
1120               =over 4
1121                
1122               =item get_public_keys( @search_strings )
1123                
1124               =item get_secret_keys( @search_strings )
1125                
1126               =item get_public_keys_with_sigs( @search_strings )
1127                
1128               These methods create and return objects of the type GnuPG::PublicKey
1129               or GnuPG::SecretKey respectively. This is done by parsing the output
1130               of GnuPG with the option B<with-colons> enabled. The objects created
1131               do or do not have signature information stored in them, depending
1132               if the method ends in I<_sigs>; this separation of functionality is there
1133               because of performance hits when listing information with signatures.
1134                
1135               =item test_default_key_passphrase()
1136                
1137               This method will return a true or false value, depending
1138               on whether GnuPG reports a good passphrase was entered
1139               while signing a short message using the values of
1140               the B<passphrase> data member, and the default
1141               key specified in the B<options> data member.
1142                
1143               =item version()
1144                
1145               Returns the version of GnuPG that GnuPG::Interface is running.
1146                
1147               =back
1148                
1149                
1150               =head1 Invoking GnuPG with a custom call
1151                
1152               GnuPG::Interface attempts to cover a lot of the commands
1153               of GnuPG that one would want to perform; however, there may be a lot
1154               more calls that GnuPG is and will be capable of, so a generic command
1155               interface is provided, C<wrap_call>.
1156                
1157               =over 4
1158                
1159               =item wrap_call( %args )
1160                
1161               Call GnuPG with a custom command. The %args hash must contain
1162               at least the following keys:
1163                
1164               =over 4
1165                
1166               =item commands
1167                
1168               The value of this key in the hash must be a reference to a a list of
1169               commands for GnuPG, such as C<[ qw( --encrypt --sign ) ]>.
1170                
1171               =item handles
1172                
1173               As with most other GnuPG::Interface methods, B<handles>
1174               must be a GnuPG::Handles object.
1175                
1176               =back
1177                
1178               The following keys are optional.
1179                
1180               =over 4
1181                
1182               =item command_args
1183                
1184               As with other GnuPG::Interface methods, the value in hash
1185               for this key must be a reference to a list of arguments
1186               to be passed to the GnuPG command, such as which
1187               keys to list in a key-listing.
1188                
1189               =back
1190                
1191               =back
1192                
1193                
1194               =head1 OBJECT DATA MEMBERS
1195                
1196               =over 4
1197                
1198               =item call
1199                
1200               This defines the call made to invoke GnuPG. Defaults to 'gpg'; this
1201               should be changed if 'gpg' is not in your path, or there is a different
1202               name for the binary on your system.
1203                
1204               =item passphrase
1205                
1206               In order to lessen the burden of using handles by the user of this package,
1207               setting this option to one's passphrase for a secret key will allow
1208               the package to enter the passphrase via a handle to GnuPG by itself
1209               instead of leaving this to the user. See also L<GnuPG::Handles/passphrase>.
1210                
1211               =item options
1212                
1213               This data member, of the type GnuPG::Options; the setting stored in this
1214               data member are used to determine the options used when calling GnuPG
1215               via I<any> of the object methods described in this package.
1216               See L<GnuPG::Options> for more information.
1217                
1218               =back
1219                
1220               =head1 EXAMPLES
1221                
1222               The following setup can be done before any of the following examples:
1223                
1224               use IO::Handle;
1225               use GnuPG::Interface;
1226                
1227               my @original_plaintext = ( "How do you doo?" );
1228               my $passphrase = "Three Little Pigs";
1229                
1230               my $gnupg = GnuPG::Interface->new();
1231                
1232               $gnupg->options->hash_init( armor => 1,
1233               recipients => [ 'ftobin@uiuc.edu',
1234               '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ],
1235               meta_interactive => 0 ,
1236               );
1237                
1238               $gnupg->options->debug_level(4);
1239                
1240               $gnupg->options->logger_file("/tmp/gnupg-$$-decrypt-".time().".log");
1241                
1242                
1243               =head2 Encrypting
1244                
1245               # We'll let the standard error of GnuPG pass through
1246               # to our own standard error, by not creating
1247               # a stderr-part of the $handles object.
1248               my ( $input, $output ) = ( IO::Handle->new(),
1249               IO::Handle->new() );
1250                
1251               my $handles = GnuPG::Handles->new( stdin => $input,
1252               stdout => $output );
1253                
1254               # this sets up the communication
1255               # Note that the recipients were specified earlier
1256               # in the 'options' data member of the $gnupg object.
1257               my $pid = $gnupg->encrypt( handles => $handles );
1258                
1259               # this passes in the plaintext
1260               print $input @original_plaintext;
1261                
1262               # this closes the communication channel,
1263               # indicating we are done
1264               close $input;
1265                
1266               my @ciphertext = <$output>; # reading the output
1267                
1268               waitpid $pid, 0; # clean up the finished GnuPG process
1269                
1270               =head2 Signing
1271                
1272               # This time we'll catch the standard error for our perusing
1273               my ( $input, $output, $error ) = ( IO::Handle->new(),
1274               IO::Handle->new(),
1275               IO::Handle->new(),
1276               );
1277                
1278               my $handles = GnuPG::Handles->new( stdin => $input,
1279               stdout => $output,
1280               stderr => $error,
1281               );
1282                
1283               # indicate our pasphrase through the
1284               # convenience method
1285               $gnupg->passphrase( $passphrase );
1286                
1287               # this sets up the communication
1288               my $pid = $gnupg->sign( handles => $handles );
1289                
1290               # this passes in the plaintext
1291               print $input @original_plaintext;
1292                
1293               # this closes the communication channel,
1294               # indicating we are done
1295               close $input;
1296                
1297               my @ciphertext = <$output>; # reading the output
1298               my @error_output = <$error>; # reading the error
1299                
1300               close $output;
1301               close $error;
1302                
1303               waitpid $pid, 0; # clean up the finished GnuPG process
1304                
1305               =head2 Decryption
1306                
1307               # This time we'll catch the standard error for our perusing
1308               # as well as passing in the passphrase manually
1309               # as well as the status information given by GnuPG
1310               my ( $input, $output, $error, $passphrase_fh, $status_fh )
1311               = ( IO::Handle->new(),
1312               IO::Handle->new(),
1313               IO::Handle->new(),
1314               IO::Handle->new(),
1315               IO::Handle->new(),
1316               );
1317                
1318               my $handles = GnuPG::Handles->new( stdin => $input,
1319               stdout => $output,
1320               stderr => $error,
1321               passphrase => $passphrase_fh,
1322               status => $status_fh,
1323               );
1324                
1325               # this time we'll also demonstrate decrypting
1326               # a file written to disk
1327               # Make sure you "use IO::File" if you use this module!
1328               my $cipher_file = IO::File->new( 'encrypted.gpg' );
1329                
1330               # this sets up the communication
1331               my $pid = $gnupg->decrypt( handles => $handles );
1332                
1333               # This passes in the passphrase
1334               print $passphrase_fh $passphrase;
1335               close $passphrase_fh;
1336                
1337               # this passes in the plaintext
1338               print $input $_ while <$cipher_file>;
1339                
1340               # this closes the communication channel,
1341               # indicating we are done
1342               close $input;
1343               close $cipher_file;
1344                
1345               my @plaintext = <$output>; # reading the output
1346               my @error_output = <$error>; # reading the error
1347               my @status_info = <$status_fh>; # read the status info
1348                
1349               # clean up...
1350               close $output;
1351               close $error;
1352               close $status_fh;
1353                
1354               waitpid $pid, 0; # clean up the finished GnuPG process
1355                
1356               =head2 Printing Keys
1357                
1358               # This time we'll just let GnuPG print to our own output
1359               # and read from our input, because no input is needed!
1360               my $handles = GnuPG::Handles->new();
1361                
1362               my @ids = ( 'ftobin', '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' );
1363                
1364               # this time we need to specify something for
1365               # command_args because --list-public-keys takes
1366               # search ids as arguments
1367               my $pid = $gnupg->list_public_keys( handles => $handles,
1368               command_args => [ @ids ] );
1369                
1370               waitpid $pid, 0;
1371                
1372               =head2 Creating GnuPG::PublicKey Objects
1373                
1374               my @ids = [ 'ftobin', '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ];
1375                
1376               my @keys = $gnupg->get_public_keys( @ids );
1377                
1378               # no wait is required this time; it's handled internally
1379               # since the entire call is encapsulated
1380                
1381               =head2 Custom GnuPG call
1382                
1383               # assuming $handles is a GnuPG::Handles object
1384               my $pid = $gnupg->wrap_call
1385               ( commands => [ qw( --list-packets ) ],
1386               command_args => [ qw( test/key.1.asc ) ],
1387               handles => $handles,
1388               );
1389                
1390               my @out = <$handles->stdout()>;
1391               waitpid $pid, 0;
1392                
1393                
1394               =head1 FAQ
1395                
1396               =over 4
1397                
1398               =item How do I get GnuPG::Interface to read/write directly from
1399               a filehandle?
1400                
1401               You need to set GnuPG::Handles B<direct> option to be true for the
1402               filehandles in concern. See L<GnuPG::Handles/options> and
1403               L<"Object Methods which use a GnuPG::Handles Object"> for more
1404               information.
1405                
1406               =item Why do you make it so difficult to get GnuPG to write/read
1407               from a filehandle? In the shell, I can just call GnuPG
1408               with the --outfile option!
1409                
1410               There are lots of issues when trying to tell GnuPG to read/write
1411               directly from a file, such as if the file isn't there, or
1412               there is a file, and you want to write over it! What do you
1413               want to happen then? Having the user of this module handle
1414               these questions beforehand by opening up filehandles to GnuPG
1415               lets the user know fully what is going to happen in these circumstances,
1416               and makes the module less error-prone.
1417                
1418               =item When having GnuPG process a large message, sometimes it just
1419               hanges there.
1420                
1421               Your problem may be due to buffering issues; when GnuPG reads/writes
1422               to B<non-direct> filehandles (those that are sent to filehandles
1423               which you read to from into memory, not that those access the disk),
1424               buffering issues can mess things up. I recommend looking into
1425               L<GnuPG::Handles/options>.
1426                
1427               =back
1428                
1429               =head1 NOTES
1430                
1431               This package is the successor to PGP::GPG::MessageProcessor,
1432               which I found to be too inextensible to carry on further.
1433               A total redesign was needed, and this is the resulting
1434               work.
1435                
1436               After any call to a GnuPG-command method of GnuPG::Interface
1437               in which one passes in the handles,
1438               one should all B<wait> to clean up GnuPG from the process table.
1439                
1440                
1441               =head1 BUGS
1442                
1443               =head2 Large Amounts of Data
1444                
1445               Currently there are problems when transmitting large quantities
1446               of information over handles; I'm guessing this is due
1447               to buffering issues. This bug does not seem specific to this package;
1448               IPC::Open3 also appears affected.
1449                
1450               =head2 OpenPGP v3 Keys
1451                
1452               I don't know yet how well this module handles parsing OpenPGP v3 keys.
1453                
1454               =head2 RHEL 7 Test Failures
1455                
1456               Testing with the updates for version 1.00 we saw intermittent test failures
1457               on RHEL 7 with GnuPG version 2.2.20. In some cases the tests would all pass
1458               for several runs, then one would fail. We're unable to reliably reproduce
1459               this so we would be interested in feedback from other users.
1460                
1461               =head1 SEE ALSO
1462                
1463               L<GnuPG::Options>,
1464               L<GnuPG::Handles>,
1465               L<GnuPG::PublicKey>,
1466               L<GnuPG::SecretKey>,
1467               L<gpg>,
1468               L<perlipc/"Bidirectional Communication with Another Process">
1469                
1470               =head1 LICENSE
1471                
1472               This module is free software; you can redistribute it and/or modify it
1473               under the same terms as Perl itself.
1474                
1475               =head1 AUTHOR
1476                
1477               GnuPG::Interface is currently maintained by Best Practical Solutions <BPS@cpan.org>.
1478                
1479               Frank J. Tobin, ftobin@cpan.org was the original author of the package.
1480                
1481               =cut
1482                
1483               1;
1484