File Coverage

blib/lib/XML/Enc.pm
Criterion Covered Total %
statement 397 434 91.4
branch 70 110 63.6
condition 11 16 68.7
subroutine 52 54 96.3
pod 3 3 100.0
total 533 617 86.3


line stmt bran cond sub pod time code
1 10     10   1144774 use strict;
  10         97  
  10         302  
2 10     10   53 use warnings;
  10         20  
  10         517  
3              
4             package XML::Enc;
5             our $VERSION = '0.13'; # VERSION
6              
7             # ABSTRACT: XML::Enc Encryption Support
8              
9 10     10   60 use Carp;
  10         16  
  10         714  
10 10     10   4850 use Crypt::AuthEnc::GCM 0.062;
  10         32207  
  10         475  
11 10     10   4368 use Crypt::Mode::CBC;
  10         9511  
  10         278  
12 10     10   5405 use Crypt::PK::RSA;
  10         112452  
  10         488  
13 10     10   79 use Crypt::PRNG qw( random_bytes );
  10         18  
  10         461  
14 10     10   4668 use MIME::Base64 qw/decode_base64 encode_base64/;
  10         6503  
  10         645  
15 10     10   6988 use XML::LibXML;
  10         497821  
  10         78  
16              
17             # state means perl 5.10
18 10     10   1533 use feature 'state';
  10         26  
  10         1356  
19 10     10   91 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
  10         22  
  10         53265  
