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