File Coverage

blib/lib/Convert/PEM.pm
Criterion Covered Total %
statement 130 134 97.0
branch 30 52 57.7
condition 10 22 45.5
subroutine 21 22 95.5
pod 7 13 53.8
total 198 243 81.5


line stmt bran cond sub pod time code
1             # $Id: PEM.pm 1829 2005-05-25 21:51:40Z btrott $
2              
3             package Convert::PEM;
4 3     3   50 use strict;
  3         38  
  3         48  
5 3     3   47 use base qw( Class::ErrorHandler );
  3         24  
  3         47  
6              
7 3     3   116 use MIME::Base64;
  3         31  
  3         126  
8 3     3   55 use Digest::MD5 qw( md5 );
  3         26  
  3         44  
9 3     3   119 use Convert::ASN1;
  3         33  
  3         63  
10 3     3   60 use Carp qw( croak );
  3         28  
  3         77  
11 3     3   149 use Convert::PEM::CBC;
  3         33  
  3         61  
12              
13 3     3   51 use vars qw( $VERSION );
  3         27  
  3         47  
14             $VERSION = '0.07';
15              
16             sub new {
17 2     2 1 21     my $class = shift;
18 2         61     my $pem = bless { }, $class;
19 2         27     $pem->init(@_);
20             }
21              
22             sub init {
23 2     2 0 19     my $pem = shift;
24 2         26     my %param = @_;
25 2 50 33     39     unless (exists $param{ASN} && exists $param{Name}) {
26 0         0         return (ref $pem)->error("init: Name and ASN are required");
27                 }
28                 else {
29 2         22         $pem->{ASN} = $param{ASN};
30 2         23         $pem->{Name} = $param{Name};
31                 }
32 2         20     $pem->{Macro} = $param{Macro};
33 2         37     my $asn = $pem->{_asn} = Convert::ASN1->new;
34 2 50       161     $asn->prepare( $pem->{ASN} ) or
35                     return (ref $pem)->error("ASN prepare failed: $asn->{error}");
36 2         4202     $pem;
37             }
38              
39 12     12 1 138 sub asn { $_[0]->{_asn} }
40 0     0 1 0 sub ASN { $_[0]->{ASN} }
41 14     14 0 228 sub name { $_[0]->{Name} }
42              
43             sub read {
44 4     4 1 39     my $pem = shift;
45 4         47     my %param = @_;
46              
47 4         31     my $blob;
48 4         35     local *FH;
49 4         42     my $fname = delete $param{Filename};
50 4 50       245     open FH, $fname or
51                     return $pem->error("Can't open $fname: $!");
52 4         55     $blob = do { local $/; <FH> };
  4         45  
  4         388  
53 4         97     close FH;
54              
55 4         51     $param{Content} = $blob;
56 4         67     $pem->decode(%param);
57             }
58              
59             sub write {
60 3     3 1 30     my $pem = shift;
61 3         43     my %param = @_;
62              
63 3 50       2158     my $fname = delete $param{Filename} or
64                     return $pem->error("write: Filename is required");
65 3         73     my $blob = $pem->encode(%param);
66              
67 3         35     local *FH;
68 3 50       426     open FH, ">$fname" or
69                     return $pem->error("Can't open $fname: $!");
70 3         141     print FH $blob;
71 3         403     close FH;
72 3         96     $blob;
73             }
74              
75             sub decode {
76 8     8 1 109     my $pem = shift;
77 8         213     my %param = @_;
78 8 50       92     my $blob = $param{Content} or
79                     return $pem->error("'Content' is required");
80 8         73     chomp $blob;
81              
82 8 50       87     my $dec = $pem->explode($blob) or return;
83 8   33     218     my $name = $param{Name} || $pem->name;
84 8 50       89     return $pem->error("Object $dec->{Object} does not match " . $name)
85                     unless $dec->{Object} eq $name;
86              
87 8         125     my $head = $dec->{Headers};
88 8         79     my $buf = $dec->{Content};
89 8         79     my %headers = map { $_->[0] => $_->[1] } @$head;
  8         98  
90 8 100 66     126     if (%headers && $headers{'Proc-Type'} eq '4,ENCRYPTED') {
91 4 100       93         $buf = $pem->decrypt( Ciphertext => $buf,
92                                           Info => $headers{'DEK-Info'},
93                                           Password => $param{Password} )
94                         or return;
95                 }
96              
97 6         102     my $asn = $pem->asn;
98 6 50 33     187     if (my $macro = ($param{Macro} || $pem->{Macro})) {
99 0 0       0         $asn = $asn->find($macro) or
100                         return $pem->error("Can't find Macro $macro");
101                 }
102 6 50       1242     my $obj = $asn->decode($buf) or
103                     return $pem->error("ASN decode failed: $asn->{error}");
104              
105 6         2717     $obj;
106             }
107              
108             sub encode {
109 6     6 1 60     my $pem = shift;
110 6         72     my %param = @_;
111              
112 6         104     my $asn = $pem->asn;
113 6 50 33     108     if (my $macro = ($param{Macro} || $pem->{Macro})) {
114 0 0       0         $asn = $asn->find($macro) or
115                         return $pem->error("Can't find Macro $macro");
116                 }
117 6 50       86     my $buf = $asn->encode( $param{Content} ) or
118                     return $pem->error("ASN encode failed: $asn->{error}");
119              
120 6         2076     my(@headers);
121 6 100       72     if ($param{Password}) {
122 2         19         my($info);
123 2 50       28         ($buf, $info) = $pem->encrypt( Plaintext => $buf,
124                                                    Password => $param{Password} )
125                         or return;
126 2         75         push @headers, [ 'Proc-Type' => '4,ENCRYPTED' ];
127 2         27         push @headers, [ 'DEK-Info' => $info ];
128                 }
129              
130 6   33     94     $pem->implode( Object => $param{Name} || $pem->name,
131                                Headers => \@headers,
132                                Content => $buf );
133             }
134              
135             sub explode {
136 8     8 0 139     my $pem = shift;
137 8         115     my($message) = @_;
138 8         209     my($head, $object, $headers, $content, $tail) = $message =~
139                     m:(-----BEGIN ([^\n\-]+)-----)\n(.*?\n\n)?(.+)(-----END .*?-----)$:s;
140 8         98     my $buf = decode_base64($content);
141              
142 8         70     my @headers;
143 8 100       80     if ($headers) {
144 4         56         for my $h ( split /\n/, $headers ) {
145 8         98             my($k, $v) = split /:\s*/, $h, 2;
146 8 50       452             push @headers, [ $k => $v ] if $k;
147                     }
148                 }
149              
150 8         154     { Content => $buf,
151                   Object => $object,
152                   Headers => \@headers }
153             }
154              
155             sub implode {
156 6     6 0 56     my $pem = shift;
157 6         81     my %param = @_;
158 6         67     my $head = "-----BEGIN $param{Object}-----";
159 6         64     my $tail = "-----END $param{Object}-----";
160 6         80     my $content = encode_base64( $param{Content}, '' );
161 6         160     $content =~ s!(.{1,64})!$1\n!g;
162 4         78     my $headers = join '',
163 6         69                   map { "$_->[0]: $_->[1]\n" }
164 6         54                   @{ $param{Headers} };
165 6 100       66     $headers .= "\n" if $headers;
166 6         107     "$head\n$headers$content$tail\n";
167             }
168              
169 3     3   75 use vars qw( %CTYPES );
  3         32  
  3         73  
