File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/NO/Domain.pm
Criterion Covered Total %
statement 24 194 12.3
branch 0 96 0.0
condition 0 111 0.0
subroutine 8 19 42.1
pod 0 11 0.0
total 32 431 7.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .NO Domain extensions
2             ##
3             ## Copyright (c) 2008-2010,2013-2014 UNINETT Norid AS, Ehttp://www.norid.noE,
4             ## Trond Haugen Einfo@norid.noE
5             ## 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::NO::Domain;
18              
19 1     1   982 use strict;
  1         2  
  1         28  
20 1     1   4 use warnings;
  1         1  
  1         23  
21              
22 1     1   5 use Net::DRI::DRD::NO;
  1         1  
  1         21  
23 1     1   8 use Net::DRI::Protocol::EPP::Core::Domain;
  1         1  
  1         27  
24 1     1   6 use Net::DRI::Util;
  1         2  
  1         14  
25 1     1   5 use Net::DRI::Exception;
  1         1  
  1         18  
26 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         19  
27 1     1   4 use Net::DRI::Protocol::EPP::Extensions::NO::Host;
  1         1  
  1         1759  
28              
29             =pod
30              
31             =head1 NAME
32              
33             Net::DRI::Protocol::EPP::Extensions::NO::Domain - .NO EPP Domain extension commands for Net::DRI
34              
35             =head1 DESCRIPTION
36              
37             Please see the README file for details.
38              
39             =head1 SUPPORT
40              
41             For now, support questions should be sent to:
42              
43             Enetdri@dotandco.comE
44              
45             Please also see the SUPPORT file in the distribution.
46              
47             =head1 SEE ALSO
48              
49             Ehttp://www.dotandco.com/services/software/Net-DRI/E
50              
51             =head1 AUTHOR
52              
53             Trond Haugen, Einfo@norid.noE
54              
55             =head1 COPYRIGHT
56              
57             Copyright (c) 2008-2010,2013-2014 UNINETT Norid AS, Ehttp://www.norid.noE,
58             Trond Haugen Einfo@norid.noE
59             All rights reserved.
60              
61             This program is free software; you can redistribute it and/or modify
62             it under the terms of the GNU General Public License as published by
63             the Free Software Foundation; either version 2 of the License, or
64             (at your option) any later version.
65              
66             See the LICENSE file that comes with this distribution for more details.
67              
68             =cut
69              
70             ####################################################################################################
71              
72             sub register_commands {
73 0     0 0   my ( $class, $version ) = @_;
74 0           my %tmp = (
75             check => [ \&facet, undef ],
76             info => [ \&facet, \&parse_info ],
77             transfer_cancel => [ \&facet, undef ],
78             transfer_query => [ \&facet, undef ],
79             renew => [ \&facet, undef ],
80              
81             create => [ \&create, undef ],
82             update => [ \&update, undef ],
83             delete => [ \&delete, undef ],
84             transfer_request => [ \&transfer_request, undef ],
85             transfer_execute => [
86             \&transfer_execute,
87             \&Net::DRI::Protocol::EPP::Core::Domain::transfer_parse
88             ],
89             withdraw => [ \&withdraw, undef ],
90             );
91 0           return { 'domain' => \%tmp };
92             }
93              
94             ####################################################################################################
95              
96             sub build_command_extension {
97 0     0 0   my ( $mes, $epp, $tag, $no_version ) = @_;
98              
99 0 0 0       if ($no_version && $no_version eq "1.1") {
100 0           return $mes->command_extension_register(
101             $tag,
102             sprintf(
103             'xmlns:no-ext-domain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_domain_1_1')
104             )
105             );
106             } else {
107              
108 0           return $mes->command_extension_register(
109             $tag,
110             sprintf(
111             'xmlns:no-ext-domain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_domain')
112             )
113             );
114             }
115             }
116              
117             sub facet {
118 0     0 0   my ( $epp, $o, $rd ) = @_;
119              
120 0           return Net::DRI::Protocol::EPP::Extensions::NO::Host::build_facets( $epp, $rd );
121             }
122              
123             sub applicant_dataset {
124 0     0 0   my ( $epp, $command, $rd ) = @_;
125              
126 0           my @e;
127             my $eid;
128              
129 0 0 0       return unless ( ref $rd eq 'HASH' && defined $rd->{applicantdataset} && keys %{$rd->{applicantdataset}} );
  0   0        
130              
131 0 0 0       return unless ($command eq 'create' || $command eq 'update');
132              
133 0           my $r = $rd->{applicantdataset};
134              
135             # Check precense of all mandatory elements.
136             # All fields except registrarref are required to have a value.
137 0           foreach my $el ( qw / versionnumber acceptname acceptdate /) {
138 0 0         unless ( $r->{$el} ) {
139 0           Net::DRI::Exception->die(0,'protocol/EPP',1,"applicantdataset is missing a mandatory element: $el");
140             }
141             }
142              
143 0           my $versionnumber = $r->{versionnumber};
144 0           my $acceptname = $r->{acceptname};
145 0           my $acceptdate = $r->{acceptdate};
146              
147 0           my $mes = $epp->message();
148              
149 0           $eid = build_command_extension( $mes, $epp, 'no-ext-domain:' . $command, '1.1' );
150              
151 0           my @te;
152 0           push @te, [ "no-ext-domain:versionNumber", $versionnumber ];
153 0           push @te, [ "no-ext-domain:acceptName" , $acceptname ];
154 0           push @te, [ "no-ext-domain:acceptDate" , $acceptdate ];
155              
156 0 0         if ($command eq 'create') {
    0          
157 0           push @e, [ 'no-ext-domain:applicantDataset', @te ];
158             } elsif ($command eq 'update') {
159 0           push @e, [ 'no-ext-domain:chg', [ 'no-ext-domain:applicantDataset', @te ] ];
160             }
161 0           return $mes->command_extension( $eid, \@e );
162             }
163              
164             sub parse_info {
165 0     0 0   my ( $po, $otype, $oaction, $oname, $rinfo ) = @_;
166 0           my $mes = $po->message();
167 0 0         return unless $mes->is_success();
168              
169 0           my $NS = $mes->ns('no_domain_1_1');
170              
171 0           my $c = $rinfo->{domain}->{$oname}->{self};
172              
173 0           my $adata = $mes->get_extension('no_domain_1_1','infData');
174              
175 0 0         return unless $adata;
176              
177 0           for my $t ('versionNumber', 'acceptName', 'acceptDate', 'updateClientID', 'updateDate') {
178 0           my $el = $adata->getElementsByTagNameNS( $NS, $t );
179 0 0         my $v = $el ? $el->get_node(1)->getFirstChild()->getData() : undef;
180             # Transform the dates to date objects
181 0 0 0       if (defined $v && $v && ($t eq 'acceptDate' || $t eq 'updateDate')) {
      0        
      0        
182 0           $v = $po->parse_iso8601($v);
183             }
184 0           $rinfo->{domain}->{$oname}->{applicantDataset}->{$t} = $v;
185             }
186 0           return;
187             }
188              
189             sub create {
190 0     0 0   my ( $epp, $domain, $rd ) = @_;
191              
192 0           my $fs = $rd->{facets};
193 0           my $ds = $rd->{applicantdataset};
194              
195 0 0 0       return unless ( defined($fs) && $fs || defined($ds) && $ds );
      0        
      0        
196              
197 0           my $r;
198              
199 0 0 0       if (defined($ds) && $ds) {
200 0           $r = applicant_dataset($epp, 'create', $rd);
201             }
202              
203 0 0         if ($fs) {
204 0           my $rd;
205 0           $rd->{facets} = $fs;
206 0           $r = facet($epp, $domain, $rd);
207             }
208 0           return $r;
209             }
210              
211              
212             sub update {
213 0     0 0   my ( $epp, $domain, $todo ) = @_;
214              
215 0           my $fs = $todo->set('facets');
216 0           my $ds = $todo->set('applicantdataset');
217              
218 0 0 0       return unless ( defined($fs) && $fs || defined($ds) && $ds );
      0        
      0        
219              
220 0           my $r;
221              
222 0 0 0       if (defined($ds) && $ds) {
223 0           my $rd;
224 0           $rd->{applicantdataset} = $ds;
225 0           $r = applicant_dataset($epp, 'update', $rd);
226             }
227              
228 0 0         if ($fs) {
229 0           my $rd;
230 0           $rd->{facets} = $fs;
231 0           $r = facet($epp, $domain, $rd);
232             }
233 0           return $r;
234             }
235              
236              
237             sub delete { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
238 0     0 0   my ( $epp, $domain, $rd ) = @_;
239 0           my $mes = $epp->message();
240              
241 0           my $ddate = $rd->{deleteDate};
242 0           my $dfd = $rd->{deletefromdns};
243 0           my $dfr = $rd->{deletefromregistry};
244 0           my $fs = $rd->{facets};
245              
246 0 0 0       return unless ( ( defined($dfd) || defined($dfr) || defined($fs) ) && ( $dfd || $dfr || $fs ) );
      0        
      0        
247              
248 0 0 0       if (defined($dfd) && ref($dfd)) {
249 0           Net::DRI::Util::check_isa($dfd,'DateTime');
250 0           $dfd = $dfd->set_time_zone('CET')->strftime('%Y-%m-%d');
251             }
252 0 0 0       if (defined($dfr) && ref($dfr)) {
253 0           Net::DRI::Util::check_isa($dfr,'DateTime');
254 0           $dfr = $dfr->set_time_zone('CET')->strftime('%Y-%m-%d');
255             }
256 0 0         if (defined($ddate)) {
257 0 0         if (ref($ddate)) {
258 0           Net::DRI::Util::check_isa($ddate,'DateTime');
259 0           $ddate = $ddate->set_time_zone('CET')->strftime('%Y-%m-%d');
260             }
261 0 0         $dfd = $ddate if !$dfd;
262 0 0         $dfr = $ddate if !$dfr;
263             }
264              
265 0           my $r;
266 0 0 0       if ( $dfd || $dfr ) {
267 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-domain:delete', '1.1' );
268 0           my @e;
269 0 0 0       push @e, [ 'no-ext-domain:deleteFromDNS', $dfd ] if ( defined($dfd) && $dfd );
270 0 0 0       push @e, [ 'no-ext-domain:deleteFromRegistry', $dfr ] if ( defined($dfr) && $dfr );
271              
272 0 0         $r = $mes->command_extension( $eid, \@e ) if (@e);
273             }
274 0 0         if ($fs) {
275 0           $r = facet($epp, $domain, $rd);
276             }
277 0           return $r;
278              
279             }
280              
281              
282             sub transfer_request {
283 0     0 0   my ( $epp, $domain, $rd ) = @_;
284 0           my $mes = $epp->message();
285              
286 0           my $mp = $rd->{mobilephone};
287 0           my $em = $rd->{email};
288 0           my $fs = $rd->{facets};
289              
290 0 0 0       return unless ( ( defined($mp) || defined($em) || defined($fs) ) && ( $mp || $em || $fs) );
      0        
      0        
291              
292 0           my $r;
293 0 0 0       if ($mp || $em) {
294 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-domain:transfer', '1.1' );
295              
296 0           my @d;
297 0 0 0       push @d,
298             Net::DRI::Protocol::EPP::Util::build_tel(
299             'no-ext-domain:mobilePhone', $mp )
300             if ( defined($mp) && $mp );
301 0 0 0       push @d, [ 'no-ext-domain:email', $em ] if ( defined($em) && $em );
302              
303 0           my @e;
304 0           push @e, [ 'no-ext-domain:notify', @d ];
305 0           $r = $mes->command_extension( $eid, \@e );
306              
307             }
308 0 0         if ($fs) {
309 0           $r = facet($epp, $domain, $rd);
310             }
311              
312 0           return $r;
313              
314             }
315              
316              
317             sub withdraw {
318 0     0 0   my ( $epp, $domain, $rd ) = @_;
319 0           my $mes = $epp->message();
320              
321 0           my $transaction;
322 0 0         $transaction = $rd->{transactionname} if $rd->{transactionname};
323              
324 0           my $fs = $rd->{facets};
325              
326 0 0 0       return unless ( $transaction && $transaction eq 'withdraw');
327              
328 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters(
329             'Witdraw command requires a domain name')
330             unless ( defined($domain) && $domain );
331              
332 0           my $r;
333              
334 0           my (undef,$NS,$NSX)=$mes->nsattrs('no_domain_1_1');
335 0           my (undef,$ExtNS,$ExtNSX)=$mes->nsattrs('no_epp');
336              
337 0           my $eid = $mes->command_extension_register( 'command',
338             'xmlns="'
339             . $ExtNS
340             . '" xsi:schemaLocation="'
341             . $ExtNS
342             . " $ExtNSX"
343             . '"' );
344              
345 0           my $cltrid=$mes->cltrid();
346              
347 0           my %domns;
348 0           $domns{'xmlns:domain'} = $NS;
349 0           $domns{'xsi:schemaLocation'} = $NS . " $NSX";
350              
351 0           $r=$mes->command_extension(
352             $eid,
353             [ [ 'withdraw',
354             [ 'domain:withdraw', [ 'domain:name', $domain ],
355             \%domns, \%domns
356             ]
357             ],
358             [ 'clTRID', $cltrid ]
359             ]
360             );
361              
362 0 0 0       if ( defined($fs) && $fs ) {
363 0           $r = facet($epp, $domain, $rd);
364             }
365              
366 0           return $r;
367              
368             }
369              
370             sub transfer_execute {
371 0     0 0   my ( $epp, $domain, $rd ) = @_;
372 0           my $mes = $epp->message();
373              
374 0           my $transaction;
375 0 0         $transaction = $rd->{transactionname} if $rd->{transactionname};
376              
377 0 0 0       return unless ( $transaction && $transaction eq 'transfer_execute' );
378              
379 0           my (undef,$NS,$NSX)=$mes->nsattrs('no_domain_1_1');
380 0           my (undef,$ExtNS,$ExtNSX)=$mes->nsattrs('no_epp');
381              
382 0           my ( $auth, $du, $token, $fs );
383 0 0         $auth = $rd->{auth} if Net::DRI::Util::has_key($rd,'auth');
384 0 0         $du = $rd->{duration} if Net::DRI::Util::has_key($rd,'duration');
385 0 0         $token = $rd->{token} if Net::DRI::Util::has_key($rd,'token');
386 0 0         $fs = $rd->{facets} if Net::DRI::Util::has_key($rd,'facets');
387              
388             # Duration is optional
389 0           my $dur;
390 0 0 0       if ( defined($du)
      0        
391             && $du
392             && Net::DRI::Util::has_duration( $rd )
393             )
394             {
395 0           Net::DRI::Util::check_isa( $du, 'DateTime::Duration' );
396              
397 0 0         Net::DRI::Exception->die( 0, 'DRD::NO', 3, 'Invalid duration' )
398             if Net::DRI::DRD::NO->verify_duration_renew(undef, $du, $domain ); ## TODO: this test should be done in Net::DRI::DRD::NO directly !
399 0           $dur = Net::DRI::Protocol::EPP::Util::build_period($du);
400             }
401              
402 0           my $eid = $mes->command_extension_register( 'command',
403             'xmlns="'
404             . $ExtNS
405             . '" xsi:schemaLocation="'
406             . $ExtNS
407             . " $ExtNSX"
408             . '"' );
409              
410              
411 0           my $cltrid=$mes->cltrid();
412              
413 0           my %domns;
414 0           $domns{'xmlns:domain'} = 'urn:ietf:params:xml:ns:domain-1.0';
415 0           $domns{'xsi:schemaLocation'}
416             = 'urn:ietf:params:xml:ns:domain-1.0 domain-1.0.xsd';
417              
418 0           my %domns2;
419 0           $domns2{'xmlns:no-ext-domain'} = $NS;
420 0           $domns2{'xsi:schemaLocation'} = $NS . " $NSX";
421              
422 0           my $r;
423              
424 0 0 0       if ( Net::DRI::Util::has_auth( $rd )
    0          
425             && ( ref( $rd->{auth} ) eq 'HASH' ) )
426             {
427             $r=$mes->command_extension(
428             $eid,
429             [ [ 'transfer',
430             { 'op' => 'execute' },
431             [ 'domain:transfer',
432             \%domns,
433             [ 'domain:name', $domain ],
434             $dur,
435             Net::DRI::Protocol::EPP::Util::domain_build_authinfo(
436             $epp, $rd->{auth}
437 0           ),
438             ],
439             ],
440             [ 'clTRID', $cltrid ]
441             ]
442             );
443             } elsif ($token) {
444 0           $r=$mes->command_extension(
445             $eid,
446             [ [ 'transfer',
447             { 'op' => 'execute' },
448             [ 'domain:transfer', \%domns,
449             [ 'domain:name', $domain ], $dur,
450             ],
451             ],
452             [ 'extension',
453             [ 'no-ext-domain:transfer', \%domns2,
454             [ 'no-ext-domain:token', $token ]
455             ]
456             ],
457             [ 'clTRID', $cltrid ]
458             ]
459             );
460             } else {
461 0           $r=$mes->command_extension(
462             $eid,
463             [ [ 'transfer',
464             { 'op' => 'execute' },
465             [ 'domain:transfer', \%domns,
466             [ 'domain:name', $domain ], $dur,
467             ],
468             ],
469             [ 'clTRID', $cltrid ]
470             ]
471             );
472             }
473              
474 0 0 0       if ( defined($fs) && $fs ) {
475 0           $r = facet($epp, $domain, $rd);
476             }
477              
478 0           return $r;
479              
480             }
481              
482             ####################################################################################################
483             1;