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
|
|
|
|
|
|
|
|
|