170             %CTYPES = ('DES-EDE3-CBC' => 'Crypt::DES_EDE3');
171              
172             sub decrypt {
173 4     4 0 38     my $pem = shift;
174 4         53     my %param = @_;
175 4   100     52     my $passphrase = $param{Password} || "";
176 4         51     my($ctype, $iv) = split /,/, $param{Info};
177 4 50       49     my $cmod = $CTYPES{$ctype} or
178                     return $pem->error("Unrecognized cipher: '$ctype'");
179 4         51     $iv = pack "H*", $iv;
180 4         70     my $cbc = Convert::PEM::CBC->new(
181                                Passphrase => $passphrase,
182                                Cipher => $cmod,
183                                IV => $iv );
184 4 100       52     my $buf = $cbc->decrypt($param{Ciphertext}) or
185                     return $pem->error("Decryption failed: " . $cbc->errstr);
186 2         74     $buf;
187             }
188              
189             sub encrypt {
190 2     2 0 21     my $pem = shift;
191 2         26     my %param = @_;
192 2 50       25     $param{Password} or return $param{Plaintext};
193 2   50     80     my $ctype = $param{Cipher} || 'DES-EDE3-CBC';
194 2 50       36     my $cmod = $CTYPES{$ctype} or
195                     return $pem->error("Unrecognized cipher: '$ctype'");
196 2         46     my $cbc = Convert::PEM::CBC->new(
197                                 Passphrase => $param{Password},
198                                 Cipher => $cmod );
199 2         30     my $iv = uc join '', unpack "H*", $cbc->iv;
200 2 50       30     my $buf = $cbc->encrypt($param{Plaintext}) or
201                     return $pem->error("Encryption failed: " . $cbc->errstr);
202 2         25     ($buf, "$ctype,$iv");
203             }
204              
205             1;
206             __END__
207            
208             =head1 NAME
209            
210             Convert::PEM - Read/write encrypted ASN.1 PEM files
211            
212             =head1 SYNOPSIS
213            
214             use Convert::PEM;
215             my $pem = Convert::PEM->new(
216             Name => "DSA PRIVATE KEY",
217             ASN => qq(
218             DSAPrivateKey SEQUENCE {
219             version INTEGER,
220             p INTEGER,
221             q INTEGER,
222             g INTEGER,
223             pub_key INTEGER,
224             priv_key INTEGER
225             }
226             ));
227            
228             my $pkey = $pem->read(
229             Filename => $keyfile,
230             Password => $pwd
231             );
232            
233             $pem->write(
234             Content => $pkey,
235             Password => $pwd,
236             Filename => $keyfile
237             );
238            
239             =head1 DESCRIPTION
240            
241             I<Convert::PEM> reads and writes PEM files containing ASN.1-encoded
242             objects. The files can optionally be encrypted using a symmetric
243             cipher algorithm, such as 3DES. An unencrypted PEM file might look
244             something like this:
245            
246             -----BEGIN DH PARAMETERS-----
247             MB4CGQDUoLoCULb9LsYm5+/WN992xxbiLQlEuIsCAQM=
248             -----END DH PARAMETERS-----
249            
250             The string beginning C<MB4C...> is the Base64-encoded, ASN.1-encoded
251             "object."
252            
253             An encrypted file would have headers describing the type of
254             encryption used, and the initialization vector:
255            
256             -----BEGIN DH PARAMETERS-----
257             Proc-Type: 4,ENCRYPTED
258             DEK-Info: DES-EDE3-CBC,C814158661DC1449
259            
260             AFAZFbnQNrGjZJ/ZemdVSoZa3HWujxZuvBHzHNoesxeyqqidFvnydA==
261             -----END DH PARAMETERS-----
262            
263             The two headers (C<Proc-Type> and C<DEK-Info>) indicate information
264             about the type of encryption used, and the string starting with
265             C<AFAZ...> is the Base64-encoded, encrypted, ASN.1-encoded
266             contents of this "object."
267            
268             The initialization vector (C<C814158661DC1449>) is chosen randomly.
269            
270             =head1 USAGE
271            
272             =head2 $pem = Convert::PEM->new( %arg )
273            
274             Constructs a new I<Convert::PEM> object designed to read/write an
275             object of a specific type (given in I<%arg>, see below). Returns the
276             new object on success, C<undef> on failure (see I<ERROR HANDLING> for
277             details).
278            
279             I<%arg> can contain:
280            
281             =over 4
282            
283             =item * Name
284            
285             The name of the object; when decoding a PEM-encoded stream, the name
286             in the encoding will be checked against the value of I<Name>.
287             Similarly, when encoding an object, the value of I<Name> will be used
288             as the name of the object in the PEM-encoded content. For example, given
289             the string C<FOO BAR>, the output from I<encode> will start with a
290             header like:
291            
292             -----BEGIN FOO BAR-----
293            
294             I<Name> is a required argument.
295            
296             =item * ASN
297            
298             An ASN.1 description of the content to be either encoded or decoded.
299            
300             I<ASN> is a required argument.
301            
302             =item * Macro
303            
304             If your ASN.1 description (in the I<ASN> parameter) includes more than
305             one ASN.1 macro definition, you will want to use the I<Macro> parameter
306             to specify which definition to use when encoding/decoding objects.
307             For example, if your ASN.1 description looks like this:
308            
309             Foo ::= SEQUENCE {
310             x INTEGER,
311             bar Bar
312             }
313            
314             Bar ::= INTEGER
315            
316             If you want to encode/decode a C<Foo> object, you will need to tell
317             I<Convert::PEM> to use the C<Foo> macro definition by using the I<Macro>
318             parameter and setting the value to C<Foo>.
319            
320             I<Macro> is an optional argument.
321            
322             =back
323            
324             =head2 $obj = $pem->decode(%args)
325            
326             Decodes, and, optionally, decrypts a PEM file, returning the
327             object as decoded by I<Convert::ASN1>. The difference between this
328             method and I<read> is that I<read> reads the contents of a PEM file
329             on disk; this method expects you to pass the PEM contents as an
330             argument.
331            
332             If an error occurs while reading the file or decrypting/decoding
333             the contents, the function returns I<undef>, and you should check
334             the error message using the I<errstr> method (below).
335            
336             I<%args> can contain:
337            
338             =over 4
339            
340             =item * Content
341            
342             The PEM contents.
343            
344             =item * Password
345            
346             The password with which the file contents were encrypted.
347            
348             If the file is encrypted, this is a mandatory argument (well, it's
349             not strictly mandatory, but decryption isn't going to work without
350             it). Otherwise it's not necessary.
351            
352             =back
353            
354             =head2 $blob = $pem->encode(%args)
355            
356             Constructs the contents for the PEM file from an object: ASN.1-encodes
357             the object, optionally encrypts those contents.
358            
359             Returns I<undef> on failure (encryption failure, file-writing failure,
360             etc.); in this case you should check the error message using the
361             I<errstr> method (below). On success returns the constructed PEM string.
362            
363             I<%args> can contain:
364            
365             =over 4
366            
367             =item * Content
368            
369             A hash reference that will be passed to I<Convert::ASN1::encode>,
370             and which should correspond to the ASN.1 description you gave to the
371             I<new> method. The hash reference should have the exact same format
372             as that returned from the I<read> method.
373            
374             This argument is mandatory.
375            
376             =item * Password
377            
378             A password used to encrypt the contents of the PEM file. This is an
379             optional argument; if not provided the contents will be unencrypted.
380            
381             =back
382            
383             =head2 $obj = $pem->read(%args)
384            
385             Reads, decodes, and, optionally, decrypts a PEM file, returning
386             the object as decoded by I<Convert::ASN1>. This is implemented
387             as a wrapper around I<decode>, with the bonus of reading the PEM
388             file from disk for you.
389            
390             If an error occurs while reading the file or decrypting/decoding
391             the contents, the function returns I<undef>, and you should check
392             the error message using the I<errstr> method (below).
393            
394             In addition to the arguments that can be passed to the I<decode>
395             method (minus the I<Content> method), I<%args> can contain:
396            
397             =over 4
398            
399             =item * Filename
400            
401             The location of the PEM file that you wish to read.
402            
403             =back
404            
405             =head2 $pem->write(%args)
406            
407             Constructs the contents for the PEM file from an object: ASN.1-encodes
408             the object, optionally encrypts those contents; then writes the file
409             to disk. This is implemented as a wrapper around I<encode>, with the
410             bonus of writing the file to disk for you.
411            
412             Returns I<undef> on failure (encryption failure, file-writing failure,
413             etc.); in this case you should check the error message using the
414             I<errstr> method (below). On success returns the constructed PEM string.
415            
416             In addition to the arguments for I<encode>, I<%args> can contain:
417            
418             =over 4
419            
420             =item * Filename
421            
422             The location on disk where you'd like the PEM file written.
423            
424             =back
425            
426             =head2 $pem->errstr
427            
428             Returns the value of the last error that occurred. This should only
429             be considered meaningful when you've received I<undef> from one of
430             the functions above; in all other cases its relevance is undefined.
431            
432             =head2 $pem->asn
433            
434             Returns the I<Convert::ASN1> object used internally to decode and
435             encode ASN.1 representations. This is useful when you wish to
436             interact directly with that object; for example, if you need to
437             call I<configure> on that object to set the type of big-integer
438             class to be used when decoding/encoding big integers:
439            
440             $pem->asn->configure( decode => { bigint => 'Math::Pari' },
441             encode => { bigint => 'Math::Pari' } );
442            
443             =head1 ERROR HANDLING
444            
445             If an error occurs in any of the above methods, the method will return
446             C<undef>. You should then call the method I<errstr> to determine the
447             source of the error:
448            
449             $pem->errstr
450            
451             In the case that you do not yet have a I<Convert::PEM> object (that is,
452             if an error occurs while creating a I<Convert::PEM> object), the error
453             can be obtained as a class method:
454            
455             Convert::PEM->errstr
456            
457             For example, if you try to decode an encrypted object, and you do not
458             give a passphrase to decrypt the object:
459            
460             my $obj = $pem->read( Filename => "encrypted.pem" )
461             or die "Decryption failed: ", $pem->errstr;
462            
463             =head1 AUTHOR & COPYRIGHTS
464            
465             Benjamin Trott, ben@rhumba.pair.com
466            
467             Except where otherwise noted, Convert::PEM is Copyright 2001
468             Benjamin Trott. All rights reserved. Convert::PEM is free
469             software; you may redistribute it and/or modify it under
470             the same terms as Perl itself.
471            
472             =cut
473