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