File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/EURid/Domain.pm
Criterion Covered Total %
statement 15 179 8.3
branch 0 114 0.0
condition 0 42 0.0
subroutine 5 18 27.7
pod 0 13 0.0
total 20 366 5.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EURid Domain EPP extension commands
2             ## (based on EURid registration_guidelines_v1_0E-epp.pdf)
3             ##
4             ## Copyright (c) 2005-2013,2015 Patrick Mevzek . All rights reserved.
5             ## 2014 Michael Kefeder . All rights reserved.
6             ##
7             ## This file is part of Net::DRI
8             ##
9             ## Net::DRI is free software; you can redistribute it and/or modify
10             ## it under the terms of the GNU General Public License as published by
11             ## the Free Software Foundation; either version 2 of the License, or
12             ## (at your option) any later version.
13             ##
14             ## See the LICENSE file that comes with this distribution for more details.
15             ####################################################################################################
16              
17             package Net::DRI::Protocol::EPP::Extensions::EURid::Domain;
18              
19 1     1   3 use strict;
  1         2  
  1         27  
20 1     1   4 use warnings;
  1         1  
  1         18  
21              
22 1     1   3 use Net::DRI::Util;
  1         1  
  1         14  
23 1     1   3 use Net::DRI::Exception;
  1         3  
  1         13  
