File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/SecDNS.pm
Criterion Covered Total %
statement 12 176 6.8
branch 0 128 0.0
condition 0 45 0.0
subroutine 4 17 23.5
pod 0 13 0.0
total 16 379 4.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EPP DNS Security Extensions (RFC4310 & RFC5910)
2             ##
3             ## Copyright (c) 2005-2010,2012-2013 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::SecDNS;
16              
17 1     1   837 use strict;
  1         2  
  1         30  
18 1     1   5 use warnings;
  1         2  
  1         21  
19              
20 1     1   8 use Net::DRI::Util;
  1         2  
  1         13  
21 1     1   4 use Net::DRI::Exception;
  1         1  
  1         1800  
22              
23             =pod
24              
25             =head1 NAME
26              
27             Net::DRI::Protocol::EPP::Extensions::SecDNS - EPP DNS Security Extensions (version 1.0 in RFC4310 & version 1.1 in RFC5910) for Net::DRI
28              
29             =head1 DESCRIPTION
30              
31             Please see the README file for details.
32              
33             =head1 SUPPORT
34              
35             For now, support questions should be sent to:
36              
37             Enetdri@dotandco.comE
38              
39             Please also see the SUPPORT file in the distribution.
40              
41             =head1 SEE ALSO
42              
43             Ehttp://www.dotandco.com/services/software/Net-DRI/E
44              
45             =head1 AUTHOR
46              
47             Patrick Mevzek, Enetdri@dotandco.comE
48              
49             =head1 COPYRIGHT
50              
51             Copyright (c) 2005-2010,2012-2013 Patrick Mevzek .
52             All rights reserved.
53              
54             This program is free software; you can redistribute it and/or modify
55             it under the terms of the GNU General Public License as published by
56             the Free Software Foundation; either version 2 of the License, or
57             (at your option) any later version.
58              
59             See the LICENSE file that comes with this distribution for more details.
60              
61             =cut
62              
63             ####################################################################################################
64              
65             sub register_commands
66             {
67 0     0 0   my ($class,$version)=@_;
68 0           my %s=(
69             'connect' => [ undef, \&parse_greeting ],
70             noop => [ undef, \&parse_greeting ],
71             );
72 0           my %d=(
73             info => [ undef, \&info_parse ],
74             create => [ \&create, undef ],
75             update => [ \&update, undef ],
76             );
77              
78 0           return { 'domain' => \%d, 'session' => \%s };
79             }
80              
81 0     0 0   sub capabilities_add { return (['domain_update','secdns',['add','del','set']],['domain_update','secdns_urgent',['set']]); }
82              
83             sub setup
84             {
85 0     0 0   my ($class,$po,$version)=@_;
86 0           $po->ns({ 'secDNS' => [ 'urn:ietf:params:xml:ns:secDNS-1.0','secDNS-1.0.xsd' ] }); ## this will get bumped to secDNS-1.1 after login if server supports it, until all registry servers have been upgraded to 1.1
87 0           return;
88             }
89              
90             ####################################################################################################
91              
92             sub format_dsdata
93             {
94 0     0 0   my ($e,$nomsl)=@_;
95              
96 0           my @mk=grep { ! Net::DRI::Util::has_key($e,$_) } qw/keyTag alg digestType digest/;
  0            
97 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Attributes missing: '.join(' ',@mk)) if @mk;
98 0 0         Net::DRI::Exception::usererr_invalid_parameters('keyTag must be 16-bit unsigned integer: '.$e->{keyTag}) unless Net::DRI::Util::verify_ushort($e->{keyTag});
99 0 0         Net::DRI::Exception::usererr_invalid_parameters('alg must be an unsigned byte: '.$e->{alg}) unless Net::DRI::Util::verify_ubyte($e->{alg});
100 0 0         Net::DRI::Exception::usererr_invalid_parameters('digestType must be an unsigned byte: '.$e->{digestType}) unless Net::DRI::Util::verify_ubyte($e->{digestType});
101 0 0         Net::DRI::Exception::usererr_invalid_parameters('digest must be hexadecimal: '.$e->{digest}) unless Net::DRI::Util::verify_hex($e->{digest});
102              
103 0           my @c;
104 0           push @c,['secDNS:keyTag',$e->{keyTag}];
105 0           push @c,['secDNS:alg',$e->{alg}];
106 0           push @c,['secDNS:digestType',$e->{digestType}];
107 0           push @c,['secDNS:digest',$e->{digest}];
108              
109 0 0 0       if (exists $e->{maxSigLife} && ! $nomsl)
110             {
111 0 0         Net::DRI::Exception::usererr_invalid_parameters('maxSigLife must be a positive integer: '.$e->{maxSigLife}) unless Net::DRI::Util::verify_int($e->{maxSigLife},1);
112 0           push @c,['secDNS:maxSigLife',$e->{maxSigLife}];
113             }
114              
115             ## If one key attribute is provided, all of them should be (this is verified in format_keydata)
116 0 0 0       if (exists $e->{key_flags} || exists $e->{key_protocol} || exists $e->{key_alg} || exists $e->{key_pubKey})
      0        
      0        
117             {
118 0           push @c,['secDNS:keyData',format_keydata($e)];
119             }
120              
121 0           return @c;
122             }
123              
124             sub format_keydata
125             {
126 0     0 0   my ($e)=@_;
127              
128 0           my @mk=grep { ! Net::DRI::Util::has_key($e,$_) } qw/key_flags key_protocol key_alg key_pubKey/;
  0            
129 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Attributes missing: '.join(' ',@mk)) if @mk;
130              
131 0 0         Net::DRI::Exception::usererr_invalid_parameters('key_flags mut be a 16-bit unsigned integer: '.$e->{key_flags}) unless Net::DRI::Util::verify_ushort($e->{key_flags});
132 0 0         Net::DRI::Exception::usererr_invalid_parameters('key_protocol must be an unsigned byte: '.$e->{key_protocol}) unless Net::DRI::Util::verify_ubyte($e->{key_protocol});
133 0 0         Net::DRI::Exception::usererr_invalid_parameters('key_alg must be an unsigned byte: '.$e->{key_alg}) unless Net::DRI::Util::verify_ubyte($e->{key_alg});
134 0 0         Net::DRI::Exception::usererr_invalid_parameters('key_pubKey must be a non empty base64 string: '.$e->{key_pubKey}) unless Net::DRI::Util::verify_base64($e->{key_pubKey},1);
135              
136 0           return (['secDNS:flags',$e->{key_flags}],['secDNS:protocol',$e->{key_protocol}],['secDNS:alg',$e->{key_alg}],['secDNS:pubKey',$e->{key_pubKey}]);
137             }
138              
139             sub parse_greeting
140             {
141 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
142 0           my $mes=$po->message();
143              
144 0 0         return unless defined $mes->node_greeting(); ## only work here for true greeting reply handling, not for all polling responses !
145              
146 0           my $rs=$po->default_parameters()->{server};
147 0           my @v=grep { m/^urn:ietf:params:xml:ns:secDNS-\S+$/ } @{$rs->{extensions_selected}};
  0            
  0            
148             ##Net::DRI::Exception::err_invalid_parameters('Net::DRI::Protocol::EPP::Extensions::SecDNS was loaded but server does not support the secDNS extension!') unless @v;
149 0 0         return unless @v;
150 0 0         Net::DRI::Exception::err_invalid_parameters('Net::DRI::Protocol::EPP::Extensions::SecDNS supports only versions 1.0 or 1.1, but the server announced: '.join(' ',@v)) if grep { ! /^urn:ietf:params:xml:ns:secDNS-1\.[01]$/ } @v;
  0            
151              
152             ## If server supports secDNS-1.1 we switch to it completely
153 0 0         if (grep { m/1\.1/ } @v)
  0            
154             {
155 0           $po->ns({ 'secDNS' => [ 'urn:ietf:params:xml:ns:secDNS-1.1','secDNS-1.1.xsd' ] });
156 0 0         $rs->{extensions_selected}=[ grep { ! m/^urn:ietf:params:xml:ns:secDNS-1.0$/ } @{$rs->{extensions_selected}} ] if grep { m/1\.0/ } @v;
  0            
  0            
  0            
157             } else
158             {
159 0           $po->ns({ 'secDNS' => [ 'urn:ietf:params:xml:ns:secDNS-1.0','secDNS-1.0.xsd' ] });
160             }
161 0           return;
162             }
163              
164             ####################################################################################################
165             ########### Query commands
166              
167             sub parse_dsdata
168             {
169 0     0 0   my ($node)=@_;
170              
171 0           my %n;
172 0           foreach my $sel (Net::DRI::Util::xml_list_children($node))
173             {
174 0           my ($name,$c)=@$sel;
175 0 0         if ($name=~m/^(keyTag|alg|digestType|digest|maxSigLife)$/)
    0          
176             {
177 0           $n{$1}=$c->textContent();
178             } elsif ($name eq 'keyData')
179             {
180 0           parse_keydata($c,\%n);
181             }
182             }
183 0           return \%n;
184             }
185              
186             sub parse_keydata
187             {
188 0     0 0   my ($node,$rn)=@_;
189              
190 0           foreach my $el (Net::DRI::Util::xml_list_children($node))
191             {
192 0           my ($name,$c)=@$el;
193 0 0         if ($name=~m/^(flags|protocol|alg|pubKey)$/)
194             {
195 0           $rn->{'key_'.$1}=$c->textContent();
196             }
197             }
198 0           return;
199             }
200              
201             sub info_parse
202             {
203 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
204 0           my $mes=$po->message();
205 0 0         return unless $mes->is_success();
206              
207 0           my $infdata=$mes->get_extension($mes->ns('secDNS'),'infData');
208 0 0         return unless defined $infdata;
209              
210 0           my @d;
211 0           my $ns=$mes->ns('secDNS');
212              
213 0 0         if ($ns=~m/1\.0/)
214             {
215 0           @d=map { parse_dsdata($_) } ($infdata->getChildrenByTagNameNS($mes->ns('secDNS'),'dsData'));
  0            
216             } else ## secDNS-1.1
217             {
218 0           my $msl;
219 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
220             {
221 0           my ($name,$c)=@$el;
222 0 0         if ($name eq 'maxSigLife')
    0          
    0          
223             {
224 0           $msl=0+$c->textContent();
225             } elsif ($name eq 'dsData')
226             {
227 0           my $rn=parse_dsdata($c);
228 0 0         $rn->{maxSigLife}=$msl if defined $msl;
229 0           push @d,$rn;
230             } elsif ($name eq 'keyData')
231             {
232 0           my %n;
233 0           parse_keydata($c,\%n);
234 0 0         $n{maxSigLife}=$msl if defined $msl;
235 0           push @d,\%n;
236             }
237             }
238             }
239              
240 0           $rinfo->{domain}->{$oname}->{secdns}=\@d;
241 0           return;
242             }
243              
244             ############ Transform commands
245              
246             sub create
247             {
248 0     0 0   my ($epp,$domain,$rd)=@_;
249 0           my $mes=$epp->message();
250              
251 0 0         return unless Net::DRI::Util::has_key($rd,'secdns');
252 0 0         Net::DRI::Exception::usererr_invalid_parameters('secdns value must be an array reference with key data') unless ref $rd->{secdns} eq 'ARRAY';
253 0 0         return unless @{$rd->{secdns}};
  0            
254              
255 0           my $eid=$mes->command_extension_register('secDNS','create');
256 0           my @n;
257 0 0         if ($mes->ns('secDNS')=~m/1\.0/)
258             {
259 0           @n=map { ['secDNS:dsData',format_dsdata($_,0)] } (@{$rd->{secdns}});
  0            
  0            
260             } else ## secDNS-1.1
261             {
262 0           push @n,add_maxsiglife($rd->{secdns});
263 0           push @n,add_interfaces($rd->{secdns});
264             }
265 0           $mes->command_extension($eid,\@n);
266 0           return;
267             }
268              
269             sub add_maxsiglife
270             {
271 0     0 0   my ($ra)=@_;
272              
273 0           my %msl=map { 0+$_->{maxSigLife} => 1 } grep { exists $_->{maxSigLife} } @$ra;
  0            
  0            
274 0 0         return unless %msl;
275              
276 0 0         Net::DRI::Exception::usererr_invalid_parameters('Multiple distinct maxSigLife provided') if keys(%msl) > 1;
277 0           my $msl=(keys(%msl))[0];
278 0 0         Net::DRI::Exception::usererr_invalid_parameters('maxSigLife must be a positive integer: '.$msl) unless Net::DRI::Util::verify_int($msl,1);
279 0           return ['secDNS:maxSigLife',$msl];
280             }
281              
282             sub add_interfaces
283             {
284 0     0 0   my ($ra)=@_;
285              
286 0 0 0       my $cd=grep { exists $_->{keyTag} || exists $_->{alg} || exists $_->{digestType} || exists $_->{digest} } @$ra;
  0   0        
287 0 0 0       my $ck=grep { (exists $_->{key_flags} || exists $_->{key_protocol} || exists $_->{key_alg} || exists $_->{key_pubKey}) && ! exists $_->{keyTag} && ! exists $_->{alg} && ! exists $_->{digestType} && ! exists $_->{digest} } @$ra;
  0   0        
      0        
      0        
288 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Unknown secDNS data provided') unless $cd || $ck;
289 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('In secDNS-1.1 you can not mix dsData and keyData blocks') if $cd && $ck;
290 0 0         return $cd ? map { ['secDNS:dsData',format_dsdata($_,1)] } @$ra : map { ['secDNS:keyData',format_keydata($_)] } @$ra;
  0            
  0            
291             }
292              
293             sub update
294             {
295 0     0 0   my ($epp,$domain,$todo)=@_;
296 0           my $mes=$epp->message();
297              
298 0           my $toadd=$todo->add('secdns');
299 0           my $todel=$todo->del('secdns');
300 0           my $toset=$todo->set('secdns');
301 0           my $urgent=$todo->set('secdns_urgent');
302              
303 0           my @def=grep { defined } ($toadd,$todel,$toset);
  0            
304 0 0         return unless @def; ## no updates asked
305              
306 0 0         my $ver=(grep { /-1\.1$/ } $mes->ns('secDNS'))? '1.1' : '1.0';
  0            
307 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('In SecDNS-1.0, only add or del or chg is possible, not more than one of them') if ($ver eq '1.0' && @def>1);
308              
309 0 0 0       my $urg=(defined $urgent && $urgent)? 'urgent="1" ' : '';
310 0 0 0       my $eid=$mes->command_extension_register('secDNS','update',defined $urgent && $urgent ? { urgent => 1 } : {});
311              
312 0           my @n;
313              
314 0 0         if ($ver eq '1.0')
315             {
316 0 0         if (defined $todel)
317             {
318 0           my @nn;
319 0 0         foreach my $e (ref $todel eq 'ARRAY' ? @$todel : ($todel))
320             {
321 0 0         $e=$e->{keyTag} if ref $e eq 'HASH';
322 0 0         Net::DRI::Exception::usererr_invalid_parameters('keyTag must be 16-bit unsigned integer: '.$e) unless Net::DRI::Util::verify_ushort($e);
323 0           push @nn,['secDNS:keyTag',$e];
324             }
325 0           push @n,['secDNS:rem',@nn];
326             }
327 0 0         push @n,['secDNS:add',map { ['secDNS:dsData',format_dsdata($_,0)] } (ref $toadd eq 'ARRAY')? @$toadd : ($toadd)] if defined $toadd;
  0 0          
328 0 0         push @n,['secDNS:chg',map { ['secDNS:dsData',format_dsdata($_,0)] } (ref $toset eq 'ARRAY')? @$toset : ($toset)] if defined $toset;
  0 0          
329             } else ## secDNS-1.1
330             {
331 0 0         if (defined $todel)
332             {
333 0 0         if (! ref $todel)
334             {
335 0 0         Net::DRI::Exception::usererr_invalid_parameters('In delete, only string allowed is "all", not: '.$todel) unless $todel eq 'all';
336 0           push @n,['secDNS:rem',['secDNS:all','true']];
337             } else
338             {
339 0 0         push @n,['secDNS:rem',add_interfaces(ref $todel eq 'ARRAY' ? $todel : [ $todel ] )];
340             }
341             }
342 0 0         push @n,['secDNS:add',add_interfaces(ref $toadd eq 'ARRAY' ? $toadd : [ $toadd ] )] if defined $toadd;
    0          
343 0 0         push @n,['secDNS:chg',add_maxsiglife(ref $toset eq 'ARRAY' ? $toset: (ref $toset eq 'HASH' ? [$toset] : [{ maxSigLife=>$toset }]))] if defined $toset;
    0          
    0          
344             }
345              
346 0           $mes->command_extension($eid,\@n);
347 0           return;
348             }
349              
350             ####################################################################################################
351             1;