File Coverage

blib/lib/Crypt/OpenPGP/Signature.pm
Criterion Covered Total %
statement 180 197 91.3
branch 41 62 66.1
condition 8 13 61.5
subroutine 17 19 89.4
pod 7 11 63.6
total 253 302 83.7


line stmt bran cond sub pod time code
1             package Crypt::OpenPGP::Signature;
2 4     4   21 use strict;
  4         8  
  4         150  
3              
4 4     4   795 use Crypt::OpenPGP::Digest;
  4         7  
  4         123  
5 4     4   2193 use Crypt::OpenPGP::Signature::SubPacket;
  4         18  
  4         158  
6 4     4   615 use Crypt::OpenPGP::Key::Public;
  4         10  
  4         140  
7 4     4   31 use Crypt::OpenPGP::Constants qw( DEFAULT_DIGEST );
  4         8  
  4         43  
8 4     4   31 use Crypt::OpenPGP::ErrorHandler;
  4         7  
  4         123  
9 4     4   22 use base qw( Crypt::OpenPGP::ErrorHandler );
  4         10  
  4         9838  
10              
11 8     8 0 20 sub pkt_hdrlen { 2 }
12              
13             sub key_id {
14 6     6 1 1849 my $sig = shift;
15 6 100       27 unless ($sig->{key_id}) {
16 5         22 my $sp = $sig->find_subpacket(16);
17 5         17 $sig->{key_id} = $sp->{data};
18             }
19 6         29 $sig->{key_id};
20             }
21              
22             sub timestamp {
23 0     0 1 0 my $sig = shift;
24             $sig->{version} < 4 ?
25             $sig->{timestamp} :
26 0 0       0 $sig->find_subpacket(2)->{data};
27             }
28              
29             sub digest {
30 0     0 1 0 my $sig = shift;
31 0         0 Crypt::OpenPGP::Digest->new($sig->{hash_alg});
32             }
33              
34             sub find_subpacket {
35 5     5 0 8 my $sig = shift;
36 5         9 my($type) = @_;
37 5         7 my @sp = (@{$sig->{subpackets_hashed}}, @{$sig->{subpackets_unhashed}});
  5         11  
  5         14  
38 5         15 for my $sp (@sp) {
39 10 100       42 return $sp if $sp->{type} == $type;
40             }
41             }
42              
43             sub new {
44 53     53 1 132 my $class = shift;
45 53         171 my $sig = bless { }, $class;
46 53         363 $sig->init(@_);
47             }
48              
49             sub init {
50 53     53 0 87 my $sig = shift;
51 53         157 my %param = @_;
52 53         211 $sig->{subpackets_hashed} = [];
53 53         146 $sig->{subpackets_unhashed} = [];
54 53 100 66     284 if ((my $obj = $param{Data}) && (my $cert = $param{Key})) {
55 8   100     57 $sig->{version} = $param{Version} || 4;
56 8   100     50 $sig->{type} = $param{Type} || 0x00;
57             $sig->{hash_alg} = $param{Digest} ? $param{Digest} :
58 8 100       77 $sig->{version} == 4 ? DEFAULT_DIGEST : 1;
    50          
59 8         47 $sig->{pk_alg} = $cert->key->alg_id;
60 8 100       36 if ($sig->{version} < 4) {
61 1         4 $sig->{timestamp} = time;
62 1         6 $sig->{key_id} = $cert->key_id;
63 1         12 $sig->{hash_len} = 5;
64             }
65             else {
66 7         63 my $sp = Crypt::OpenPGP::Signature::SubPacket->new;
67 7         22 $sp->{type} = 2;
68 7         21 $sp->{data} = time;
69 7         14 push @{ $sig->{subpackets_hashed} }, $sp;
  7         27  
70 7         26 $sp = Crypt::OpenPGP::Signature::SubPacket->new;
71 7         17 $sp->{type} = 16;
72 7         34 $sp->{data} = $cert->key_id;
73 7         16 push @{ $sig->{subpackets_unhashed} }, $sp;
  7         21  
74             }
75 8 100       70 my $hash = $sig->hash_data(ref($obj) eq 'ARRAY' ? @$obj : $obj);
76 8         43 $sig->{chk} = substr $hash, 0, 2;
77             my $sig_data = $cert->key->sign($hash,
78 8         43 Crypt::OpenPGP::Digest->alg($sig->{hash_alg}));
79 8         375090756 my @sig = $cert->key->sig_props;
80 8         32 for my $e (@sig) {
81 15         83 $sig->{$e} = $sig_data->{$e};
82             }
83             }
84 53         172 $sig;
85             }
86              
87             sub sig_trailer {
88 16     16 0 31 my $sig = shift;
89 16         64 my $buf = Crypt::OpenPGP::Buffer->new;
90 16 100       184 if ($sig->{version} < 4) {
91 2         12 $buf->put_int8($sig->{type});
92 2         22 $buf->put_int32($sig->{timestamp});
93             }
94             else {
95 14         73 $buf->put_int8($sig->{version});
96 14         140 $buf->put_int8($sig->{type});
97 14         79 $buf->put_int8($sig->{pk_alg});
98 14         82 $buf->put_int8($sig->{hash_alg});
99 14         109 my $sp_data = $sig->_save_subpackets('hashed');
100 14 50       179 $buf->put_int16(defined $sp_data ? length($sp_data) : 0);
101 14 50       137 $buf->put_bytes($sp_data) if $sp_data;
102 14         114 my $len = $buf->length;
103 14         75 $buf->put_int8($sig->{version});
104 14         71 $buf->put_int8(0xff);
105 14         62 $buf->put_int32($len);
106             }
107 16         103 $buf->bytes;
108             }
109              
110             sub parse {
111 45     45 1 107 my $class = shift;
112 45         94 my($buf) = @_;
113 45         205 my $sig = $class->new;
114              
115 45         163 $sig->{version} = $buf->get_int8;
116 45 100       792 if ($sig->{version} < 4) {
117 2         8 $sig->{sig_data} = $buf->bytes($buf->offset+1, 5);
118 2         19 $sig->{hash_len} = $buf->get_int8;
119             return $class->error("Hash len $sig->{hash_len} != 5")
120 2 50       25 unless $sig->{hash_len} == 5;
121 2         7 $sig->{type} = $buf->get_int8;
122 2         24 $sig->{timestamp} = $buf->get_int32;
123 2         24 $sig->{key_id} = $buf->get_bytes(8);
124 2         25 $sig->{pk_alg} = $buf->get_int8;
125 2         19 $sig->{hash_alg} = $buf->get_int8;
126             }
127             else {
128 43         152 $sig->{sig_data} = $buf->bytes($buf->offset-1, 6);
129 43         555 $sig->{type} = $buf->get_int8;
130 43         525 $sig->{pk_alg} = $buf->get_int8;
131 43         479 $sig->{hash_alg} = $buf->get_int8;
132 43         469 for my $h (qw( hashed unhashed )) {
133 86         472 my $subpack_len = $buf->get_int16;
134 86         1229 my $sp_buf = $buf->extract($subpack_len);
135 86 100       2025 $sig->{sig_data} .= $sp_buf->bytes if $h eq 'hashed';
136 86         486 while ($sp_buf->offset < $sp_buf->length) {
137 154         1080 my $len = $sp_buf->get_int8;
138 154 50 33     1930 if ($len >= 192 && $len < 255) {
    50          
139 0         0 my $len2 = $sp_buf->get_int8;
140 0         0 $len = (($len-192) << 8) + $len2 + 192;
141             } elsif ($len == 255) {
142 0         0 $len = $sp_buf->get_int32;
143             }
144 154         334 my $this_buf = $sp_buf->extract($len);
145 154         3346 my $sp = Crypt::OpenPGP::Signature::SubPacket->parse($this_buf);
146 154         183 push @{ $sig->{"subpackets_$h"} }, $sp;
  154         780  
147             }
148             }
149             }
150 45         348 $sig->{chk} = $buf->get_bytes(2);
151             ## XXX should be Crypt::OpenPGP::Signature->new($sig->{pk_alg})?
152             my $key = Crypt::OpenPGP::Key::Public->new($sig->{pk_alg})
153 45 50       886 or return $class->error(Crypt::OpenPGP::Key::Public->errstr);
154 45         179 my @sig = $key->sig_props;
155 45         114 for my $e (@sig) {
156 88         1971 $sig->{$e} = $buf->get_mp_int;
157             }
158 45         2010 $sig;
159             }
160              
161             sub save {
162 8     8 1 16 my $sig = shift;
163 8         49 my $buf = Crypt::OpenPGP::Buffer->new;
164 8         115 $buf->put_int8($sig->{version});
165 8 100       76 if ($sig->{version} < 4) {
166 1         4 $buf->put_int8($sig->{hash_len});
167 1         4 $buf->put_int8($sig->{type});
168 1         5 $buf->put_int32($sig->{timestamp});
169 1         13 $buf->put_bytes($sig->{key_id}, 8);
170 1         7 $buf->put_int8($sig->{pk_alg});
171 1         6 $buf->put_int8($sig->{hash_alg});
172             }
173             else {
174 7         30 $buf->put_int8($sig->{type});
175 7         42 $buf->put_int8($sig->{pk_alg});
176 7         40 $buf->put_int8($sig->{hash_alg});
177 7         37 for my $h (qw( hashed unhashed )) {
178 14         73 my $sp_data = $sig->_save_subpackets($h);
179 14 50       161 $buf->put_int16(defined $sp_data ? length($sp_data) : 0);
180 14 50       116 $buf->put_bytes($sp_data) if $sp_data;
181             }
182             }
183 8         71 $buf->put_bytes($sig->{chk}, 2);
184             ## XXX should be Crypt::OpenPGP::Signature->new($sig->{pk_alg})?
185 8         141 my $key = Crypt::OpenPGP::Key::Public->new($sig->{pk_alg});
186 8         58 my @sig = $key->sig_props;
187 8         26 for my $e (@sig) {
188 15         182 $buf->put_mp_int($sig->{$e});
189             }
190 8         138 $buf->bytes;
191             }
192              
193             sub _save_subpackets {
194 28     28   48 my $sig = shift;
195 28         72 my($h) = @_;
196 28         39 my @sp;
197             return unless $sig->{"subpackets_$h"} &&
198 28 50 33     149 (@sp = @{ $sig->{"subpackets_$h"} });
  28         165  
199 28         120 my $sp_buf = Crypt::OpenPGP::Buffer->new;
200 28         218 for my $sp (@sp) {
201 28         141 my $data = $sp->save;
202 28         298 my $len = length $data;
203 28 50       68 if ($len < 192) {
    0          
204 28         78 $sp_buf->put_int8($len);
205             } elsif ($len < 8384) {
206 0         0 $len -= 192;
207 0         0 $sp_buf->put_int8( int($len / 256) + 192 );
208 0         0 $sp_buf->put_int8( $len % 256 );
209             } else {
210 0         0 $sp_buf->put_int8(255);
211 0         0 $sp_buf->put_int32($len);
212             }
213 28         175 $sp_buf->put_bytes($data);
214             }
215 28         240 $sp_buf->bytes;
216             }
217              
218             sub hash_data {
219 16     16 1 35 my $sig = shift;
220 16         101 my $buf = Crypt::OpenPGP::Buffer->new;
221 16         164 my $type = ref($_[0]);
222 16 100       82 if ($type eq 'Crypt::OpenPGP::Certificate') {
    50          
223 4         7 my $cert = shift;
224 4         21 $buf->put_int8(0x99);
225 4         57 my $pk = $cert->public_cert->save;
226 4         94 $buf->put_int16(length $pk);
227 4         33 $buf->put_bytes($pk);
228              
229 4 50       33 if (@_) {
230 4 50       20 if (ref($_[0]) eq 'Crypt::OpenPGP::UserID') {
    0          
231 4         12 my $uid = shift;
232 4         23 my $ud = $uid->save;
233 4 100       22 if ($sig->{version} >= 4) {
234 2         11 $buf->put_int8(0xb4);
235 2         22 $buf->put_int32(length $ud);
236             }
237 4         24 $buf->put_bytes($ud);
238             }
239             elsif (ref($_[0]) eq 'Crypt::OpenPGP::Certificate') {
240 0         0 my $subcert = shift;
241 0         0 $buf->put_int8(0x99);
242 0         0 my $k = $subcert->public_cert->save;
243 0         0 $buf->put_int16(length $k);
244 0         0 $buf->put_bytes($k);
245             }
246             }
247             }
248             elsif ($type eq 'Crypt::OpenPGP::Plaintext') {
249 12         24 my $pt = shift;
250 12         53 my $data = $pt->data;
251 12 100       48 if ($pt->mode eq 't') {
252 2         18 require Crypt::OpenPGP::Util;
253 2         12 $buf->put_bytes(Crypt::OpenPGP::Util::canonical_text($data));
254             }
255             else {
256 10         56 $buf->put_bytes($data);
257             }
258             }
259              
260 16         218 $buf->put_bytes($sig->sig_trailer);
261              
262 16 50       529 my $hash = Crypt::OpenPGP::Digest->new($sig->{hash_alg}) or
263             return $sig->error( Crypt::OpenPGP::Digest->errstr );
264 16         59 $hash->hash($buf->bytes);
265             }
266              
267             1;
268             __END__
269              
270             =head1 NAME
271              
272             Crypt::OpenPGP::Signature - Signature packet
273              
274             =head1 SYNOPSIS
275              
276             use Crypt::OpenPGP::Signature;
277              
278             my $cert = Crypt::OpenPGP::Certificate->new;
279             my $plaintext = 'foo bar';
280              
281             my $sig = Crypt::OpenPGP::Signature->new(
282             Key => $cert,
283             Data => $plaintext,
284             );
285             my $serialized = $sig->save;
286              
287             =head1 DESCRIPTION
288              
289             I<Crypt::OpenPGP::Signature> implements PGP signature packets and
290             provides functionality for hashing PGP packets to obtain message
291             digests; these digests are then signed by the secret key to form a
292             signature.
293              
294             I<Crypt::OpenPGP::Signature> reads and writes both version 3 and version
295             4 signatures, along with the signature subpackets found in version 4
296             (see I<Crypt::OpenPGP::Signature::SubPacket>).
297              
298             =head1 USAGE
299              
300             =head2 Crypt::OpenPGP::Signature->new( %arg )
301              
302             Creates a new signature packet object and returns that object. If
303             there are no arguments in I<%arg>, the object is created empty; this is
304             used, for example, in I<parse> (below), to create an empty packet which is
305             then filled from the data in the buffer.
306              
307             If you wish to initialize a non-empty object, I<%arg> can contain:
308              
309             =over 4
310              
311             =item * Data
312              
313             A PGP packet object of some kind. Currently the two supported objects
314             are I<Crypt::OpenPGP::Certificate> objects, to create self-signatures
315             for keyrings, and I<Crypt::OpenPGP::Plaintext> objects, for signatures
316             on blocks of data.
317              
318             This argument is required (for a non-empty packet).
319              
320             =item * Key
321              
322             A secret-key certificate that can be used to sign the data. In other
323             words an object of type I<Crypt::OpenPGP::Certificate> that holds
324             a secret key.
325              
326             This argument is required.
327              
328             =item * Version
329              
330             The packet format version of the signature. Valid values are either
331             C<3> or C<4>; version C<4> signatures are the default, but will be
332             incompatible with older PGP implementations; for example, PGP2 will
333             only read version 3 signatures; PGP5 can read version 4 signatures,
334             but only on signatures of data packets (not on key signatures).
335              
336             This argument is optional; the default is version 4.
337              
338             =item * Type
339              
340             Specifies the type of signature (data, key, etc.). Valid values can
341             be found in the OpenPGP RFC, section 5.2.1.
342              
343             This argument is optional; the default is C<0x00>, signature of a
344             binary document.
345              
346             =item * Digest
347              
348             The digest algorithm to use when generating the digest of the data
349             to be signed. See the documentation for I<Crypt::OpenPGP::Digest>
350             for a list of valid values.
351              
352             This argument is optional; the default is C<SHA1>.
353              
354             =back
355              
356             =head2 $sig->save
357              
358             Serializes the signature packet and returns a string of octets.
359              
360             =head2 Crypt::OpenPGP::Signature->parse($buffer)
361              
362             Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
363             with offset pointing to) a signature packet, returns a new
364             I<Crypt::OpenPGP::Signature> object, initialized with the signature
365             data in the buffer.
366              
367             =head2 $sig->hash_data(@data)
368              
369             Prepares a digital hash of the packets in I<@data>; the hashing method
370             depends on the type of packets in I<@data>, and the hashing algorithm used
371             depends on the algorithm associated with the I<Crypt::OpenPGP::Signature>
372             object I<$sig>. This digital hash is then signed to produce the signature
373             itself.
374              
375             You generally do not need to use this method unless you have not passed in
376             the I<Data> parameter to I<new> (above).
377              
378             There are two possible packet types that can be included in I<@data>:
379              
380             =over 4
381              
382             =item * Key Certificate and User ID
383              
384             An OpenPGP keyblock contains a key certificate and a signature of the
385             public key and user ID made by the secret key. This is called a
386             self-signature. To produce a self-signature, I<@data> should contain two
387             packet objects: a I<Crypt::OpenPGP::Certificate> object and a
388             I<Crypt::OpenPGP::UserID> object. For example:
389              
390             my $hash = $sig->hash_data($cert, $id)
391             or die $sig->errstr;
392              
393             =item * Plaintext
394              
395             To sign a piece of plaintext, pass in a I<Crypt::OpenPGP::Plaintext> object.
396             This is a standard OpenPGP signature.
397              
398             my $pt = Crypt::OpenPGP::Plaintext->new( Data => 'foo bar' );
399             my $hash = $sig->hash_data($pt)
400             or die $sig->errstr;
401              
402             =back
403              
404             =head2 $sig->key_id
405              
406             Returns the ID of the key that created the signature.
407              
408             =head2 $sig->timestamp
409              
410             Returns the time that the signature was created in Unix epoch time (seconds
411             since 1970).
412              
413             =head2 $sig->digest
414              
415             Returns a Crypt::OpenPGP::Digest object representing the digest algorithm
416             used by the signature.
417              
418             =head1 AUTHOR & COPYRIGHTS
419              
420             Please see the Crypt::OpenPGP manpage for author, copyright, and
421             license information.
422              
423             =cut