24 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         1775  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::EPP::Extensions::EURid::Domain - EURid EPP Domain extension commands for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2005-2013,2015 Patrick Mevzek .
55             2014 Michael Kefeder .
56             All rights reserved.
57              
58             This program is free software; you can redistribute it and/or modify
59             it under the terms of the GNU General Public License as published by
60             the Free Software Foundation; either version 2 of the License, or
61             (at your option) any later version.
62              
63             See the LICENSE file that comes with this distribution for more details.
64              
65             =cut
66              
67             ####################################################################################################
68              
69             sub register_commands
70             {
71 0     0 0   my ($class,$version)=@_;
72 0           my %tmp=(
73             create => [ \&create, undef ],
74             update => [ \&update, undef ],
75             info => [ \&info, \&info_parse ],
76             delete => [ \&delete, undef ],
77             transfer_request => [ \&transfer_request, undef ],
78             renew => [ undef, \&renew_parse ],
79             );
80              
81 0           return { 'domain' => \%tmp };
82             }
83              
84             sub setup
85             {
86 0     0 0   my ($class,$po,$version)=@_;
87 0           foreach my $ns (qw/domain-ext/)
88             {
89 0           $po->ns({ $ns => [ 'http://www.eurid.eu/xml/epp/'.$ns.'-1.1',$ns.'-1.1.xsd' ] });
90             }
91 0           foreach my $ns (qw/authInfo/)
92             {
93 0           $po->ns({ $ns => [ 'http://www.eurid.eu/xml/epp/'.$ns.'-1.0',$ns.'-1.0.xsd' ] });
94             }
95 0           return;
96             }
97              
98             ####################################################################################################
99              
100             sub build_command_extension
101             {
102 0     0 0   my ($mes,$epp,$tag)=@_;
103 0           return $mes->command_extension_register($tag,sprintf('xmlns:eurid="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('eurid')));
104             }
105              
106             sub create
107             {
108 0     0 0   my ($epp,$domain,$rd)=@_;
109 0           my $mes=$epp->message();
110 0           my $cs=$rd->{contact};
111              
112 0           my @n;
113 0           push @n,map { ['domain-ext:contact',$_->srid(),{'type'=>'onsite'}] } $cs->get('onsite');
  0            
114 0 0         push @n,add_nsgroup($rd->{nsgroup}) if Net::DRI::Util::has_key($rd,'nsgroup');
115 0 0 0       push @n,['domain-ext:keygroup',$rd->{keygroup}] if Net::DRI::Util::has_key($rd,'keygroup') && Net::DRI::Util::xml_is_token($rd->{keygroup},1,100);
116             ## TODO domain-ext-voucher
117              
118 0 0         return unless @n;
119              
120 0           my $eid=$mes->command_extension_register('domain-ext','create');
121 0           $mes->command_extension($eid,\@n);
122 0           return;
123             }
124              
125             sub update
126             {
127 0     0 0   my ($epp,$domain,$todo)=@_;
128 0           my $mes=$epp->message();
129              
130 0 0         if (grep { ! /^(?:add|del)$/ } $todo->types('nsgroup'))
  0            
131             {
132 0           Net::DRI::Exception->die(0,'protocol/EPP',11,'Only nsgroup add/del available for domain');
133             }
134              
135 0           my $nsgadd=$todo->add('nsgroup');
136 0           my $nsgdel=$todo->del('nsgroup');
137 0           my $cadd=$todo->add('contact');
138 0           my $cdel=$todo->del('contact');
139 0 0 0       return unless ($nsgadd || $nsgdel || $cadd || $cdel);
      0        
      0        
140              
141 0           my @n;
142 0 0 0       if ($nsgadd || $cadd)
143             {
144 0           my @todo;
145 0 0         push @todo,add_nsgroup($nsgadd) if $nsgadd;
146 0 0         push @todo,map { ['domain-ext:contact',$_->srid(),{'type'=>'onsite'}] } $cadd->get('onsite') if $cadd;
  0            
147 0 0         push @n,['domain-ext:add',@todo] if @todo;
148             }
149 0 0 0       if ($nsgdel || $cdel)
150             {
151 0           my @todo;
152 0 0         push @todo,add_nsgroup($nsgdel) if $nsgdel;
153 0 0         push @todo,map { ['domain-ext:contact',$_->srid(),{'type'=>'onsite'}] } $cdel->get('onsite') if $cdel;
  0            
154 0 0         push @n,['domain-ext:rem',@todo] if @todo;
155             }
156             ## TODO : handle domain-ext:keygroup
157              
158 0 0         return unless @n;
159              
160 0           my $eid=$mes->command_extension_register('domain-ext','update');
161 0           $mes->command_extension($eid,\@n);
162 0           return;
163             }
164              
165             sub info
166             {
167 0     0 0   my ($epp,$domain,$rd)=@_;
168 0           my $mes=$epp->message();
169              
170 0 0 0       return unless Net::DRI::Util::has_key($rd,'authinfo_request') && $rd->{authinfo_request};
171              
172 0           my $eid=$mes->command_extension_register('authInfo','info');
173 0           $mes->command_extension($eid,['authInfo:request']);
174 0           return;
175             }
176              
177             sub info_parse
178             {
179 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
180 0           my $mes=$po->message();
181              
182 0 0         return unless $mes->is_success();
183              
184 0           my $infdata=$mes->get_extension('domain-ext','infData');
185 0 0         return unless defined $infdata;
186              
187 0           my @nsg;
188 0           my $status=$rinfo->{domain}->{$oname}->{status};
189 0           my $contact=$rinfo->{domain}->{$oname}->{contact};
190 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
191             {
192 0           my ($name,$c)=@$el;
193 0 0         if ($name=~m/^(onHold|quarantined)$/) ## onHold here has nothing to do with EPP client|serverHold, unfortunately
    0          
    0          
    0          
    0          
    0          
194             {
195 0 0         $status->add($name) if Net::DRI::Util::xml_parse_boolean($c->textContent()); ## TODO : correct status name?
196             } elsif ($name=~m/^(availableDate|deletionDate)$/)
197             {
198 0           $rinfo->{domain}->{$oname}->{$name}=$po->parse_iso8601($c->textContent());
199             } elsif ($name eq 'contact')
200             {
201 0           $contact->add($po->create_local_object('contact')->srid($c->textContent()),$c->getAttribute('type'));
202             } elsif ($name eq 'nsgroup')
203             {
204 0           push @nsg,$po->create_local_object('hosts')->name($c->textContent());
205             } elsif ($name eq 'keygroup')
206             {
207 0           $rinfo->{domain}->{$oname}->{keygroup}=$c->textContent();
208             } elsif ($name eq 'pendingTransfer')
209             {
210 0           $status->add('pendingTransfer');
211 0           my %p;
212 0           my $cs=$po->create_local_object('contactset');
213 0           my %ccache;
214 0           foreach my $subel (Net::DRI::Util::xml_list_children($c))
215             {
216 0           my ($subname,$subc)=@$subel;
217 0 0         if ($subname eq 'registrant')
    0          
    0          
218             {
219 0           my $id=$subc->textContent();
220 0 0         $ccache{$id}=$po->create_local_object('contact')->srid($id) unless exists $ccache{$id};
221 0           $cs->set($ccache{$id},'registrant');
222             } elsif ($subname eq 'contact')
223             {
224 0           my $id=$subc->textContent();
225 0 0         $ccache{$id}=$po->create_local_object('contact')->srid($id) unless exists $ccache{$id};
226 0           $cs->add($ccache{$id},$subc->getAttribute('type'));
227             } elsif ($subname eq 'initiationDate')
228             {
229 0           $p{initiationDate}=$po->parse_iso8601($subc->textContent());
230             }
231             }
232 0           $p{contact}=$cs;
233 0           $rinfo->{domain}->{$oname}->{pending_transaction}=\%p;
234             }
235             }
236 0 0         $rinfo->{domain}->{$oname}->{nsgroup}=\@nsg if @nsg;
237 0           return;
238             }
239              
240             sub check_parse
241             {
242 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
243 0           my $mes=$po->message();
244 0 0         return unless $mes->is_success();
245              
246 0           my $chkdata=$mes->get_extension('domain-ext','chkData');
247 0 0         return unless defined $chkdata;
248              
249 0           my $ns=$mes->ns('domain-ext');
250 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($ns,'domain'))
251             {
252 0           my $domain;
253 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
254             {
255 0           my ($n,$c)=@$el;
256 0 0         if ($n eq 'name')
    0          
    0          
257             {
258 0           $domain=lc $c->textContent();
259 0           $rinfo->{domain}->{$domain}->{action}='check';
260             } elsif ($n eq 'availableDate')
261             {
262 0           $rinfo->{domain}->{$domain}->{availableDate}=$po->parse_iso8601($c->textContent());
263             } elsif ($n eq 'status')
264             {
265 0           $rinfo->{domain}->{$domain}->{status}=$po->create_local_object('status')->add(Net::DRI::Protocol::EPP::Util::parse_node_status($c));
266             }
267             }
268             }
269 0           return;
270             }
271              
272             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
273             {
274 0     0 0   my ($epp,$domain,$rd)=@_;
275 0           my $mes=$epp->message();
276              
277 0 0         my $hasdelete=Net::DRI::Util::has_key($rd,'deleteDate') ? 1 : 0;
278 0 0 0       my $hascancel=(Net::DRI::Util::has_key($rd,'cancel') && $rd->{cancel}) ? 1 : 0;
279              
280 0 0 0       return unless $hasdelete || $hascancel;
281 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('For domain_delete, parameters deleteDate & cancel can not be set at the same time') if $hasdelete && $hascancel;
282              
283 0           my $eid=$mes->command_extension_register('domain-ext','delete');
284 0           my @n;
285              
286 0 0         if ($hasdelete)
287             {
288 0           Net::DRI::Util::check_isa($rd->{deleteDate},'DateTime');
289 0           @n=(['domain-ext:schedule',['domain-ext:delDate',$rd->{deleteDate}->set_time_zone('UTC')->strftime('%Y-%m-%dT%T.%NZ')]]);
290             }
291 0 0         if ($hascancel)
292             {
293 0           @n=(['domain-ext:cancel']);
294             }
295              
296 0           $mes->command_extension($eid,\@n);
297 0           return;
298             }
299              
300             sub transfer_request
301             {
302 0     0 0   my ($epp,$domain,$rd)=@_;
303 0           my $mes=$epp->message();
304              
305 0           my $eid=$mes->command_extension_register('domain-ext','transfer');
306 0           my @d;
307              
308 0 0         if (Net::DRI::Util::has_contact($rd))
309             {
310 0           my $cs=$rd->{contact};
311 0           my $creg=$cs->get('registrant');
312 0 0         push @d,['domain-ext:registrant',$creg->srid()] if Net::DRI::Util::isa_contact($creg,'Net::DRI::Data::Contact::EURid');
313 0           my $cbill=$cs->get('billing');
314 0 0         push @d,['domain-ext:contact',$cbill->srid(),{type => 'billing'}] if Net::DRI::Util::isa_contact($cbill,'Net::DRI::Data::Contact::EURid');
315 0 0         push @d,add_contact('tech',$cs,9) if $cs->has_type('tech');
316 0 0         push @d,add_contact('onsite',$cs,5) if $cs->has_type('onsite');
317             }
318              
319 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_ns($epp,$rd->{ns},$domain,'domain-ext') if Net::DRI::Util::has_ns($rd);
320 0 0         push @d,add_nsgroup($rd->{nsgroup}) if Net::DRI::Util::has_key($rd,'nsgroup');
321             ## TODO keygroup
322             ## push @n,['eurid:keygroup',$rd->{keygroup}] if Net::DRI::Util::has_key($rd,'keygroup') && Net::DRI::Util::xml_is_token($rd->{keygroup},1,100);
323              
324 0           $mes->command_extension($eid,['domain-ext:request',@d]);
325              
326 0 0         if ($epp->has_module('Net::DRI::Protocol::EPP::Extensions::SecDNS'))
327             {
328 0           my $ref=$epp->find_action_in_class('Net::DRI::Protocol::EPP::Extensions::SecDNS','domain','create');
329 0 0 0       $ref->($epp,$domain,$rd) if defined $ref && ref $ref;
330             }
331 0           return;
332             }
333              
334             sub add_nsgroup
335             {
336 0     0 0   my ($nsg)=@_;
337 0 0 0       return unless (defined($nsg) && $nsg);
338 0 0 0       my @a=grep { defined($_) && $_ && !ref($_) && Net::DRI::Util::xml_is_normalizedstring($_,1,100) } map { Net::DRI::Util::isa_nsgroup($_)? $_->name() : $_ } (ref($nsg) eq 'ARRAY')? @$nsg : ($nsg);
  0 0 0        
  0 0          
339 0           return map { ['domain-ext:nsgroup',$_] } grep {defined} @a[0..8];
  0            
  0            
340             }
341              
342             sub add_contact
343             {
344 0     0 0   my ($type,$cs,$max)=@_;
345 0           my @r=grep { Net::DRI::Util::isa_contact($_,'Net::DRI::Data::Contact::EURid') } ($cs->get($type));
  0            
346 0           return map { ['domain-ext:contact',$_->srid(),{type=>$type}] } grep { defined } @r[0..($max-1)];
  0            
  0            
347             }
348              
349             sub renew_parse
350             {
351 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
352 0           my $mes=$po->message();
353 0 0         return unless $mes->is_success();
354              
355 0           my $rendata=$mes->get_extension('domain-ext','renData');
356 0 0         return unless defined $rendata;
357              
358 0           foreach my $el (Net::DRI::Util::xml_list_children($rendata))
359             {
360 0           my ($name,$c)=@$el;
361 0 0         if ($name=~m/^(removedDeletionDate)$/)
362             {
363 0           $rinfo->{domain}->{$oname}->{$1}=Net::DRI::Util::xml_parse_boolean($c->textContent());
364             }
365             }
366 0           return;
367             }
368              
369             ####################################################################################################
370             1;