20              
21             our $DEBUG = 0;
22              
23              
24             # Source: https://www.w3.org/TR/2002/REC-xmlenc-core-20021210/Overview.html#sec-Alg-Block
25             # 5.2.1 Triple DES - 64 bit Initialization Vector (IV) (8 bytes)
26             # 5.2.2 AES - 128 bit initialization vector (IV) (16 bytes)
27              
28             sub _assert_symmetric_algorithm {
29 114     114   175 my $algo = shift;
30              
31 114         326 state $SYMMETRIC = {
32             'http://www.w3.org/2001/04/xmlenc#tripledes-cbc' => {
33             ivsize => 8,
34             keysize => 24,
35             modename => 'DES_EDE'
36             },
37             'http://www.w3.org/2001/04/xmlenc#aes128-cbc' => {
38             ivsize => '16',
39             keysize => 16,
40             modename => 'AES'
41             },
42             'http://www.w3.org/2001/04/xmlenc#aes192-cbc' => {
43             ivsize => '16',
44             keysize => 24,
45             modename => 'AES'
46             },
47             'http://www.w3.org/2001/04/xmlenc#aes256-cbc' => {
48             ivsize => '16',
49             keysize => 32,
50             modename => 'AES'
51             },
52             'http://www.w3.org/2009/xmlenc11#aes128-gcm' => {
53             ivsize => '12',
54             keysize => 16,
55             modename => 'AES',
56             tagsize => 16
57             },
58             'http://www.w3.org/2009/xmlenc11#aes192-gcm' => {
59             ivsize => '12',
60             keysize => 24,
61             modename => 'AES',
62             tagsize => 16
63             },
64             'http://www.w3.org/2009/xmlenc11#aes256-gcm' => {
65             ivsize => '12',
66             keysize => 32,
67             modename => 'AES',
68             tagsize => 16
69             },
70             };
71              
72 114 50       431 die "Unsupported symmetric algo $algo" unless $SYMMETRIC->{ $algo };
73 114         235 return $SYMMETRIC->{$algo}
74             }
75              
76             sub _assert_encryption_digest {
77 2     2   5 my $algo = shift;
78              
79 2         9 state $ENC_DIGEST = {
80             'http://www.w3.org/2000/09/xmldsig#sha1' => 'SHA1',
81             'http://www.w3.org/2001/04/xmlenc#sha256' => 'SHA256',
82             };
83              
84 2 50       10 die "Unsupported encryption digest algo $algo" unless $ENC_DIGEST->{ $algo };
85 2         6 return $ENC_DIGEST->{ $algo };
86             }
87              
88              
89              
90             sub new {
91 65     65 1 78792 my $class = shift;
92 65         207 my $params = shift;
93 65         126 my $self = {};
94              
95 65         153 bless $self, $class;
96              
97 65 50       211 if ( exists $params->{ 'key' } ) {
98 65         197 $self->{key} = $params->{ 'key' };
99 65         199 $self->_load_key( $params->{ 'key' } );
100             }
101 65 100       232 if ( exists $params->{ 'cert' } ) {
102 52         111 $self->{cert} = $params->{ 'cert' };
103 52         178 $self->_load_cert_file( $params->{ 'cert' } );
104             }
105 65 50       190 if (exists $params->{'no_xml_declaration'}) {
106 65 50       221 $self->{'no_xml_declaration'} = $params->{'no_xml_declaration'} ? $params->{'no_xml_declaration'} : 0;
107             }
108              
109 65 100       167 my $enc_method = exists($params->{'data_enc_method'}) ? $params->{'data_enc_method'} : 'aes256-cbc';
110 65         195 $self->{'data_enc_method'} = $self->_setEncryptionMethod($enc_method);
111              
112 65 100       177 my $key_method = exists($params->{'key_transport'}) ? $params->{'key_transport'} : 'rsa-oaep-mgf1p ';
113 65         177 $self->{'key_transport'} = $self->_setKeyEncryptionMethod($key_method);
114              
115 65 100       176 my $oaep_mgf_alg = exists($params->{'oaep_mgf_alg'}) ? $params->{'oaep_mgf_alg'} : 'http://www.w3.org/2009/xmlenc11#mgf1sha1';
116 65         151 $self->{'oaep_mgf_alg'} = $self->_setOAEPAlgorithm($oaep_mgf_alg);
117              
118 65 100       171 $self->{'oaep_params'} = exists($params->{'oaep_params'}) ? $params->{'oaep_params'} : '';
119              
120 65         309 return $self;
121             }
122              
123              
124             sub decrypt {
125 65     65 1 47091 my $self = shift;
126 65         148 my $xml = shift;
127 65         130 my %options = @_;
128              
129 65         141 local $XML::LibXML::skipXMLDeclaration = $self->{ no_xml_declaration };
130              
131 65         264 my $doc = XML::LibXML->load_xml( string => $xml );
132              
133 64         19701 my $xpc = XML::LibXML::XPathContext->new($doc);
134 64         436 $xpc->registerNs('dsig', 'http://www.w3.org/2000/09/xmldsig#');
135 64         247 $xpc->registerNs('xenc', 'http://www.w3.org/2001/04/xmlenc#');
136 64         194 $xpc->registerNs('xenc11', 'http://www.w3.org/2009/xmlenc11#');
137 64         176 $xpc->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
138              
139 64 50       202 return $doc unless $xpc->exists('//xenc:EncryptedData');
140              
141 64 50       2697 die "You cannot decrypt XML without a private key." unless $self->{key_obj};
142              
143 64         223 my $parser = XML::LibXML->new();
144 64         936 $self->_decrypt_encrypted_key_nodes($xpc, $parser, %options);
145 64         2557 $self->_decrypt_uri_nodes($xpc, $parser, %options);
146              
147 64         262 return $doc->serialize();
148             }
149              
150             sub _decrypt_encrypted_key_nodes {
151 64     64   97 my $self = shift;
152 64         95 my $xpc = shift;
153 64         87 my $parser = shift;
154 64         109 my %options = @_;
155              
156             my $k = $self->_get_named_key_nodes(
157             '//xenc:EncryptedData/dsig:KeyInfo/xenc:EncryptedKey',
158             $xpc, $options{key_name}
159 64         239 );
160              
161             $k->foreach(
162             sub {
163 63     63   816 my $key = $self->_get_key_from_node($_, $xpc);
164 63 100       174 return unless $key;
165 62         520 my $encrypted_node = $_->parentNode->parentNode;
166 62         299 $self->_decrypt_encrypted_node($encrypted_node,
167             $key, $xpc, $parser);
168             }
169 64         506 );
170             }
171              
172             sub _decrypt_uri_nodes {
173 64     64   131 my $self = shift;
174 64         89 my $xpc = shift;
175 64         87 my $parser = shift;
176 64         136 my %options = @_;
177              
178 64         172 my $uri_nodes = $xpc->findnodes('//dsig:KeyInfo/dsig:RetrievalMethod/@URI');
179 64     1   2969 my @uri_nodes = $uri_nodes->map(sub { my $v = $_->getValue; $v =~ s/^#//; return $v; });
  1         19  
  1         9  
  1         7  
180              
181 64         1364 foreach my $uri (@uri_nodes) {
182             my $encrypted_key_nodes = $self->_get_named_key_nodes(
183             sprintf('//xenc:EncryptedKey[@Id="%s"]', $uri),
184 1         9 $xpc, $options{key_name});
185              
186             $encrypted_key_nodes->foreach(
187             sub {
188              
189 1     1   12 my $key = $self->_get_key_from_node($_, $xpc);
190 1 50       4 return unless $key;
191              
192 1         13 my $encrypted_nodes = $xpc->findnodes(sprintf('//dsig:KeyInfo/dsig:RetrievalMethod[@URI="#%s"]/../..', $uri));
193 1 50       78 return unless $encrypted_nodes->size;
194              
195             $encrypted_nodes->foreach(sub {
196 1         14 $self->_decrypt_encrypted_node(
197             $_,
198             $key,
199             $xpc,
200             $parser
201             );
202 1         14 });
203              
204             # We don't need the encrypted key here
205 1         29 $_->removeChildNodes();
206             }
207 1         8 );
208             }
209             }
210              
211             sub _get_named_key_nodes {
212 65     65   115 my $self = shift;
213 65         92 my $xpath = shift;
214 65         91 my $xpc = shift;
215 65         145 my $name = shift;
216              
217 65         165 my $nodes = $xpc->findnodes($xpath);
218 65 50       2854 return $nodes unless $name;
219             return $nodes->grep(
220             sub {
221 0     0   0 $xpc->findvalue('dsig:KeyInfo/dsig:KeyName', $_) eq $name;
222             }
223 0         0 );
224             }
225              
226             sub _decrypt_encrypted_node {
227 63     63   1236 my $self = shift;
228 63         95 my $node = shift;
229 63         94 my $key = shift;
230 63         113 my $xpc = shift;
231 63         90 my $parser = shift;
232              
233 63         161 my $algo = $self->_get_encryption_algorithm($node, $xpc);
234 63         1168 my $cipher_value = $self->_get_cipher_value($node, $xpc);
235 63         2039 my $oaep = $self->_get_oaep_params($node, $xpc);
236              
237 63         226 my $decrypted_data = $self->_DecryptData($algo, $key, $cipher_value);
238              
239             # Sooo.. parse_balanced_chunk breaks when there is a 240             # bit in the decrypted data and thus we have to remove it.
241             # We try parsing the XML here and if that works we get all the nodes
242 63         123 my $new = eval { $parser->load_xml(string => $decrypted_data)->findnodes('//*')->[0]; };
  63         208  
243              
244 63 100       23879 if ($new) {
245 61         760 $node->addSibling($new);
246 61         147 $node->unbindNode();
247 61         869 return;
248             }
249              
250 2         13 $decrypted_data = $parser->parse_balanced_chunk($decrypted_data);
251 2 50 50     461 if (($node->parentNode->localname //'') eq 'EncryptedID') {
252 0         0 $node->parentNode->replaceNode($decrypted_data);
253 0         0 return;
254             }
255 2         10 $node->replaceNode($decrypted_data);
256 2         58 return;
257             }
258              
259             sub _get_key_from_node {
260 64     64   112 my $self = shift;
261 64         82 my $node = shift;
262 64         88 my $xpc = shift;
263              
264 64         132 my $algo = $self->_get_encryption_algorithm($_, $xpc);
265 64         1220 my $cipher_value = $self->_get_cipher_value($_, $xpc);
266 64         2574 my $digest_name = $self->_get_digest_method($_, $xpc);
267 64         137 my $oaep = $self->_get_oaep_params($_, $xpc);
268 64         215 my $mgf = $self->_get_mgf($_, $xpc);
269              
270 64         189 return $self->_decrypt_key(
271             $cipher_value,
272             $algo,
273             $digest_name,
274             $oaep,
275             $mgf,
276             );
277             }
278              
279             sub _get_encryption_algorithm {
280 127     127   186 my $self = shift;
281 127         164 my $node = shift;
282 127         179 my $xpc = shift;
283              
284 127         307 my $nodes = $xpc->findnodes('./xenc:EncryptionMethod/@Algorithm', $node);
285 127 50       6302 return $nodes->get_node(1)->getValue if $nodes->size;
286 0         0 confess "Unable to determine encryption method algorithm from " . $node->nodePath;
287             }
288              
289             sub _get_cipher_value {
290 127     127   208 my $self = shift;
291 127         172 my $node = shift;
292 127         162 my $xpc = shift;
293              
294 127         258 my $nodes = $xpc->findnodes('./xenc:CipherData/xenc:CipherValue', $node);
295 127 50       4919 return decode_base64($nodes->get_node(1)->textContent) if $nodes->size;
296 0         0 confess "Unable to get the CipherValue from " . $node->nodePath;
297             }
298              
299             sub _get_mgf {
300 64     64   103 my $self = shift;
301 64         88 my $node = shift;
302 64         85 my $xpc = shift;
303              
304 64         140 my $value = $xpc->findvalue('./xenc:EncryptionMethod/xenc11:MGF/@Algorithm', $node);
305 64 100       3890 return $value if $value;
306 29         60 return;
307             }
308              
309             sub _get_oaep_params {
310 127     127   183 my $self = shift;
311 127         164 my $node = shift;
312 127         168 my $xpc = shift;
313              
314 127         296 my $value = $xpc->findvalue('./xenc:EncryptionMethod/xenc:OAEPparams', $node);
315 127 100       7892 return decode_base64($value) if $value;
316 124         256 return;
317             }
318              
319             sub _get_digest_method {
320 64     64   105 my $self = shift;
321 64         104 my $node = shift;
322 64         92 my $xpc = shift;
323              
324 64         142 my $value = $xpc->findvalue(
325             './xenc:EncryptionMethod/dsig:DigestMethod/@Algorithm', $node);
326 64 100       4165 return _assert_encryption_digest($value) if $value;
327 62         115 return;
328             }
329              
330              
331             sub encrypt {
332 51     51 1 241 my $self = shift;
333 51         102 my ($xml) = @_;
334              
335 51         118 local $XML::LibXML::skipXMLDeclaration = $self->{ no_xml_declaration };
336              
337             # Create the EncryptedData node
338 51         111 my ($encrypted) = $self->_create_encrypted_data_xml();
339              
340 51         4415 my $dom = XML::LibXML->load_xml( string => $xml);
341              
342 51         13416 my $xpc = XML::LibXML::XPathContext->new($encrypted);
343 51         388 $xpc->registerNs('dsig', 'http://www.w3.org/2000/09/xmldsig#');
344 51         172 $xpc->registerNs('xenc', 'http://www.w3.org/2001/04/xmlenc#');
345 51         165 $xpc->registerNs('xenc11', 'http://www.w3.org/2009/xmlenc11#');
346 51         150 $xpc->registerNs('saml', 'urn:oasis:names:tc:SAML:2.0:assertion');
347              
348             # Encrypt the data an empty key is passed by reference to allow
349             # the key to be generated at the same time the data is being encrypted
350 51         63 my $key;
351 51         102 my $method = $self->{data_enc_method};
352 51         136 my $encrypteddata = $self->_EncryptData ($method, $dom->serialize(), \$key);
353              
354             # Encrypt the Key immediately after the data is encrypted. It is passed by
355             # reference to reduce the number of times that the unencrypted key is
356             # stored in memory
357 51         1432 $self->_EncryptKey($self->{key_transport}, \$key);
358              
359 51         293 my $base64_key = encode_base64($key);
360 51         150 my $base64_data = encode_base64($encrypteddata);
361              
362             # Insert OAEPparams into the XML
363 51 100       148 if ($self->{oaep_params} ne '') {
364 1         7 $encrypted = $self->_setOAEPparams($encrypted, $xpc, encode_base64($self->{oaep_params}));
365             }
366              
367             # Insert Encrypted data into XML
368 51         160 $encrypted = $self->_setEncryptedData($encrypted, $xpc, $base64_data);
369              
370             # Insert the Encrypted Key into the XML
371 51         792 $self->_setKeyEncryptedData($encrypted, $xpc, $base64_key);
372              
373 51         654 return $encrypted->serialize();
374             }
375              
376             sub _setEncryptionMethod {
377 65     65   117 my $self = shift;
378 65         96 my $method = shift;
379              
380 65         435 my %methods = (
381             'aes128-cbc' => 'http://www.w3.org/2001/04/xmlenc#aes128-cbc',
382             'aes192-cbc' => 'http://www.w3.org/2001/04/xmlenc#aes192-cbc',
383             'aes256-cbc' => 'http://www.w3.org/2001/04/xmlenc#aes256-cbc',
384             'tripledes-cbc' => 'http://www.w3.org/2001/04/xmlenc#tripledes-cbc',
385             'aes128-gcm' => 'http://www.w3.org/2009/xmlenc11#aes128-gcm',
386             'aes192-gcm' => 'http://www.w3.org/2009/xmlenc11#aes192-gcm',
387             'aes256-gcm' => 'http://www.w3.org/2009/xmlenc11#aes256-gcm',
388             );
389              
390 65 50       359 return exists($methods{$method}) ? $methods{$method} : $methods{'aes256-cbc'};
391             }
392              
393             sub _setOAEPparams {
394 1     1   3 my $self = shift;
395 1         3 my $context = shift;
396 1         2 my $xpc = shift;
397 1         3 my $oaep_params = shift;
398              
399 1         6 my $node = $xpc->findnodes('//xenc:EncryptedKey/xenc:EncryptionMethod/xenc:OAEPparams', $context);
400              
401 1         91 $node->[0]->removeChildNodes();
402 1         8 $node->[0]->appendText($oaep_params);
403 1         4 return $context;
404             }
405              
406             sub _setOAEPAlgorithm {
407 65     65   100 my $self = shift;
408 65         100 my $method = shift;
409              
410 65         119 state $setOAEPAlgorithm = {
411             'mgf1sha1' => 'http://www.w3.org/2009/xmlenc11#mgf1sha1',
412             'mgf1sha224' => 'http://www.w3.org/2009/xmlenc11#mgf1sha224',
413             'mgf1sha256' => 'http://www.w3.org/2009/xmlenc11#mgf1sha256',
414             'mgf1sha384' => 'http://www.w3.org/2009/xmlenc11#mgf1sha384',
415             'mgf1sha512' => 'http://www.w3.org/2009/xmlenc11#mgf1sha512',
416             };
417              
418 65   66     241 return $setOAEPAlgorithm->{$method} // $setOAEPAlgorithm->{'rsa-oaep-mgf1p'};
419             }
420              
421             sub _getOAEPAlgorithm {
422 70     70   100 my $self = shift;
423 70         99 my $method = shift;
424              
425 70         100 state $OAEPAlgorithm = {
426             'http://www.w3.org/2009/xmlenc11#mgf1sha1' => 'SHA1',
427             'http://www.w3.org/2009/xmlenc11#mgf1sha224' => 'SHA224',
428             'http://www.w3.org/2009/xmlenc11#mgf1sha256' => 'SHA256',
429             'http://www.w3.org/2009/xmlenc11#mgf1sha384' => 'SHA384',
430             'http://www.w3.org/2009/xmlenc11#mgf1sha512' => 'SHA512',
431             };
432              
433 70   50     1026424 return $OAEPAlgorithm->{$method} // 'SHA1';
434             }
435              
436             sub _setKeyEncryptionMethod {
437 65     65   101 my $self = shift;
438 65         96 my $method = shift;
439              
440 65         118 state $enc_methods = {
441             'rsa-1_5' => 'http://www.w3.org/2001/04/xmlenc#rsa-1_5',
442             'rsa-oaep-mgf1p' => 'http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p',
443             'rsa-oaep' => 'http://www.w3.org/2009/xmlenc11#rsa-oaep',
444             };
445              
446 65   66     238 return $enc_methods->{$method} // $enc_methods->{'rsa-oaep-mgf1p'};
447             }
448              
449             sub _DecryptData {
450 63     63   107 my $self = shift;
451 63         101 my $method = shift;
452 63         87 my $key = shift;
453 63         83 my $encrypteddata = shift;
454              
455 63         187 my $method_vars = _assert_symmetric_algorithm($method);
456              
457 63         116 my $ivsize = $method_vars->{ivsize};
458 63         112 my $tagsize = $method_vars->{tagsize};
459              
460 63         225 my $iv = substr $encrypteddata, 0, $ivsize;
461 63         134 my $encrypted = substr $encrypteddata, $ivsize;
462              
463             # XML Encryption 5.2 Block Encryption Algorithms
464             # The resulting cipher text is prefixed by the IV.
465 63 100       326 if ($method !~ /gcm/ ){
466 42         379 my $cbc = Crypt::Mode::CBC->new($method_vars->{modename}, 0);
467 42         202 return $self->_remove_padding($cbc->decrypt($encrypted, $key, $iv));
468             }
469              
470 21         4017 my $gcm = Crypt::AuthEnc::GCM->new("AES", $key, $iv);
471              
472             # Note that GCM support for additional authentication
473             # data is not used in the XML specification.
474 21         85 my $tag = substr $encrypted, -$tagsize;
475 21         57 $encrypted = substr $encrypted, 0, (length $encrypted) - $tagsize;
476 21         117 my $plaintext = $gcm->decrypt_add($encrypted);
477              
478 21 50       97 die "Tag expected did not match returned Tag"
479             unless $gcm->decrypt_done($tag);
480              
481 21         104 return $plaintext;
482             }
483              
484             sub _EncryptData {
485 51     51   2722 my $self = shift;
486 51         80 my $method = shift;
487 51         129 my $data = shift;
488 51         61 my $key = shift;
489              
490              
491 51         132 my $method_vars = _assert_symmetric_algorithm($method);
492              
493 51         182 my $ivsize = $method_vars->{ivsize};
494 51         85 my $keysize = $method_vars->{keysize};
495              
496 51         181 my $iv = random_bytes($ivsize);
497 51         855 ${$key} = random_bytes($keysize);
  51         403  
498              
499 51 100       270 if ($method =~ /gcm/ ){
500             my $gcm
501 21         45 = Crypt::AuthEnc::GCM->new($method_vars->{modename}, ${$key}, $iv);
  21         4158  
502              
503             # Note that GCM support for additional authentication
504             # data is not used in the XML specification.
505 21         169 my $encrypted = $gcm->encrypt_add($data);
506 21         94 my $tag = $gcm->encrypt_done();
507              
508 21         130 return $iv . $encrypted . $tag;
509             }
510              
511 30         354 my $cbc = Crypt::Mode::CBC->new($method_vars->{modename}, 0);
512             # XML Encryption 5.2 Block Encryption Algorithms
513             # The resulting cipher text is prefixed by the IV.
514 30         135 $data = $self->_add_padding($data, $ivsize);
515 30         71 return $iv . $cbc->encrypt($data, ${$key}, $iv);
  30         116  
516             }
517              
518             sub _decrypt {
519 64     64   105 my $sub = shift;
520 64         99 my $decrypt;
521 64         133 eval { $decrypt = $sub->() };
  64         115  
522 64 100       928 return $decrypt unless $@;
523 1         10 return;
524             }
525              
526             sub _decrypt_key {
527 64     64   131 my $self = shift;
528 64         103 my $key = shift;
529 64         105 my $algo = shift;
530 64         96 my $digest_name = shift;
531 64         92 my $oaep = shift;
532 64         84 my $mgf = shift;
533              
534 64 100       172 if ($algo eq 'http://www.w3.org/2001/04/xmlenc#rsa-1_5') {
535 12     12   60 return _decrypt(sub{$self->{key_obj}->decrypt($key, 'v1.5')});
  12         342668  
536             }
537              
538 52 100       130 if ($algo eq 'http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p') {
539             return _decrypt(
540             sub {
541             $self->{key_obj}->decrypt(
542 17   100 17   485776 $key, 'oaep',
      100        
543             $digest_name // 'SHA1',
544             $oaep // ''
545             );
546             }
547 17         95 );
548             }
549              
550 35 50       82 if ($algo eq 'http://www.w3.org/2009/xmlenc11#rsa-oaep') {
551             return _decrypt(
552             sub {
553             $self->{key_obj}->decrypt(
554 35   50 35   84 $key, 'oaep',
555             $self->_getOAEPAlgorithm($mgf),
556             $oaep // '',
557             );
558             }
559 35         178 );
560             }
561              
562 0         0 die "Unsupported algorithm for key decryption: $algo";
563             }
564              
565             sub _EncryptKey {
566 51     51   135 my $self = shift;
567 51         69 my $keymethod = shift;
568 51         57 my $key = shift;
569              
570 51         86 my $rsa_pub = $self->{cert_obj};
571              
572 51 100       190 if ($keymethod eq 'http://www.w3.org/2001/04/xmlenc#rsa-1_5') {
    100          
    50          
573 7         8 ${$key} = $rsa_pub->encrypt(${$key}, 'v1.5');
  7         27  
  7         4811  
574             }
575             elsif ($keymethod eq 'http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p') {
576 9         19 ${$key} = $rsa_pub->encrypt(${$key}, 'oaep', 'SHA1', $self->{oaep_params});
  9         35  
  9         6354  
577             }
578             elsif ($keymethod eq 'http://www.w3.org/2009/xmlenc11#rsa-oaep') {
579 35         49 ${$key} = $rsa_pub->encrypt(${$key}, 'oaep', $self->_getOAEPAlgorithm($self->{oaep_mgf_alg}), $self->{oaep_params});
  35         108  
  35         88  
580             } else {
581 0         0 die "Unsupported algorithm for key encyption $keymethod}";
582             }
583              
584 51 50       199 print "Encrypted key: ", encode_base64(${$key}) if $DEBUG;
  0         0  
585             }
586              
587             sub _setEncryptedData {
588 51     51   76 my $self = shift;
589 51         66 my $context = shift;
590 51         72 my $xpc = shift;
591 51         62 my $cipherdata = shift;
592              
593 51         166 my $node = $xpc->findnodes('xenc:EncryptedData/xenc:CipherData/xenc:CipherValue', $context);
594              
595 51         3286 $node->[0]->removeChildNodes();
596 51         244 $node->[0]->appendText($cipherdata);
597 51         191 return $context;
598             }
599              
600             sub _setKeyEncryptedData {
601 51     51   75 my $self = shift;
602 51         64 my $context = shift;
603 51         63 my $xpc = shift;
604 51         73 my $cipherdata = shift;
605              
606 51         60 my $node;
607              
608 51 50       159 if ($xpc->findvalue('dsig:KeyInfo/dsig:RetrievalMethod/@Type', $context)
609             eq 'http://www.w3.org/2001/04/xmlenc#EncryptedKey')
610             {
611 0         0 my $id = $xpc->findvalue('dsig:KeyInfo/dsig:RetrievalMethod/@URI', $context);
612 0         0 $id =~ s/#//g;
613              
614 0         0 my $keyinfo = $xpc->find('//*[@Id=\''. $id . '\']', $context);
615 0 0       0 if (! $keyinfo ) {
616 0         0 die "Unable to find EncryptedKey";
617             }
618              
619 0         0 $node = $keyinfo->[0]->findnodes('//xenc:EncryptedKey/xenc:CipherData', $context)->[0];
620             } else {
621 51         3508 $node = $xpc->findnodes('//dsig:KeyInfo/xenc:EncryptedKey/xenc:CipherData/xenc:CipherValue')->[0];
622             }
623 51         2202 $node->removeChildNodes();
624 51         346 $node->appendText($cipherdata);
625             }
626              
627             sub _remove_padding {
628 42     42   2322 my $self = shift;
629 42         71 my $padded = shift;
630              
631 42         85 my $len = length $padded;
632 42         105 my $padlen = ord substr $padded, $len - 1;
633 42         259 return substr $padded, 0, $len - $padlen;
634             }
635              
636             sub _add_padding {
637 30     30   49 my $self = shift;
638 30         46 my $data = shift;
639 30         52 my $blksize = shift;
640              
641 30         94 my $len = length $data;
642 30         81 my $padlen = $blksize - ($len % $blksize);
643 30         101 my @pad;
644 30         51 my $n = 0;
645 30         107 while ($n < $padlen -1 ) {
646 30         186 $pad[$n] = 176 + int(rand(80));
647 30         87 $n++;
648             }
649              
650 30         259 return $data . pack ("C*", @pad, $padlen);
651             }
652              
653             ##
654             ## _trim($string)
655             ##
656             ## Arguments:
657             ## $string: string String to remove whitespace
658             ##
659             ## Returns: string Trimmed String
660             ##
661             ## Trim the whitespace from the begining and end of the string
662             ##
663             sub _trim {
664 52     52   110 my $string = shift;
665 52         218 $string =~ s/^\s+//;
666 52         435 $string =~ s/\s+$//;
667 52         211 return $string;
668             }
669              
670             ##
671             ## _load_key($file)
672             ##
673             ## Arguments: $self->{ key }
674             ##
675             ## Returns: nothing
676             ##
677             ## Load the key and process it acording to its headers
678             ##
679             sub _load_key {
680 65     65   101 my $self = shift;
681 65         173 my $file = $self->{ key };
682              
683 65 50       3532 if ( open my $KEY, '<', $file ) {
684 65         254 my $text = '';
685 65         367 local $/ = undef;
686 65         1744 $text = <$KEY>;
687 65         885 close $KEY;
688 65 50       790 if ( $text =~ m/BEGIN ([DR]SA) PRIVATE KEY/ ) {
    50          
    50          
    0          
689 0         0 my $key_used = $1;
690              
691 0 0       0 if ( $key_used eq 'RSA' ) {
692 0         0 $self->_load_rsa_key( $text );
693             }
694             else {
695 0         0 $self->_load_dsa_key( $text );
696             }
697              
698 0         0 return 1;
699             } elsif ( $text =~ m/BEGIN EC PRIVATE KEY/ ) {
700 0         0 $self->_load_ecdsa_key( $text );
701             } elsif ( $text =~ m/BEGIN PRIVATE KEY/ ) {
702 65         217 $self->_load_rsa_key( $text );
703             } elsif ($text =~ m/BEGIN CERTIFICATE/) {
704 0         0 $self->_load_x509_key( $text );
705             }
706             else {
707 0         0 confess "Could not detect type of key $file.";
708             }
709             }
710             else {
711 0         0 confess "Could not load key $file: $!";
712             }
713              
714 65         300 return;
715             }
716              
717             ##
718             ## _load_rsa_key($key_text)
719             ##
720             ## Arguments:
721             ## $key_text: string RSA Private Key as String
722             ##
723             ## Returns: nothing
724             ##
725             ## Populate:
726             ## self->{KeyInfo}
727             ## self->{key_obj}
728             ## self->{key_type}
729             ##
730             sub _load_rsa_key {
731 65     65   121 my $self = shift;
732 65         152 my ($key_text) = @_;
733              
734 65         113 eval {
735 65         506 require Crypt::PK::RSA;
736             };
737 65 50       189 confess "Crypt::PK::RSA needs to be installed so that we can handle RSA keys." if $@;
738              
739 65         537 my $rsaKey = Crypt::PK::RSA->new(\$key_text );
740              
741 65 50       31810 if ( $rsaKey ) {
742 65         186 $self->{ key_obj } = $rsaKey;
743 65         150 $self->{ key_type } = 'rsa';
744              
745 65 50       200 if (!$self->{ x509 }) {
746 65         32414 my $keyhash = $rsaKey->key2hash();
747              
748 65         733 $self->{KeyInfo} = "
749            
750            
751             $keyhash->{N}
752             $keyhash->{d}
753            
754            
755             ";
756             }
757             }
758             else {
759 0         0 confess "did not get a new Crypt::PK::RSA object";
760             }
761             }
762              
763             ##
764             ## _load_x509_key($key_text)
765             ##
766             ## Arguments:
767             ## $key_text: string RSA Private Key as String
768             ##
769             ## Returns: nothing
770             ##
771             ## Populate:
772             ## self->{key_obj}
773             ## self->{key_type}
774             ##
775             sub _load_x509_key {
776 0     0   0 my $self = shift;
777 0         0 my $key_text = shift;
778              
779 0         0 eval {
780 0         0 require Crypt::OpenSSL::X509;
781             };
782 0 0       0 confess "Crypt::OpenSSL::X509 needs to be installed so that we
783             can handle X509 Certificates." if $@;
784              
785 0         0 my $x509Key = Crypt::OpenSSL::X509->new_private_key( $key_text );
786              
787 0 0       0 if ( $x509Key ) {
788 0         0 $x509Key->use_pkcs1_padding();
789 0         0 $self->{ key_obj } = $x509Key;
790 0         0 $self->{key_type} = 'x509';
791             }
792             else {
793 0         0 confess "did not get a new Crypt::OpenSSL::X509 object";
794             }
795             }
796              
797             ##
798             ## _load_cert_file()
799             ##
800             ## Arguments: none
801             ##
802             ## Returns: nothing
803             ##
804             ## Read the file name from $self->{ cert } and
805             ## Populate:
806             ## self->{key_obj}
807             ## $self->{KeyInfo}
808             ##
809             sub _load_cert_file {
810 52     52   89 my $self = shift;
811              
812 52         72 eval {
813 52         2270 require Crypt::OpenSSL::X509;
814             };
815              
816 52 50       95311 die "Crypt::OpenSSL::X509 needs to be installed so that we can handle X509 certs.\n" if $@;
817              
818 52         110 my $file = $self->{ cert };
819 52 50       1111 if (!-r $file) {
820 0         0 die "Could not find certificate file $file";
821             }
822 52 50       2092 open my $CERT, '<', $file or die "Unable to open $file\n";
823 52         217 my $text = '';
824 52         292 local $/ = undef;
825 52         1195 $text = <$CERT>;
826 52         642 close $CERT;
827              
828 52         458 my $cert = Crypt::PK::RSA->new(\$text);
829 52 50       18384 die "Could not load certificate from $file" unless $cert;
830              
831 52         143 $self->{ cert_obj } = $cert;
832 52         155 my $cert_text = $cert->export_key_pem('public_x509');
833 52         8341 $cert_text =~ s/-----[^-]*-----//gm;
834 52         173 $self->{KeyInfo} = "\n"._trim($cert_text)."\n";
835 52         316 return;
836             }
837              
838             sub _create_encrypted_data_xml {
839 51     51   69 my $self = shift;
840              
841 51         72 local $XML::LibXML::skipXMLDeclaration = $self->{ no_xml_declaration };
842 51         434 my $doc = XML::LibXML::Document->new();
843              
844 51         111 my $xencns = 'http://www.w3.org/2001/04/xmlenc#';
845 51         62 my $dsigns = 'http://www.w3.org/2000/09/xmldsig#';
846 51         65 my $xenc11ns = 'http://www.w3.org/2009/xmlenc11#';
847              
848 51         179 my $encdata = $self->_create_node($doc, $xencns, $doc, 'xenc:EncryptedData',
849             {
850             Type => 'http://www.w3.org/2001/04/xmlenc#Element',
851             }
852             );
853              
854 51         1046 $doc->setDocumentElement ($encdata);
855              
856             my $encmethod = $self->_create_node(
857             $doc,
858             $xencns,
859             $encdata,
860             'xenc:EncryptionMethod',
861             {
862             Algorithm => $self->{data_enc_method},
863             }
864 51         1888 );
865              
866 51         624 my $keyinfo = $self->_create_node(
867             $doc,
868             $dsigns,
869             $encdata,
870             'dsig:KeyInfo',
871             );
872              
873 51         578 my $enckey = $self->_create_node(
874             $doc,
875             $xencns,
876             $keyinfo,
877             'xenc:EncryptedKey',
878             );
879              
880             my $kencmethod = $self->_create_node(
881             $doc,
882             $xencns,
883             $enckey,
884             'xenc:EncryptionMethod',
885             {
886             Algorithm => $self->{key_transport},
887             }
888 51         660 );
889              
890 51 100       644 if ($self->{'oaep_params'} ne '') {
891 1         6 my $oaep_params = $self->_create_node(
892             $doc,
893             $xencns,
894             $kencmethod,
895             'xenc:OAEPparams',
896             );
897             };
898              
899 51 100       150 if ($self->{key_transport} eq 'http://www.w3.org/2009/xmlenc11#rsa-oaep') {
900             my $oaepmethod = $self->_create_node(
901             $doc,
902             $xenc11ns,
903             $kencmethod,
904             'xenc11:MGF',
905             {
906             Algorithm => $self->{oaep_mgf_alg},
907             }
908 35         103 );
909             };
910              
911 51         416 my $keyinfo2 = $self->_create_node(
912             $doc,
913             $dsigns,
914             $enckey,
915             'dsig:KeyInfo',
916             );
917              
918 51         577 my $keyname = $self->_create_node(
919             $doc,
920             $dsigns,
921             $keyinfo2,
922             'dsig:KeyName',
923             );
924              
925 51         571 my $keycipherdata = $self->_create_node(
926             $doc,
927             $xencns,
928             $enckey,
929             'xenc:CipherData',
930             );
931              
932 51         651 my $keyciphervalue = $self->_create_node(
933             $doc,
934             $xencns,
935             $keycipherdata,
936             'xenc:CipherValue',
937             );
938              
939 51         583 my $cipherdata = $self->_create_node(
940             $doc,
941             $xencns,
942             $encdata,
943             'xenc:CipherData',
944             );
945              
946 51         556 my $ciphervalue = $self->_create_node(
947             $doc,
948             $xencns,
949             $cipherdata,
950             'xenc:CipherValue',
951             );
952              
953 51         560 return $doc;
954             }
955              
956             sub _create_node {
957 597     597   1182 my $self = shift;
958 597         685 my $doc = shift;
959 597         699 my $nsuri = shift;
960 597         660 my $parent = shift;
961 597         699 my $name = shift;
962 597         694 my $attributes = shift;
963              
964 597         3211 my $node = $doc->createElementNS ($nsuri, $name);
965 597         1751 for (keys %$attributes) {
966             $node->addChild (
967             $doc->createAttribute (
968             #$node->setAttribute (
969 188         1984 $_ => $attributes->{$_}
970             )
971             );
972             }
973 597         2414 $parent->addChild($node);
974             }
975              
976             1;
977              
978             __END__