File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/ICANN/MarkSignedMark.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Mark & Signed Mark for EPP
2             ##
3             ## Copyright (c) 2013-2016 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Protocol::EPP::Extensions::ICANN::MarkSignedMark;
16              
17 1     1   960 use strict;
  1         1  
  1         23  
18 1     1   2 use warnings;
  1         1  
  1         60  
19              
20 1     1   5 use Net::DRI::Util;
  1         1  
  1         47  
21 1     1   4 use Net::DRI::Exception;
  1         1  
  1         18  
22 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         16  
23              
24 1     1   180 use XML::LibXML ();
  0            
  0            
25             use Encode;
26              
27             my $NS_XMLDSIG = 'http://www.w3.org/2000/09/xmldsig#';
28              
29             ####################################################################################################
30              
31             sub setup
32             {
33             my ($class,$po,$version)=@_;
34             $po->ns({ 'mark' => [ 'urn:ietf:params:xml:ns:mark-1.0','mark-1.0.xsd' ],
35             'signedMark' => [ 'urn:ietf:params:xml:ns:signedMark-1.0','signedMark-1.0'] });
36             return;
37             }
38              
39             sub implements { return 'https://tools.ietf.org/html/draft-ietf-eppext-tmch-smd-06'; }
40              
41             my %xml2perl = ( trademark => 'trademark',
42             treatyOrStatute => 'treaty_statute',
43             court => 'court',
44             markName => 'mark_name',
45             goodsAndServices=> 'goods_services',
46             apId => 'application_id',
47             apDate => 'application_date',
48             regNum => 'registration_number',
49             regDate => 'registration_date',
50             exDate => 'expiration_date',
51             refNum => 'reference_number',
52             proDate => 'protection_date',
53             execDate => 'execution_date',
54             courtName => 'court_name',
55             );
56              
57             ####################################################################################################
58              
59             sub build_marks
60             {
61             my ($po,$rd)=@_;
62             Net::DRI::Exception::usererr_invalid_parameters('A ref array must be passed for marks, or a standalone ref hash for only one mark') unless defined $rd && (ref $rd eq 'ARRAY' || ref $rd eq 'HASH');
63             my @r;
64             foreach my $m (ref $rd eq 'ARRAY' ? @$rd : $rd)
65             {
66             push @r,['mark:mark',{ 'xmlns:mark' => $po->ns()->{'mark'}->[0]},build_mark($m)];
67             }
68             return @r;
69             }
70              
71             sub build_mark
72             {
73             my ($rd)=@_;
74             my @r;
75              
76             Net::DRI::Exception::usererr_invalid_parameters() unless defined $rd && ref $rd eq 'HASH';
77             my $type=$rd->{type};
78             $type='' unless defined $type;
79              
80             if ($type eq 'trademark' || exists $rd->{jurisdiction})
81             {
82             return _build_trademark($rd);
83             } elsif ($type eq 'treaty_statute' || exists $rd->{protection})
84             {
85             return _build_treaty($rd);
86             } elsif ($type eq 'court' || exists $rd->{court_name})
87             {
88             return _build_court($rd);
89             } else
90             {
91             Net::DRI::Exception::usererr_invalid_parameters(qq{Unrecognized type "$type" of mark, and no "jurisdiction", "protection" or "court_name" element});
92             }
93             return;
94             }
95              
96             sub _build_addr
97             {
98             my ($contact)=@_;
99             my (@r,$v);
100              
101             $v=scalar $contact->street();
102             Net::DRI::Exception::usererr_insufficient_parameters('Contact address must have from 1 to 3 street elements') unless defined $v && ref $v eq 'ARRAY' && @$v >=1 && @$v <= 3;
103             push @r,map { ['mark:street',$_] } @$v;
104              
105             $v=scalar $contact->city();
106             Net::DRI::Exception::usererr_insufficient_parameters('Contact address must have a city') unless defined $v;
107             Net::DRI::Exception::usererr_invalid_parameters('Contact address city must be an XML token string') unless Net::DRI::Util::xml_is_token($v);
108             push @r,['mark:city',$v];
109              
110             $v=scalar $contact->sp();
111             if (defined $v && length $v)
112             {
113             Net::DRI::Exception::usererr_invalid_parameters('Contact address sp must be an XML token string') unless Net::DRI::Util::xml_is_token($v);
114             push @r,['mark:sp',$v];
115             }
116              
117             $v=scalar $contact->pc();
118             if (defined $v && length $v)
119             {
120             Net::DRI::Exception::usererr_invalid_parameters('Contact address pc must be an XML token string with 16 characters or less') unless Net::DRI::Util::xml_is_token($v,0,16);
121             push @r,['mark:pc',$v];
122             }
123              
124             $v=scalar $contact->cc();
125             Net::DRI::Exception::usererr_insufficient_parameters('Contact address must have a cc') unless defined $v;
126             Net::DRI::Exception::usererr_invalid_parameters('Contact address cc must be an XML token string of 2 characters') unless Net::DRI::Util::xml_is_token($v,2,2);
127             push @r,['mark:cc',$v];
128              
129             return @r;
130             }
131              
132             sub _build_contact
133             {
134             my ($type,$contact)=@_;
135              
136             Net::DRI::Exception::usererr_invalid_parameters('Element must be contact object, not: '.$contact) unless Net::DRI::Util::isa_contact($contact);
137              
138             my (@r,$v);
139              
140             $v=scalar $contact->name();
141             if (defined $v && length $v)
142             {
143             Net::DRI::Exception::usererr_invalid_parameters('Name of contact must be an XML token string, not: '.$v) unless Net::DRI::Util::xml_is_token($v);
144             push @r,['mark:name',$v];
145             } else
146             {
147             Net::DRI::Exception::usererr_insufficient_parameters('Name is mandatory for a contact') if ($type eq 'contact');
148             }
149              
150             $v=scalar $contact->org();
151             if (defined $v && length $v)
152             {
153             Net::DRI::Exception::usererr_invalid_parameters('Org of contact must be an XML token string, not: '.$v) unless Net::DRI::Util::xml_is_token($v);
154             push @r,['mark:org',$v];
155             }
156              
157             Net::DRI::Exception::usererr_insufficient_parameters('holder must have a name or org') if $type eq 'holder' && ! @r;
158              
159             push @r,['mark:addr',_build_addr($contact)];
160              
161             $v=$contact->voice();
162             if (defined $v && length $v)
163             {
164             Net::DRI::Exception::usererr_invalid_parameters('Voice of contact must be an XML token string verifying pattern "(\+[0-9]{1,3}\.[0-9]{1,14})?"') unless Net::DRI::Util::xml_is_token($v,0,17) && $v=~m/^\+[0-9]{1,3}\.[0-9]{1,14}$/;
165             push @r,Net::DRI::Protocol::EPP::Util::build_tel('mark:voice',$v);
166             } else
167             {
168             Net::DRI::Exception::usererr_insufficient_parameters('Voice is mandatory for a contact') if ($type eq 'contact');
169             }
170              
171             $v=$contact->fax();
172             if (defined $v && length $v)
173             {
174             Net::DRI::Exception::usererr_invalid_parameters('Fax of contact must be an XML token string verifying pattern "(\+[0-9]{1,3}\.[0-9]{1,14})?"') unless Net::DRI::Util::xml_is_token($v,0,17) && $v=~m/^\+[0-9]{1,3}\.[0-9]{1,14}$/;
175             push @r,Net::DRI::Protocol::EPP::Util::build_tel('mark:fax',$v);
176             }
177              
178             $v=$contact->email();
179             if (defined $v && length $v)
180             {
181             Net::DRI::Exception::usererr_invalid_parameters('Email of contact must be an XML token string with at least 1 character, not: '.$v) unless Net::DRI::Util::xml_is_token($v,1);
182             push @r,['mark:email',$v];
183             } else
184             {
185             Net::DRI::Exception::usererr_insufficient_parameters('Email is mandatory for a contact') if ($type eq 'contact');
186             }
187              
188             return @r;
189             }
190              
191             sub _add_token
192             {
193             my ($rd,$key,$optional)=@_;
194             my $pkey=exists $xml2perl{$key} ? $xml2perl{$key} : $key;
195             if (Net::DRI::Util::has_key($rd,$pkey))
196             {
197             Net::DRI::Exception::usererr_invalid_parameters(qq{Value for "$pkey" key must be an XML token string}) unless Net::DRI::Util::xml_is_token($rd->{$pkey});
198             return ['mark:'.$key,$rd->{$pkey}];
199             } else
200             {
201             Net::DRI::Exception::usererr_insufficient_parameters(qq{"$pkey" key must exist}) unless (defined $optional && $optional);
202             return;
203             }
204             }
205              
206             sub _add_datetime
207             {
208             my ($rd,$key,$optional)=@_;
209             my $pkey=exists $xml2perl{$key} ? $xml2perl{$key} : $key;
210             if (Net::DRI::Util::has_key($rd,$pkey))
211             {
212             Net::DRI::Exception::usererr_invalid_parameters(qq{Value for "$pkey" key must be a DateTime object}) unless Net::DRI::Util::is_class($rd->{$pkey},'DateTime');
213             return ['mark:'.$key,Net::DRI::Util::dto2zstring($rd->{$pkey})];
214             } else
215             {
216             Net::DRI::Exception::usererr_insufficient_parameters(qq{"$pkey" key must exist}) unless (defined $optional && $optional);
217             return;
218             }
219             }
220              
221             sub _build_common1
222             {
223             my ($rd)=@_;
224             my @r;
225              
226             push @r,_add_token($rd,'id');
227             Net::DRI::Exception::usererr_invalid_parameters('Value for "id" key must match pattern "\d+-\d+"') unless $rd->{id}=~m/^\d+-\d+$/;
228              
229             push @r,_add_token($rd,'markName');
230              
231             Net::DRI::Exception::usererr_insufficient_parameters('"contact" key must exist') unless Net::DRI::Util::has_key($rd,'contact');
232             Net::DRI::Exception::usererr_invalid_parameters('Value for "contact" key must be a ContactSet object') unless Net::DRI::Util::isa_contactset($rd->{contact});
233             Net::DRI::Exception::usererr_insufficient_parameters('Value for "contact" key must have at least one contact of type holder_owner, holder_assignee or holder_licensee') unless grep { /^(?:holder_owner|holder_assignee|holder_licensee)$/ } $rd->{contact}->types();
234             foreach my $type (qw/owner assignee licensee/)
235             {
236             my @o=$rd->{contact}->get('holder_'.$type);
237             next unless @o;
238             foreach my $c (@o)
239             {
240             push @r,['mark:holder',{ entitlement => $type },_build_contact('holder',$c)];
241             }
242             }
243             foreach my $type (qw/owner agent thirdparty/)
244             {
245             my @o=$rd->{contact}->get('contact_'.$type);
246             next unless @o;
247             foreach my $c (@o)
248             {
249             push @r,['mark:contact',{ type => $type },_build_contact('contact',$c)];
250             }
251             }
252              
253             return @r;
254             }
255              
256             sub _build_common2
257             {
258             my ($rd)=@_;
259             my @r;
260              
261             if (Net::DRI::Util::has_key($rd,'label'))
262             {
263             foreach my $label (ref $rd->{label} eq 'ARRAY' ? @{$rd->{label}} : ($rd->{label}))
264             {
265             Net::DRI::Exception::usererr_invalid_parameters(qq{Label "$label" must be an XML token string from 1 to 63 characters}) unless Net::DRI::Util::xml_is_token($label,1,63);
266             Net::DRI::Exception::usererr_invalid_parameters(qq{Label "$label" must pass regex "[a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?"}) unless $label=~m/^[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?$/;
267             push @r,['mark:label',$label];
268             }
269             }
270              
271             push @r,_add_token($rd,'goodsAndServices');
272              
273             return @r;
274             }
275              
276             sub _build_common3
277             {
278             my ($rd)=@_;
279             my @r;
280              
281             push @r,_add_token($rd,'refNum');
282             push @r,_add_datetime($rd,'proDate');
283              
284             return @r;
285             }
286              
287             sub _build_trademark
288             {
289             my ($rd)=@_;
290             my @r;
291              
292             push @r,_build_common1($rd); ## id/markName/holder/contact
293              
294             push @r,_add_token($rd,'jurisdiction');
295             Net::DRI::Exception::usererr_invalid_parameters(qq{Value for "jurisdiction" key must be an XML token string of 2 characters}) unless Net::DRI::Util::xml_is_token($rd->{jurisdiction},2,2);
296              
297             if (Net::DRI::Util::has_key($rd,'class'))
298             {
299             foreach my $class (ref $rd->{class} eq 'ARRAY' ? @{$rd->{class}} : ($rd->{class}))
300             {
301             Net::DRI::Exception::usererr_invalid_parameters('Class must be an integer, not: '.$class) unless $class=~m/^\d+$/;
302             push @r,['mark:class',$class];
303             }
304             }
305              
306             push @r,_build_common2($rd); ## label/goodsAndServices
307              
308             push @r,_add_token($rd,'apId',1);
309             push @r,_add_datetime($rd,'apDate',1);
310             push @r,_add_token($rd,'regNum');
311             push @r,_add_datetime($rd,'regDate');
312             push @r,_add_datetime($rd,'exDate',1);
313              
314             return ['mark:trademark',@r];
315             }
316              
317             sub _build_treaty
318             {
319             my ($rd)=@_;
320             my @r;
321              
322             push @r,_build_common1($rd); ## id/markName/holder/contact
323              
324             Net::DRI::Exception::usererr_insufficient_parameters('Key "protection" must exist') unless Net::DRI::Util::has_key($rd,'protection');
325             foreach my $rprot (ref $rd->{protection} eq 'ARRAY' ? @{$rd->{protection}} : ($rd->{protection}))
326             {
327             my @pro;
328             Net::DRI::Exception::usererr_invalid_parameters('Each protection item must be a ref hash, not: '.$rprot) unless ref $rprot eq 'HASH';
329              
330             push @r,_add_token($rprot,'cc');
331             Net::DRI::Exception::usererr_invalid_parameters(qq{Value for "cc" key must be an XML token string of 2 characters}) unless Net::DRI::Util::xml_is_token($rprot->{cc},2,2);
332              
333             push @r,_add_token($rprot,'region',1);
334              
335             if (Net::DRI::Util::has_key($rprot,'ruling'))
336             {
337             foreach my $ruling (ref $rprot->{ruling} eq 'ARRAY' ? @{$rprot->{ruling}} : ($rprot->{ruling}))
338             {
339             push @r,_add_token({ ruling => $ruling },'ruling');
340             Net::DRI::Exception::usererr_invalid_parameters(qq{Each "ruling" item must be an XML token string of 2 characters}) unless Net::DRI::Util::xml_is_token($ruling,2,2);
341             }
342             }
343              
344             push @r,['mark:protection',@pro];
345             }
346              
347             push @r,_build_common2($rd); ## label/goodsAndServices
348             push @r,_build_common3($rd); ## refNum/proDate
349              
350             push @r,_add_token($rd,'title');
351             push @r,_add_datetime($rd,'execDate');
352              
353             return ['mark:treatyOrStatute',@r];
354             }
355              
356             sub _build_court
357             {
358             my ($rd)=@_;
359             my @r;
360              
361             push @r,_build_common1($rd); ## id/markName/holder/contact
362             push @r,_build_common2($rd); ## label/goodsAndServices
363             push @r,_build_common3($rd); ## refNum/proDate
364              
365             push @r,_add_token($rd,'cc');
366             Net::DRI::Exception::usererr_invalid_parameters(qq{Value for "cc" key must be an XML token string of 2 characters}) unless Net::DRI::Util::xml_is_token($rd->{cc},2,2);
367              
368             if (Net::DRI::Util::has_key($rd,'region'))
369             {
370             foreach my $region (ref $rd->{region} eq 'ARRAY' ? @{$rd->{region}} : ($rd->{region}))
371             {
372             push @r,_add_token({ region => $region },'region');
373             }
374             }
375              
376             push @r,_add_token($rd,'courtName');
377              
378             return ['mark:court',@r];
379             }
380              
381             ####################################################################################################
382              
383             sub parse_tel
384             {
385             my ($node)=@_;
386             my $r=$node->textContent();
387             $r.='x'.$node->getAttribute('x') if $node->hasAttribute('x');
388             return $r;
389             }
390              
391             sub parse_contact
392             {
393             my ($po,$start)=@_;
394             my $contact=$po->create_local_object('contact');
395              
396             foreach my $el (Net::DRI::Util::xml_list_children($start))
397             {
398             my ($name,$node)=@$el;
399             if ($name=~m/^(?:name|org|email)$/)
400             {
401             $contact->$name($node->textContent());
402             } elsif ($name=~m/^(?:voice|fax)$/)
403             {
404             $contact->$name(parse_tel($node));
405             } elsif ($name eq 'addr')
406             {
407             my @street;
408             foreach my $subel (Net::DRI::Util::xml_list_children($node))
409             {
410             my ($addrname,$addrnode)=@$subel;
411             if ($addrname eq 'street')
412             {
413             push @street,$addrnode->textContent();
414             } elsif ($addrname=~m/^(?:city|sp|pc|cc)$/)
415             {
416             $contact->$addrname($addrnode->textContent());
417             }
418             }
419             $contact->street(\@street);
420             } elsif ($name=~m/^(?:voice|fax)$/)
421             {
422             $contact->$name(Net::DRI::Protocol::EPP::Util::parse_tel($node));
423             }
424             }
425              
426             return $contact;
427             }
428              
429             sub parse_mark
430             {
431             my ($po,$start)=@_;
432             my @marks;
433              
434             foreach my $el (Net::DRI::Util::xml_list_children($start))
435             {
436             my ($name,$node)=@$el;
437             if ($name=~m/^(?:trademark|treatyOrStatute|court)$/)
438             {
439             my %m=(type => $xml2perl{$name});
440             my (@class,@label,@protection,@region);
441             my $cs=$po->create_local_object('contactset');
442             foreach my $subel (Net::DRI::Util::xml_list_children($node))
443             {
444             my ($mname,$mnode)=@$subel;
445             if ($mname=~m/^(id|markName|jurisdiction|goodsAndServices|apId|regNum|refNum|title|cc|courtName)$/)
446             {
447             $m{exists $xml2perl{$mname} ? $xml2perl{$mname} : $mname}=$mnode->textContent();
448             } elsif ($mname eq 'holder')
449             {
450             my $type='holder_'.$mnode->getAttribute('entitlement'); ## owner, assignee, licensee
451             $cs->add(parse_contact($po,$mnode),$type);
452             } elsif ($mname eq 'contact')
453             {
454             my $type='contact_'.$mnode->getAttribute('type'); ## owner, agent, thirdparty
455             $cs->add(parse_contact($po,$mnode),$type);
456             } elsif ($mname eq 'class')
457             {
458             push @class,$mnode->textContent();
459             } elsif ($mname eq 'label')
460             {
461             push @label,$mnode->textContent();
462             } elsif ($mname=~m/^(?:apDate|regDate|exDate|proDate|execDate)$/)
463             {
464             $m{$xml2perl{$mname}}=$po->parse_iso8601($mnode->textContent());
465             } elsif ($mname eq 'protection')
466             {
467             my %p;
468             foreach my $pel (Net::DRI::Util::xml_list_children($mnode))
469             {
470             my ($pname,$pnode)=@$pel;
471             if ($pname=~m/^(cc|region)$/)
472             {
473             $p{$pname}=$pnode->textContent();
474             } elsif ($pname eq 'ruling')
475             {
476             push @{$p{ruling}},$pnode->textContent();
477             }
478             }
479             push @protection,\%p;
480             } elsif ($mname eq 'region')
481             {
482             push @region,$mnode->textContent();
483             }
484             }
485             $m{contact}=$cs;
486             $m{class}=\@class if @class;
487             $m{label}=\@label if @label;
488             $m{protection}=\@protection if @protection;
489             $m{region}=\@region if @region;
490             if (exists $m{goods_services})
491             {
492             $m{goods_services}=~s/\n +/ /g;
493             $m{goods_services}=~s/ +$//s;
494             }
495             push @marks,\%m;
496             }
497             }
498              
499             return \@marks;
500             }
501              
502             sub lined_content
503             {
504             my ($node,$signs,@keys)=@_;
505             my $r=Net::DRI::Util::xml_traverse($node,$signs,@keys);
506             return unless defined $r;
507             $r=$r->textContent();
508             $r=~s/\s+//g;
509             return $r;
510             }
511              
512             sub parse_signed_mark
513             {
514             my ($po,$start,$xmlsec)=@_;
515             my %smark;
516              
517             foreach my $el (Net::DRI::Util::xml_list_children($start))
518             {
519             my ($name,$node)=@$el;
520             if ($name eq 'id')
521             {
522             $smark{id}=$node->textContent();
523             } elsif ($name eq 'issuerInfo')
524             {
525             my %issuer=(id => $node->getAttribute('issuerID'));
526             foreach my $iel (Net::DRI::Util::xml_list_children($node))
527             {
528             my ($iname,$inode)=@$iel;
529             if ($iname=~m/^(?:org|email|url)$/)
530             {
531             $issuer{$iname}=$inode->textContent();
532             } elsif ($iname eq 'voice')
533             {
534             $issuer{$iname}=parse_tel($inode);
535             }
536             }
537             $smark{issuer}=\%issuer;
538             } elsif ($name eq 'notBefore')
539             {
540             $smark{'creation_date'}=$po->parse_iso8601($node->textContent());
541             } elsif ($name eq 'notAfter')
542             {
543             $smark{'expiration_date'}=$po->parse_iso8601($node->textContent());
544             } elsif ($name eq 'mark')
545             {
546             $smark{mark}=parse_mark($po,$node);
547             } elsif ($name eq 'Signature')
548             {
549             my %s=(id => $start->getAttribute('id'));
550             $s{'value'}=lined_content($node,$NS_XMLDSIG,qw/SignatureValue/);
551             ## TODO: handle other algorithms
552             $s{'key'}={ algorithm => 'rsa',
553             x509_certificate => lined_content($node,$NS_XMLDSIG,qw/KeyInfo X509Data X509Certificate/),
554             };
555             $s{'validated'}=(defined $xmlsec && $xmlsec) ? _validate_xmldsig($start) : undef;
556             $smark{'signature'}=\%s;
557             }
558             }
559             return \%smark;
560             }
561              
562             sub _validate_xmldsig
563             {
564             my ($xml,$rs)=@_;
565              
566             require XML::LibXML::XPathContext;
567             require Digest::SHA;
568             require Crypt::OpenSSL::X509;
569             require Crypt::OpenSSL::RSA;
570             require MIME::Base64;
571              
572             my $xpc=XML::LibXML::XPathContext->new();
573             $xpc->registerNs('ds', $NS_XMLDSIG);
574              
575             foreach my $node ($xpc->findnodes('//ds:Reference',$xml))
576             {
577             my $for=$node->getAttribute('URI');
578             $for=~s/^#//;
579             my $cnode=$xpc->findnodes("//*[\@id='${for}' or \@Id='${for}']",$xml);
580             return 0 unless $cnode->size() == 1;
581              
582             $cnode=$cnode->get_node(1); ## node on which we perform the digest operation
583              
584             my %algos=map { $_->getAttribute('Algorithm') => 1 } $xpc->findnodes('ds:Transforms/ds:Transform',$node);
585             return 0 unless exists $algos{'http://www.w3.org/2001/10/xml-exc-c14n#'};
586              
587             my $xmlstring=$cnode->toStringEC14N(0,exists $algos{$NS_XMLDSIG.'enveloped-signature'} ? q{(. | .//node() | .//@* | .//namespace::*)[not(self::comment() or ancestor-or-self::ds:Signature)]} : undef,$xpc);
588              
589             return 0 unless defined $xmlstring && $xpc->findnodes('ds:DigestValue',$node)->get_node(1)->textContent() eq _sha256b64padded($xmlstring);
590             }
591              
592             my $cert=$xpc->findnodes('//ds:X509Certificate',$xml)->get_node(1)->textContent();
593             $cert=~s/ /\n/g;
594             my $certobj=Crypt::OpenSSL::X509->new_from_string("-----BEGIN CERTIFICATE-----\n".$cert."\n-----END CERTIFICATE-----", Crypt::OpenSSL::X509::FORMAT_PEM());
595             my $key=Crypt::OpenSSL::RSA->new_public_key($certobj->pubkey());
596             $key->use_sha256_hash();
597              
598             my $xmlsi=$xpc->find('//ds:SignedInfo',$xml)->get_node(1);
599             $xmlsi->setNamespace($NS_XMLDSIG,'ds',0);
600             my $sigval=$xpc->findnodes('//ds:SignatureValue',$xmlsi)->get_node(1)->textContent();
601             $sigval=~s!\s+!!g;
602             my $verify=$key->verify($xmlsi->toStringEC14N(0), MIME::Base64::decode_base64($sigval));
603             return (defined $verify && $verify) ? 1 : 0;
604             }
605              
606             sub _sha256b64padded
607             {
608             my ($in)=@_;
609             my $out = Digest::SHA::sha256_base64($in);
610             while (length($out) % 4) { $out .= '='; }
611             return $out;
612             }
613              
614             sub parse_encoded_signed_mark
615             {
616             my ($po,$start,$xmlsec)=@_;
617             my $content;
618              
619             if (ref $start)
620             {
621             my $encoding=$start->hasAttribute('encoding') ? $start->getAttribute('encoding') : 'base64';
622             Net::DRI::Exception::err_invalid_parameter('For encoded signed mark, only base64 encoding is supported') unless $encoding eq 'base64';
623             $content=$start->textContent();
624             } else
625             {
626             my @a=grep { /-----BEGIN ENCODED SMD-----/ .. /-----END ENCODED SMD-----/ } split(/\n/,$start);
627             $content=join("\n",@a[1..($#a-1)]);
628             }
629              
630             require MIME::Base64;
631             my $xml=MIME::Base64::decode_base64($content);
632             $xml=Encode::decode('UTF-8',$xml,Encode::FB_CROAK | Encode::LEAVE_SRC);
633             my $root=XML::LibXML->load_xml(no_cdata => 1, no_blanks => 1, no_network => 1, string => $xml)->documentElement();
634             Net::DRI::Exception::err_invalid_parameter('Decoding should give a signedMark root element') unless $root->localname() eq 'signedMark';
635              
636             return parse_signed_mark($po,$root,$xmlsec);
637             }
638              
639             ####################################################################################################
640             1;
641              
642             __END__