1## Domain Registry Interface, .UK EPP Host commands 2## 3## Copyright (c) 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::Extensions::Nominet::Host; 19 20use strict; 21use warnings; 22 23use Net::DRI::Util; 24use Net::DRI::Exception; 25 26our $VERSION=do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 27 28=pod 29 30=head1 NAME 31 32Net::DRI::Protocol::EPP::Extensions::Nominet::Host - .UK EPP Host commands for Net::DRI 33 34=head1 DESCRIPTION 35 36Please see the README file for details. 37 38=head1 SUPPORT 39 40For now, support questions should be sent to: 41 42E<lt>netdri@dotandco.comE<gt> 43 44Please also see the SUPPORT file in the distribution. 45 46=head1 SEE ALSO 47 48E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 49 50=head1 AUTHOR 51 52Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 53 54=head1 COPYRIGHT 55 56Copyright (c) 2008,2009 Patrick Mevzek <netdri@dotandco.com>. 57All rights reserved. 58 59This program is free software; you can redistribute it and/or modify 60it under the terms of the GNU General Public License as published by 61the Free Software Foundation; either version 2 of the License, or 62(at your option) any later version. 63 64See the LICENSE file that comes with this distribution for more details. 65 66=cut 67 68#################################################################################################### 69 70sub register_commands 71{ 72 my ($class,$version)=@_; 73 my %tmp=( 74 info => [ \&info, \&info_parse ], 75 update => [ \&update ], 76 ); 77 78 return { 'host' => \%tmp }; 79} 80 81sub build_command 82{ 83 my ($msg,$command,$hostname)=@_; 84 my $roid=(Net::DRI::Util::isa_hosts($hostname))? $hostname->get_details(1)->[-1]->{roid} : $hostname; 85 Net::DRI::Exception->die(1,'protocol/EPP',2,'Roid of NS object needed') unless (defined($roid) && $roid && !ref($roid)); 86 Net::DRI::Exception->die(1,'protocol/EPP',2,'Invalid ROID: '.$roid) unless ($roid=~m/^NS\d+(?:-UK)?$/); 87 88 $msg->command([$command,'ns:'.$command,sprintf('xmlns:ns="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('ns'))]); 89 return (['ns:roid',$roid]); 90} 91 92#################################################################################################### 93########### Query commands 94 95sub info 96{ 97 my ($epp,$ns)=@_; 98 my $mes=$epp->message(); 99 my @d=build_command($mes,'info',$ns); 100 $mes->command_body(\@d); 101} 102 103sub info_parse 104{ 105 my ($po,$otype,$oaction,$oname,$rinfo)=@_; 106 my $mes=$po->message(); 107 return unless $mes->is_success(); 108 my $infdata=$mes->get_response('ns','infData'); 109 return unless defined $infdata; 110 parse_infdata($po,$mes,$infdata,$oname,$rinfo); 111} 112 113sub parse_infdata 114{ 115 my ($po,$mes,$infdata,$oname,$rinfo)=@_; 116 my ($hostname,@ip4,@ip6); 117 my %i; 118 119 foreach my $el (Net::DRI::Util::xml_list_children($infdata)) 120 { 121 my ($name,$c)=@$el; 122 if ($name eq 'roid') 123 { 124 $oname=$c->textContent(); 125 $i{action}='info'; 126 $i{exist}=1; 127 $i{roid}=$oname; 128 } elsif ($name eq 'name') 129 { 130 $hostname=lc($c->textContent()); 131 $i{name}=$hostname; 132 } elsif ($name=~m/^(clID|crID|upID)$/) 133 { 134 $i{$1}=$c->textContent(); 135 } elsif ($name=~m/^(crDate|upDate)$/) 136 { 137 $i{$1}=$po->parse_iso8601($c->textContent()); 138 } elsif ($name eq 'addr') 139 { 140 my $ip=$c->textContent(); 141 my $ipv=$c->getAttribute('ip'); 142 push @ip4,$ip if ($ipv eq 'v4'); 143 push @ip6,$ip if ($ipv eq 'v6'); 144 } 145 } 146 147 while(my ($k,$v)=each(%i)) 148 { 149 $rinfo->{host}->{$hostname}->{$k}=$rinfo->{host}->{$oname}->{$k}=$v; 150 } 151 $rinfo->{host}->{$hostname}->{self}=$rinfo->{host}->{$oname}->{self}=$po->create_local_object('hosts',$hostname,\@ip4,\@ip6,1,{roid=>$oname}); 152 return $rinfo->{host}->{$hostname}->{self}; 153} 154 155############ Transform commands 156 157sub update 158{ 159 my ($epp,$ns,$todo)=@_; 160 my $mes=$epp->message(); 161 162 Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo); 163 if ((grep { ! /^(?:set)$/ } $todo->types('ip')) || 164 (grep { ! /^(?:set)$/ } $todo->types('name')) 165 ) 166 { 167 Net::DRI::Exception->die(0,'protocol/EPP',11,'Only IP/name set available for host'); 168 } 169 170 my $ipset=$todo->set('ip'); 171 my $newname=$todo->set('name'); 172 173 my @d=build_command($mes,'update',$ns); 174 if (defined($newname) && $newname) 175 { 176 Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid host name: '.$newname) unless Net::DRI::Util::is_hostname($newname); 177 push @d,['ns:name',$newname]; 178 } 179 180 if (defined($ipset) && $ipset) 181 { 182 Net::DRI::Exception::usererr_invalid_parameters($ipset.' must be a Net::DRI::Data::Hosts object') unless Net::DRI::Util::isa_hosts($ipset); 183 my ($name,$r4,$r6)=$ipset->get_details(1); 184 push @d,['ns:addr',{ip=>'v4'},$r4->[0]] if @$r4; ## it seems only one IP is allowed 185 push @d,['ns:addr',{ip=>'v6'},$r6->[0]] if @$r6; ## ditto 186 } 187 188 $mes->command_body(\@d); 189} 190 191#################################################################################################### 1921; 193