File Coverage

blib/lib/Net/DRI/Protocol/EPP/Core/Host.pm
Criterion Covered Total %
statement 18 157 11.4
branch 0 90 0.0
condition 0 15 0.0
subroutine 6 18 33.3
pod 0 12 0.0
total 24 292 8.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EPP Host commands (RFC5732)
2             ##
3             ## Copyright (c) 2005-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::Core::Host;
16              
17 1     1   928 use utf8;
  1         2  
  1         5  
18 1     1   27 use strict;
  1         2  
  1         16  
19 1     1   4 use warnings;
  1         1  
  1         22  
20              
21 1     1   3 use Net::DRI::Util;
  1         2  
  1         16  
22 1     1   4 use Net::DRI::Exception;
  1         1  
  1         14  
23 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         1685  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::EPP::Core::Host - EPP Host commands (RFC5732) for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Enetdri@dotandco.comE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://www.dotandco.com/services/software/Net-DRI/E
46              
47             =head1 AUTHOR
48              
49             Patrick Mevzek, Enetdri@dotandco.comE
50              
51             =head1 COPYRIGHT
52              
53             Copyright (c) 2005-2013 Patrick Mevzek .
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub register_commands
68             {
69 0     0 0   my ($class,$version)=@_;
70 0           my %tmp=( create => [ \&create, \&create_parse ],
71             check => [ \&check, \&check_parse ],
72             info => [ \&info, \&info_parse ],
73             delete => [ \&delete ],
74             update => [ \&update ],
75             review_complete => [ undef, \&pandata_parse ],
76             );
77              
78 0           $tmp{check_multi}=$tmp{check};
79 0           return { 'host' => \%tmp };
80             }
81              
82             sub build_command
83             {
84 0     0 0   my ($msg,$command,$hostname)=@_;
85 0 0         my @n=map { Net::DRI::Util::isa_hosts($_)? $_->get_names() : $_ } ((ref($hostname) eq 'ARRAY')? @$hostname : ($hostname));
  0 0          
86              
87 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'Host name needed') unless @n;
88 0           foreach my $n (@n)
89             {
90 0 0 0       Net::DRI::Exception->die(1,'protocol/EPP',2,'Host name needed') unless (defined($n) && $n && !ref($n));
      0        
91 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid host name: '.$n) unless Net::DRI::Util::is_hostname($n);
92             }
93              
94 0           $msg->command([$command,'host:'.$command,sprintf('xmlns:host="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('host'))]);
95              
96 0           my @d=map { ['host:name',$_] } @n;
  0            
97 0           return @d;
98             }
99              
100             ####################################################################################################
101             ########### Query commands
102              
103             sub check
104             {
105 0     0 0   my ($epp,$ns)=@_;
106 0           my $mes=$epp->message();
107 0           my @d=build_command($mes,'check',$ns);
108 0           $mes->command_body(\@d);
109 0           return;
110             }
111              
112             sub check_parse
113             {
114 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
115 0           my $mes=$po->message();
116 0 0         return unless $mes->is_success();
117              
118 0           my $chkdata=$mes->get_response('host','chkData');
119 0 0         return unless defined $chkdata;
120 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($mes->ns('host'),'cd'))
121             {
122 0           my $host;
123 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
124             {
125 0           my ($n,$c)=@$el;
126 0 0         if ($n eq 'name')
127             {
128 0           $host=lc($c->textContent());
129 0           $rinfo->{host}->{$host}->{action}='check';
130 0           $rinfo->{host}->{$host}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
131             }
132 0 0         if ($n eq 'reason')
133             {
134 0           $rinfo->{host}->{$host}->{exist_reason}=$c->textContent();
135             }
136             }
137             }
138 0           return;
139             }
140              
141             sub info
142             {
143 0     0 0   my ($epp,$ns)=@_;
144 0           my $mes=$epp->message();
145 0           my @d=build_command($mes,'info',$ns);
146 0           $mes->command_body(\@d);
147 0           return;
148             }
149              
150             sub info_parse
151             {
152 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
153 0           my $mes=$po->message();
154 0 0         return unless $mes->is_success();
155              
156 0           my $infdata=$mes->get_response('host','infData');
157 0 0         return unless defined $infdata;
158              
159 0           my (@s,@ip4,@ip6);
160 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
161             {
162 0           my ($name,$c)=@$el;
163 0 0         if ($name eq 'name')
    0          
    0          
    0          
    0          
    0          
164             {
165 0           $oname=lc($c->textContent());
166 0           $oname =~ s/\.$//; # remove trailing .
167 0           $rinfo->{host}->{$oname}->{action}='info';
168 0           $rinfo->{host}->{$oname}->{exist}=1;
169             } elsif ($name=~m/^(clID|crID|upID)$/)
170             {
171 0           $rinfo->{host}->{$oname}->{$1}=$c->textContent();
172             } elsif ($name=~m/^(crDate|upDate|trDate)$/)
173             {
174 0           $rinfo->{host}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
175             } elsif ($name eq 'roid')
176             {
177 0           $rinfo->{host}->{$oname}->{roid}=$c->textContent();
178             } elsif ($name eq 'status')
179             {
180 0           push @s,Net::DRI::Protocol::EPP::Util::parse_node_status($c);
181             } elsif ($name eq 'addr')
182             {
183 0           my $ip=$c->textContent();
184 0           my $ipv=$c->getAttribute('ip');
185 0 0 0       $ipv='v4' unless (defined($ipv) && $ipv);
186 0 0         push @ip4,$ip if ($ipv eq 'v4');
187 0 0         push @ip6,$ip if ($ipv eq 'v6');
188             }
189             }
190              
191 0           $rinfo->{host}->{$oname}->{status}=$po->create_local_object('status')->add(@s);
192 0           $rinfo->{host}->{$oname}->{self}=$po->create_local_object('hosts',$oname,\@ip4,\@ip6,1);
193 0           return;
194             }
195              
196             ############ Transform commands
197              
198             sub create
199             {
200 0     0 0   my ($epp,$ns)=@_;
201 0           my $mes=$epp->message();
202 0           my @d=build_command($mes,'create',$ns);
203 0 0         push @d,add_ip($ns) if Net::DRI::Util::isa_hosts($ns);
204 0           $mes->command_body(\@d);
205 0           return;
206             }
207              
208             sub create_parse
209             {
210 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
211 0           my $mes=$po->message();
212 0 0         return unless $mes->is_success();
213              
214 0           my $credata=$mes->get_response('host','creData');
215 0 0         return unless defined $credata;
216              
217 0           foreach my $el (Net::DRI::Util::xml_list_children($credata))
218             {
219 0           my ($name,$c)=@$el;
220 0 0         if ($name eq 'name')
    0          
221             {
222 0           $oname=lc($c->textContent());
223 0           $rinfo->{host}->{$oname}->{action}='create';
224 0           $rinfo->{host}->{$oname}->{exist}=1;
225             } elsif ($name=~m/^(crDate)$/)
226             {
227 0           $rinfo->{host}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
228             }
229             }
230 0           return;
231             }
232              
233             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
234             {
235 0     0 0   my ($epp,$ns)=@_;
236 0           my $mes=$epp->message();
237 0           my @d=build_command($mes,'delete',$ns);
238 0           $mes->command_body(\@d);
239 0           return;
240             }
241              
242             sub update
243             {
244 0     0 0   my ($epp,$ns,$todo)=@_;
245 0           my $mes=$epp->message();
246              
247 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a non empty Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
248              
249 0           my $nsadd=$todo->add('ip');
250 0           my $nsdel=$todo->del('ip');
251 0           my $sadd=$todo->add('status');
252 0           my $sdel=$todo->del('status');
253 0           my $newname=$todo->set('name');
254              
255 0 0 0       unless (defined($ns) && $ns)
256             {
257 0 0         $ns=$nsadd->get_names(1) if Net::DRI::Util::isa_hosts($nsadd);
258 0 0         $ns=$nsdel->get_names(1) if Net::DRI::Util::isa_hosts($nsdel);
259             }
260              
261 0           my (@add,@rem);
262 0 0         push @add,add_ip($nsadd) if Net::DRI::Util::isa_hosts($nsadd);
263 0 0         push @add,$sadd->build_xml('host:status') if Net::DRI::Util::isa_statuslist($sadd);
264 0 0         push @rem,add_ip($nsdel) if Net::DRI::Util::isa_hosts($nsdel);
265 0 0         push @rem,$sdel->build_xml('host:status') if Net::DRI::Util::isa_statuslist($sdel);
266              
267 0           my @d=build_command($mes,'update',$ns);
268 0 0         push @d,['host:add',@add] if @add;
269 0 0         push @d,['host:rem',@rem] if @rem;
270              
271 0 0 0       if (defined($newname) && length $newname)
272             {
273 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid host name: '.$newname) unless Net::DRI::Util::is_hostname($newname);
274 0           push @d,['host:chg',['host:name',$newname]];
275             }
276 0           $mes->command_body(\@d);
277 0           return;
278             }
279              
280             sub add_ip
281             {
282 0     0 0   my ($ns)=@_;
283 0           my @ip;
284 0           my ($name,$r4,$r6)=$ns->get_details(1);
285 0 0         push @ip,map { ['host:addr',$_,{ip=>'v4'}] } @$r4 if @$r4;
  0            
286 0 0         push @ip,map { ['host:addr',$_,{ip=>'v6'}] } @$r6 if @$r6;
  0            
287 0           return @ip;
288             }
289              
290             ####################################################################################################
291             ## RFC4932 ยง3.3 Offline Review of Requested Actions
292              
293             sub pandata_parse
294             {
295 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
296 0           my $mes=$po->message();
297 0 0         return unless $mes->is_success();
298              
299 0           my $pandata=$mes->get_response('host','panData');
300 0 0         return unless defined $pandata;
301              
302 0           foreach my $el (Net::DRI::Util::xml_list_children($pandata))
303             {
304 0           my ($name,$c)=@$el;
305 0 0         if ($name eq 'name')
    0          
    0          
306             {
307 0           $oname=lc($c->textContent());
308 0           $rinfo->{host}->{$oname}->{action}='review';
309 0           $rinfo->{host}->{$oname}->{result}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('paResult'));
310             } elsif ($name eq 'paTRID')
311             {
312 0           my $ns=$mes->ns('_main');
313 0           my $tmp=Net::DRI::Util::xml_child_content($c,$ns,'clTRID');
314 0 0         $rinfo->{host}->{$oname}->{trid}=$tmp if defined $tmp;
315 0           $rinfo->{host}->{$oname}->{svtrid}=Net::DRI::Util::xml_child_content($c,$ns,'svTRID');
316             } elsif ($name eq 'paDate')
317             {
318 0           $rinfo->{host}->{$oname}->{date}=$po->parse_iso8601($c->textContent());
319             }
320             }
321 0           return;
322             }
323              
324             ####################################################################################################
325             1;