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