line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mail::GPG::Result; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# $Id: Result.pm,v 1.8 2006/04/14 11:05:03 joern Exp $ |
4
|
|
|
|
|
|
|
|
5
|
6
|
|
|
6
|
|
35
|
use strict; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
9771
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
require Encode if $] >= 5.008; |
8
|
|
|
|
|
|
|
|
9
|
64
|
|
|
64
|
0
|
479
|
sub get_mail_gpg { shift->{mail_gpg} } |
10
|
|
|
|
|
|
|
|
11
|
30
|
|
|
30
|
0
|
336
|
sub get_is_encrypted { shift->{is_encrypted} } |
12
|
30
|
|
|
30
|
0
|
360
|
sub get_enc_ok { shift->{enc_ok} } |
13
|
30
|
|
|
30
|
0
|
240
|
sub get_enc_key_id { shift->{enc_key_id} } |
14
|
30
|
|
|
30
|
0
|
194
|
sub get_enc_mail { shift->{enc_mail} } |
15
|
0
|
|
|
0
|
0
|
0
|
sub get_enc_key_ids { shift->{enc_key_ids} } |
16
|
0
|
|
|
0
|
0
|
0
|
sub get_enc_mails { shift->{enc_mails} } |
17
|
30
|
|
|
30
|
0
|
243
|
sub get_is_signed { shift->{is_signed} } |
18
|
52
|
|
|
52
|
0
|
613
|
sub get_sign_ok { shift->{sign_ok} } |
19
|
0
|
|
|
0
|
0
|
0
|
sub get_sign_state { shift->{sign_state} } |
20
|
54
|
|
|
54
|
0
|
516
|
sub get_sign_key_id { shift->{sign_key_id} } |
21
|
42
|
|
|
42
|
0
|
320
|
sub get_sign_mail { shift->{sign_mail} } |
22
|
0
|
|
|
0
|
0
|
0
|
sub get_sign_mail_aliases { shift->{sign_mail_aliases} } |
23
|
0
|
|
|
0
|
0
|
0
|
sub get_sign_fingerprint { shift->{sign_fingerprint} } |
24
|
|
|
|
|
|
|
|
25
|
52
|
|
|
52
|
0
|
252
|
sub set_is_encrypted { shift->{is_encrypted} = $_[1] } |
26
|
52
|
|
|
52
|
0
|
298
|
sub set_enc_ok { shift->{enc_ok} = $_[1] } |
27
|
52
|
|
|
52
|
0
|
183
|
sub set_enc_key_id { shift->{enc_key_id} = $_[1] } |
28
|
52
|
|
|
52
|
0
|
133
|
sub set_enc_mail { shift->{enc_mail} = $_[1] } |
29
|
52
|
|
|
52
|
0
|
291
|
sub set_enc_key_ids { shift->{enc_key_ids} = $_[1] } |
30
|
52
|
|
|
52
|
0
|
189
|
sub set_enc_mails { shift->{enc_mails} = $_[1] } |
31
|
52
|
|
|
52
|
0
|
374
|
sub set_is_signed { shift->{is_signed} = $_[1] } |
32
|
52
|
|
|
52
|
0
|
141
|
sub set_sign_ok { shift->{sign_ok} = $_[1] } |
33
|
52
|
|
|
52
|
0
|
384
|
sub set_sign_state { shift->{sign_state} = $_[1] } |
34
|
52
|
|
|
52
|
0
|
188
|
sub set_sign_key_id { shift->{sign_key_id} = $_[1] } |
35
|
52
|
|
|
52
|
0
|
313
|
sub set_sign_mail { shift->{sign_mail} = $_[1] } |
36
|
52
|
|
|
52
|
0
|
129
|
sub set_sign_mail_aliases { shift->{sign_mail_aliases} = $_[1] } |
37
|
52
|
|
|
52
|
0
|
186
|
sub set_sign_fingerprint { shift->{sign_fingerprint} = $_[1] } |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
0
|
0
|
0
|
sub get_gpg_stdout { shift->{gpg_stdout} } |
40
|
52
|
|
|
52
|
0
|
109
|
sub get_gpg_stderr { shift->{gpg_stderr} } |
41
|
52
|
|
|
52
|
0
|
151
|
sub get_gpg_status { shift->{gpg_status} } |
42
|
0
|
|
|
0
|
0
|
0
|
sub get_gpg_rc { shift->{gpg_rc} } |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub new { |
45
|
52
|
|
|
52
|
0
|
201
|
my $class = shift; |
46
|
52
|
|
|
|
|
920
|
my %par = @_; |
47
|
|
|
|
|
|
|
my ($mail_gpg, $gpg_stdout, $gpg_stderr, $gpg_status, $gpg_rc) = |
48
|
52
|
|
|
|
|
253
|
@par{'mail_gpg','gpg_stdout','gpg_stderr','gpg_status','gpg_rc'}; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#-- initialize reference attributes to prevent |
51
|
|
|
|
|
|
|
#-- dereferencing undef errors |
52
|
52
|
50
|
|
|
|
141
|
$gpg_stdout = \"" if not defined $gpg_stdout; |
53
|
52
|
50
|
|
|
|
144
|
$gpg_stderr = \"" if not defined $gpg_stderr; |
54
|
52
|
50
|
|
|
|
133
|
$gpg_status = \"" if not defined $gpg_status; |
55
|
|
|
|
|
|
|
|
56
|
52
|
|
|
|
|
283
|
my $self = bless { |
57
|
|
|
|
|
|
|
mail_gpg => $mail_gpg, |
58
|
|
|
|
|
|
|
gpg_stdout => $gpg_stdout, |
59
|
|
|
|
|
|
|
gpg_stderr => $gpg_stderr, |
60
|
|
|
|
|
|
|
gpg_status => $gpg_status, |
61
|
|
|
|
|
|
|
gpg_rc => $gpg_rc, |
62
|
|
|
|
|
|
|
}, $class; |
63
|
|
|
|
|
|
|
|
64
|
52
|
|
|
|
|
350
|
$self->analyze_result; |
65
|
|
|
|
|
|
|
|
66
|
52
|
|
|
|
|
245
|
return $self; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub analyze_result { |
70
|
52
|
|
|
52
|
0
|
160
|
my $self = shift; |
71
|
|
|
|
|
|
|
|
72
|
52
|
|
|
|
|
227
|
my ($is_signed, $sign_ok, $sign_state, |
73
|
|
|
|
|
|
|
$sign_key_id, $sign_mail, $sign_fingerprint, |
74
|
|
|
|
|
|
|
@sign_mail_aliases, $is_encrypted, $enc_ok, |
75
|
|
|
|
|
|
|
@enc_key_ids, @enc_mails |
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
|
78
|
52
|
|
|
|
|
220
|
my $gpg_status = $self->get_gpg_status; |
79
|
52
|
|
|
|
|
223
|
my $gpg_stderr = $self->get_gpg_stderr; |
80
|
|
|
|
|
|
|
|
81
|
52
|
|
66
|
|
|
1133
|
while ( $$gpg_status && $$gpg_status =~ m{^\[GNUPG:\]\s+(.*)$}mg ) { |
82
|
416
|
|
|
|
|
912
|
my $line = $1; |
83
|
416
|
100
|
|
|
|
3273
|
if ( $line =~ /^(GOOD|EXP|EXPKEY|REVKEY|BAD)SIG\s+([^\s]+)\s+(.*)/ ) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
84
|
33
|
|
|
|
|
361
|
my ( $state, $key_id, $mail ) = ( $1, $2, $3 ); |
85
|
33
|
|
|
|
|
88
|
$is_signed = 1; |
86
|
33
|
|
|
|
|
64
|
$sign_state = $state; |
87
|
33
|
|
|
|
|
80
|
$sign_key_id = $key_id; |
88
|
33
|
|
|
|
|
86
|
$sign_mail = decode($mail); |
89
|
33
|
|
|
|
|
318
|
$sign_ok = $sign_state eq 'GOOD'; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
elsif ( $line =~ /^ERRSIG\s+([^\s]+)/ ) { |
92
|
0
|
|
|
|
|
0
|
$is_signed = 1; |
93
|
0
|
|
|
|
|
0
|
$sign_key_id = $1; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
elsif ( $line =~ /^VALIDSIG\s+([^\s]+)/ ) { |
96
|
30
|
|
|
|
|
171
|
$sign_fingerprint = $1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
elsif ( $line =~ /^ENC_TO\s+([^\s]+)/ ) { |
99
|
30
|
|
|
|
|
107
|
push @enc_key_ids, decode($1); |
100
|
30
|
|
|
|
|
346
|
$enc_mails[ @enc_key_ids - 1 ] = ""; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif ( $line =~ /^USERID_HINT\s+([^\s]+)\s+(.*)/ ) { |
103
|
30
|
|
|
|
|
116
|
my ( $hint_key_id, $hint_text ) = ( $1, $2 ); |
104
|
30
|
|
|
|
|
54
|
my $i = 0; |
105
|
30
|
|
|
|
|
169
|
foreach my $key_id (@enc_key_ids) { |
106
|
30
|
50
|
|
|
|
106
|
if ( $key_id eq $hint_key_id ) { |
107
|
30
|
|
|
|
|
64
|
$enc_mails[$i] = decode($hint_text); |
108
|
|
|
|
|
|
|
} |
109
|
30
|
|
|
|
|
193
|
++$i; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
elsif ( $line =~ /^BEGIN_DECRYPTION/ ) { |
113
|
30
|
|
|
|
|
156
|
$is_encrypted = 1; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
elsif ( $line =~ /^DECRYPTION_OKAY/ ) { |
116
|
30
|
|
|
|
|
131
|
$enc_ok = 1; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
52
|
|
|
|
|
210
|
@sign_mail_aliases = $$gpg_stderr =~ /^gpg:\s+aka\s+"(.*?)"/mg; |
121
|
|
|
|
|
|
|
|
122
|
52
|
100
|
|
|
|
433
|
if ( !$self->get_mail_gpg->get_use_long_key_ids ) { |
123
|
29
|
|
|
|
|
78
|
for ( $sign_key_id, @enc_key_ids ) { |
124
|
47
|
100
|
|
|
|
173
|
$_ = substr( $_, -8, 8 ) if defined $_; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
52
|
|
100
|
|
|
431
|
$self->set_is_signed( $is_signed || 0 ); |
129
|
52
|
|
100
|
|
|
287
|
$self->set_sign_ok( $sign_ok || 0 ); |
130
|
52
|
|
100
|
|
|
271
|
$self->set_sign_state( $sign_state || "" ); |
131
|
52
|
|
100
|
|
|
393
|
$self->set_sign_key_id( $sign_key_id || "" ); |
132
|
52
|
|
100
|
|
|
345
|
$self->set_sign_mail( $sign_mail || "" ); |
133
|
52
|
|
100
|
|
|
369
|
$self->set_sign_fingerprint( $sign_fingerprint || "" ); |
134
|
52
|
|
|
|
|
239
|
$self->set_sign_mail_aliases( \@sign_mail_aliases ); |
135
|
52
|
|
100
|
|
|
513
|
$self->set_is_encrypted( $is_encrypted || '0' ); |
136
|
|
|
|
|
|
|
|
137
|
52
|
|
100
|
|
|
374
|
$self->set_enc_ok( $enc_ok || 0 ); |
138
|
52
|
|
|
|
|
255
|
$self->set_enc_key_ids( \@enc_key_ids ); |
139
|
52
|
|
|
|
|
249
|
$self->set_enc_mails( \@enc_mails ); |
140
|
52
|
|
100
|
|
|
297
|
$self->set_enc_key_id( $enc_key_ids[0] || "" ); |
141
|
52
|
|
100
|
|
|
313
|
$self->set_enc_mail( $enc_mails[0] || "" ); |
142
|
|
|
|
|
|
|
|
143
|
52
|
|
|
|
|
131
|
return $self; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub decode { |
147
|
93
|
|
|
93
|
0
|
205
|
my ($str) = @_; |
148
|
93
|
50
|
|
|
|
202
|
return $str if not defined $str; |
149
|
93
|
|
|
|
|
207
|
$str =~ s/\\x(..)/chr(hex($1))/eg; |
|
0
|
|
|
|
|
0
|
|
150
|
93
|
50
|
|
|
|
254
|
eval { $str = Encode::decode("utf-8", $str, Encode::FB_CROAK) } |
|
93
|
|
|
|
|
798
|
|
151
|
|
|
|
|
|
|
if $] >= 5.008; |
152
|
93
|
|
|
|
|
7201
|
return $str; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub as_string { |
156
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
157
|
0
|
|
|
|
|
0
|
my %par = @_; |
158
|
0
|
|
|
|
|
0
|
my ($no_stdout) = $par{'no_stdout'}; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
0
|
my ( $method, $string ); |
161
|
0
|
|
|
|
|
0
|
foreach my $attr ( |
162
|
|
|
|
|
|
|
qw (is_encrypted enc_ok enc_key_id enc_mail |
163
|
|
|
|
|
|
|
enc_key_ids enc_mails |
164
|
|
|
|
|
|
|
is_signed sign_ok sign_state sign_key_id |
165
|
|
|
|
|
|
|
sign_fingerprint sign_mail sign_mail_aliases |
166
|
|
|
|
|
|
|
sign_trust gpg_rc ) |
167
|
|
|
|
|
|
|
) { |
168
|
0
|
0
|
|
|
|
0
|
if ( $attr eq 'sign_mail_aliases' ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
169
|
0
|
|
|
|
|
0
|
foreach my $value ( @{ $self->get_sign_mail_aliases } ) { |
|
0
|
|
|
|
|
0
|
|
170
|
0
|
|
|
|
|
0
|
$string |
171
|
|
|
|
|
|
|
.= sprintf( "%-18s: %s\n", "sign_mail_alias", $value ); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
elsif ( $attr eq 'enc_key_ids' ) { |
175
|
0
|
|
|
|
|
0
|
foreach my $value ( @{ $self->get_enc_key_ids } ) { |
|
0
|
|
|
|
|
0
|
|
176
|
0
|
|
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", "enc_key_ids", $value ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
elsif ( $attr eq 'enc_mails' ) { |
180
|
0
|
|
|
|
|
0
|
foreach my $value ( @{ $self->get_enc_mails } ) { |
|
0
|
|
|
|
|
0
|
|
181
|
0
|
|
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", "enc_mails", $value ); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
else { |
185
|
0
|
|
|
|
|
0
|
$method = "get_$attr"; |
186
|
0
|
|
|
|
|
0
|
my $value = $self->$method; |
187
|
0
|
0
|
|
|
|
0
|
$value = "" unless defined $value; |
188
|
0
|
|
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", $attr, $value ); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
0
|
my $stdout = ${ $self->get_gpg_stdout }; |
|
0
|
|
|
|
|
0
|
|
193
|
0
|
|
|
|
|
0
|
my $stderr = ${ $self->get_gpg_stderr }; |
|
0
|
|
|
|
|
0
|
|
194
|
0
|
|
|
|
|
0
|
my $status = ${ $self->get_gpg_status }; |
|
0
|
|
|
|
|
0
|
|
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
for ( $stdout, $stderr, $status ) { |
197
|
0
|
0
|
|
|
|
0
|
next unless $_; |
198
|
0
|
|
|
|
|
0
|
s/\n/\n /g; |
199
|
0
|
|
|
|
|
0
|
s/\s+$//; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
0
|
0
|
0
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", "gpg_stdout", $stdout || '' ) |
203
|
|
|
|
|
|
|
if not $no_stdout; |
204
|
0
|
|
0
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", "gpg_stderr", $stderr || '' ); |
205
|
0
|
|
0
|
|
|
0
|
$string .= sprintf( "%-18s: %s\n", "gpg_status", $status || '' ); |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
0
|
return $string; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub as_short_string { |
211
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
0
|
my $string; |
214
|
|
|
|
|
|
|
|
215
|
0
|
0
|
|
|
|
0
|
if ( $self->get_is_encrypted ) { |
216
|
0
|
0
|
|
|
|
0
|
$string .= "ENC(" |
217
|
|
|
|
|
|
|
. $self->get_enc_mail . ", " |
218
|
|
|
|
|
|
|
. $self->get_enc_key_id . ", " |
219
|
|
|
|
|
|
|
. ( $self->get_enc_ok ? "OK" : "NOK" ) . ") - "; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else { |
222
|
0
|
|
|
|
|
0
|
$string .= "NOENC - "; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
0
|
0
|
|
|
|
0
|
if ( $self->get_is_signed ) { |
226
|
0
|
|
|
|
|
0
|
$string .= "SIGN(" |
227
|
|
|
|
|
|
|
. $self->get_sign_mail . ", " |
228
|
|
|
|
|
|
|
. $self->get_sign_key_id . ", " |
229
|
|
|
|
|
|
|
. $self->get_sign_state . ") - "; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
else { |
232
|
0
|
|
|
|
|
0
|
$string .= "NOSIGN - "; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
0
|
$string =~ s/ - $//; |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
0
|
return $string; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub get_sign_trust { |
241
|
12
|
|
|
12
|
0
|
17
|
my $self = shift; |
242
|
|
|
|
|
|
|
|
243
|
12
|
50
|
|
|
|
27
|
return $self->{sign_trust} if exists $self->{sign_trust}; |
244
|
|
|
|
|
|
|
|
245
|
12
|
|
|
|
|
33
|
my $trust = $self->get_mail_gpg->get_key_trust( |
246
|
|
|
|
|
|
|
key_id => $self->get_sign_key_id ); |
247
|
|
|
|
|
|
|
|
248
|
12
|
|
|
|
|
1340
|
return $self->{sign_trust} = $trust; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
1; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
__END__ |