1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
package SBO::Lib::Cryptography;
use 5.016;
use strict;
use warnings;
our $VERSION = '2.9.0';
use Cwd;
use File::Temp "tempdir";
use IPC::Open3;
use Exporter 'import';
# Minimal definitions of some GPG raw output messages.
use constant {
BADSIG => 'bad signature',
EXPSIG => 'signature expired',
EXPKEYSIG => 'signed by expired key',
ERRSIG => 'signature verification not possible',
GOODSIG => 'good signature',
REVKEYSIG => 'good signature by revoked public key',
NO_PUBKEY => 'public key unavailable',
VALIDSIG => 'valid signature',
# An unknown message type.
UNKNOWN => 'unknown',
};
our @EXPORT_OK = qw{
import_gpg_key
parse_gpg_output
verify_gpg_signed_file
BADSIG
EXPSIG
EXPKEYSIG
ERRSIG
GOODSIG
REVKEYSIG
NO_PUBKEY
VALIDSIG
UNKNOWN
};
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
);
=pod
=encoding UTF-8
=cut
# Messages on Signature status which should only turn up once.
our %is_signature_status = (
&BADSIG => 1,
&ERRSIG => 1,
&EXPSIG => 1,
&EXPKEYSIG => 1,
&GOODSIG => 1,
&REVKEYSIG => 1,
);
=head2
parse_gpg_output(@output, $key_id);
=cut
sub parse_gpg_output {
my $output = shift;
my $key_id = shift;
my $line;
my $status = '';
foreach $line (@$output) {
my $msg = parse_gpg_line($line, $key_id);
if (exists($is_signature_status{$msg})) {
# Only one signature expected.
if ($status ne '') {
return UNKNOWN;
}
$status = $msg;
}
if ($msg eq NO_PUBKEY) {
return NO_PUBKEY;
} elsif ($msg eq VALIDSIG) {
# VALIDSIG contains the full hex key ID to be certain it is signed by the
# right key. information can be found in 'DETAILS' in the gnupg2
# documentation folder.
return $status;
}
}
return UNKNOWN;
}
sub parse_gpg_line {
my $line = shift;
my $key_id = shift;
if ($line =~ /^\[GNUPG\:] BADSIG/) {
return BADSIG;
} elsif ($line =~ /^\[GNUPG\:] EXPSIG/) {
return EXPSIG;
} elsif ($line =~ /^\[GNUPG\:] EXPKEYSIG/) {
return EXPKEYSIG;
} elsif ($line =~ /^\[GNUPG\:] ERRSIG/) {
return ERRSIG;
} elsif ($line =~ /^\[GNUPG\:] GOODSIG/) {
return GOODSIG;
} elsif ($line =~ /^\[GNUPG\:] REVKEYSIG/) {
return REVKEYSIG;
} elsif ($line =~ /^\[GNUPG\:] NO_PUBKEY/) {
return NO_PUBKEY;
} elsif ($line =~ /^\[GNUPG\:] VALIDSIG $key_id/) {
return VALIDSIG;
} else {
return UNKNOWN;
}
}
=head2 import_gpg_key
import_gpg_key($key);
C<import_gpg_key()> will import the key into the systems keychain. An error will
be reported if the configured key fingerprint does not match the imported one.
=cut
sub import_gpg_key {
script_error('import_gpg_key requires two arguments.') unless @_ == 2;
my $key = shift;
my $key_id = shift;
my $key_source;
if ($key =~ m!^http://! || $key =~ m!^https://!) {
open3(undef, $key_source, ">&STDERR", "wget", $key, "-O", "-") || die("could not download key from $key");
} else {
open($key_source, "<", $key) || die("could not read '$key': $!");
}
my $old = $ENV{'GNUPGHOME'};
$ENV{'GNUPGHOME'} = tempdir(CLEANUP => 1);
my $gpg_cmd;
open3($gpg_cmd, undef, undef, "gpg", "--batch", "--yes", "--import", "-") || die("could not import key: $!\n");
while (my $line = <$key_source>) {
print($gpg_cmd $line);
}
close($gpg_cmd);
close($key_source);
sleep(1);
if (system(">/dev/null gpg --list-keys $key_id")) {
die("GPG key '$key_id' not found. Confirm the correct key is configured or is being imported.\n");
}
my $gpg_export;
open($gpg_export, "-|", "gpg", "--export", $key_id) || die("could not export key: $!\n");
$ENV{'GNUPGHOME'} = $old;
my $gpg_import;
open3($gpg_import, ">&STDOUT", ">&STDOUT", "gpg", "--batch", "--yes", "--import", "-") || die("could not import key: $!\n");
while (my $line = <$gpg_export>) {
print($gpg_import $line);
}
close($gpg_export);
close($gpg_import);
sleep(1);
print("key imported\n");
}
=head2 verify_gpg_signed_file
verify_gpg_signed_file($file_path, $key_id);
C<verify_gpg_signed_file()> verifies the C<file_path> is signed by C<key_id>.
=cut
sub verify_gpg_signed_file {
script_error('verify_gpg_signed_file requires two arguments.') unless @_ == 2;
my $file_path = shift;
my $key_id = shift;
my @output;
open3(undef, my $std_out, undef, "gpg", "--status-fd=1", "--verify", $file_path) or die("dead");
while (my $line = <$std_out>) {
push(@output, $line);
}
close($std_out);
return parse_gpg_output(\@output, $key_id);
}
|
