1## Domain Registry Interface, .UK EPP Domain commands 2## 3## Copyright (c) 2008,2009,2010 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::Domain; 19 20use strict; 21use warnings; 22 23use Net::DRI::Util; 24use Net::DRI::Exception; 25use Net::DRI::Protocol::EPP::Core::Domain; 26use Net::DRI::Protocol::EPP::Extensions::Nominet::Account; 27use Net::DRI::Protocol::EPP::Extensions::Nominet::Host; 28use Net::DRI::Protocol::EPP::Util; 29 30our $VERSION=do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 31 32=pod 33 34=head1 NAME 35 36Net::DRI::Protocol::EPP::Extensions::Nominet::Domain - .UK EPP Domain commands for Net::DRI 37 38=head1 DESCRIPTION 39 40Please see the README file for details. 41 42=head1 SUPPORT 43 44For now, support questions should be sent to: 45 46E<lt>netdri@dotandco.comE<gt> 47 48Please also see the SUPPORT file in the distribution. 49 50=head1 SEE ALSO 51 52E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 53 54=head1 AUTHOR 55 56Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 57 58=head1 COPYRIGHT 59 60Copyright (c) 2008,2009,2010 Patrick Mevzek <netdri@dotandco.com>. 61All rights reserved. 62 63This program is free software; you can redistribute it and/or modify 64it under the terms of the GNU General Public License as published by 65the Free Software Foundation; either version 2 of the License, or 66(at your option) any later version. 67 68See the LICENSE file that comes with this distribution for more details. 69 70=cut 71 72#################################################################################################### 73 74sub register_commands 75{ 76 my ($class,$version)=@_; 77 my %tmp=( 78 check => [ \&Net::DRI::Protocol::EPP::Core::Domain::check, \&Net::DRI::Protocol::EPP::Core::Domain::check_parse ], 79 info => [ \&info, \&info_parse ], 80 delete => [ \&Net::DRI::Protocol::EPP::Core::Domain::delete ], 81 renew => [ \&renew, \&Net::DRI::Protocol::EPP::Core::Domain::renew_parse ], 82 transfer_request => [ \&transfer_request ], 83 transfer_answer => [ \&transfer_answer ], 84 create => [\&create, \&create_parse ], 85 update => [\&update], 86 unrenew => [\&unrenew], 87 ); 88 89 $tmp{check_multi}=$tmp{check}; 90 return { 'domain' => \%tmp }; 91} 92 93#################################################################################################### 94########### Query commands 95 96sub info 97{ 98 my ($epp,$domain,$rd)=@_; 99 my $mes=$epp->message(); 100 my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'info',$domain); 101 $mes->command_body(\@d); 102} 103 104sub info_parse 105{ 106 my ($po,$otype,$oaction,$oname,$rinfo)=@_; 107 my $mes=$po->message(); 108 return unless $mes->is_success(); 109 my $infdata=$mes->get_response('domain','infData'); 110 return unless defined $infdata; 111 112 my $ns=$po->create_local_object('hosts'); 113 my @n; 114 115 foreach my $el (Net::DRI::Util::xml_list_children($infdata)) 116 { 117 my ($name,$c)=@$el; 118 if ($name eq 'name') 119 { 120 $oname=lc($c->textContent()); 121 $rinfo->{domain}->{$oname}->{action}='info'; 122 $rinfo->{domain}->{$oname}->{exist}=1; 123 } elsif ($name=~m/^(reg-status|first-bill|recur-bill|auto-bill|next-bill)$/) 124 { 125 ## See http://www.nominet.org.uk/registrars/systems/data/fields/ 126 $rinfo->{domain}->{$oname}->{$1}=$c->textContent(); 127 } elsif ($name eq 'notes') ## There may be more than one instance of this element. (http://www.nominet.org.uk/registrars/systems/epp/domainnamelistelements/) 128 { 129 push @n,$c->textContent(); 130 } elsif ($name eq 'account') 131 { 132 my $cs=Net::DRI::Protocol::EPP::Extensions::Nominet::Account::parse_infdata($po,$mes,$c->getChildrenByTagNameNS($mes->ns('account'),'infData')->get_node(1),undef,$rinfo); 133 $rinfo->{domain}->{$oname}->{contact}=$cs; 134 } elsif ($name eq 'ns') 135 { 136 $rinfo->{domain}->{$oname}->{ns}=Net::DRI::Protocol::EPP::Util::parse_ns($po,$c); 137 } elsif ($name=~m/^(clID|crID|upID)$/) 138 { 139 $rinfo->{domain}->{$oname}->{$1}=$c->textContent(); 140 } elsif ($name=~m/^(crDate|upDate|exDate)$/) 141 { 142 $rinfo->{domain}->{$oname}->{$1}=$po->parse_iso8601($c->textContent()); 143 } 144 } 145 146 $rinfo->{domain}->{$oname}->{ns}=$ns; 147 $rinfo->{domain}->{$oname}->{notes}=\@n; 148} 149 150############ Transform commands #################################################################### 151 152sub renew 153{ 154 my ($epp,$domain,$rd)=@_; 155 my $mes=$epp->message(); 156 my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'renew',$domain); 157 push @d,Net::DRI::Protocol::EPP::Util::build_period($rd->{duration}) if Net::DRI::Util::has_duration($rd); 158 $mes->command_body(\@d); 159} 160 161sub transfer_request 162{ 163 my ($epp,$domain,$rd)=@_; 164 my $mes=$epp->message(); 165 my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,['transfer',{'op'=>'request'}],$domain); 166 167 Net::DRI::Exception::usererr_insufficient_parameters('Extra parameters must be provided for domain transfer request, at least a registrar_tag') unless Net::DRI::Util::has_key($rd,'registrar_tag'); 168 Net::DRI::Exception::usererr_invalid_parameters('Registrar tag must be an XML token from 2 to 16 characters') unless Net::DRI::Util::xml_is_token($rd->{registrar_tag},2,16); 169 push @d,['domain:registrar-tag',$rd->{registrar_tag}]; 170 171 if (Net::DRI::Util::has_key($rd,'account_id')) 172 { 173 my $id=Net::DRI::Util::isa_contactset($rd->{account_id})? $rd->{account_id}->get('registrant')->srid() : $rd->{account_id}; 174 Net::DRI::Exception::usererr_invalid_parameters('Account id must be an XML token with pattern [0-9]*(-UK)?') unless (Net::DRI::Util::xml_is_token($id) && $id=~m/^\d+(?:-UK)?$/); 175 push @d,['domain:account',['domain:account-id',$id]]; 176 } 177 $mes->command_body(\@d); 178} 179 180sub transfer_answer 181{ 182 my ($epp,$domain,$rd)=@_; 183 my $mes=$epp->message(); 184 $mes->command([['transfer',{'op'=>(Net::DRI::Util::has_key($rd,'approve') && $rd->{approve})? 'approve' : 'reject'}]]); 185 186 Net::DRI::Exception::usererr_insufficient_parameters('Extra parameters must be provided for domain transfer request, at least a case_id') unless Net::DRI::Util::has_key($rd,'case_id'); 187 Net::DRI::Exception::usererr_invalid_parameters('Case id must be an XML token up to 12 characters') unless Net::DRI::Util::xml_is_token($rd->{case_id},undef,12); 188 189 my @ns=@{$mes->ns()->{notifications}}; 190 my @d=['n:rcCase',{ 'xmlns:n' => $ns[0], 'xsi:schemaLocation' => $ns[0].' '.$ns[1]},['n:case-id',$rd->{case_id}]]; 191 $mes->command_body(\@d); 192} 193 194sub build_ns 195{ 196 my ($epp,$ns,$domain)=@_; 197 198 my @d; 199 foreach my $i (1..$ns->count()) 200 { 201 my ($n,$r4,$r6)=$ns->get_details($i); 202 my @h; 203 push @h,['domain:hostName',$n]; 204 if (($n=~m/\S+\.${domain}$/i) || (lc($n) eq lc($domain))) 205 { 206 ## The registry accepts only ONE Ipv4 or IPv6 address :-( ! 207 push @h,['domain:hostAddr',$r4->[0],{ip=>'v4'}] if @$r4; 208 push @h,['domain:hostAddr',$r6->[0],{ip=>'v6'}] if @$r6; 209 } 210 push @d,['domain:host',@h]; 211 } 212 return ['domain:ns',@d]; 213} 214 215sub create 216{ 217 my ($epp,$domain,$rd)=@_; 218 my $mes=$epp->message(); 219 my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'create',$domain); 220 push @d,Net::DRI::Protocol::EPP::Util::build_period($rd->{duration}) if Net::DRI::Util::has_duration($rd); 221 222 ## account=contact 223 Net::DRI::Exception::usererr_insufficient_parameters('account data is mandatory') unless Net::DRI::Util::has_key($rd,'contact'); 224 if (Net::DRI::Util::isa_contactset($rd->{contact})) 225 { 226 push @d,['domain:account',['account:create',{'xmlns:account'=>$mes->ns('account'),'xmlns:contact'=>$mes->ns('contact')},Net::DRI::Protocol::EPP::Extensions::Nominet::Account::add_account_data($mes,$rd->{contact},0)]]; 227 } else 228 { 229 push @d,['domain:account',['domain:account-id',$rd->{contact}]]; 230 } 231 232 ## ns, optional 233 push @d,build_ns($mes,$rd->{ns},$domain) if (Net::DRI::Util::has_ns($rd)); 234 235 ## See http://www.nominet.org.uk/registrars/systems/data/fields/#billing 236 push @d,['domain:first-bill',$rd->{'first-bill'}] if (Net::DRI::Util::has_key($rd,'first-bill') && $rd->{'first-bill'}=~m/^(?:th|bc)$/); 237 push @d,['domain:recur-bill',$rd->{'recur-bill'}] if (Net::DRI::Util::has_key($rd,'recur-bill') && $rd->{'recur-bill'}=~m/^(?:th|bc)$/); 238 push @d,['domain:auto-bill',$rd->{'auto-bill'}] if (Net::DRI::Util::has_key($rd,'auto-bill') && $rd->{'auto-bill'}=~m/^\d+$/ && $rd->{'auto-bill'}>=1 && $rd->{'auto-bill'}<=182); 239 push @d,['domain:next-bill',$rd->{'next-bill'}] if (Net::DRI::Util::has_key($rd,'next-bill') && $rd->{'next-bill'}=~m/^\d+$/ && $rd->{'next-bill'}>=1 && $rd->{'next-bill'}<=182); 240 push @d,['domain:notes',$rd->{notes}] if Net::DRI::Util::has_key($rd,'notes'); 241 242 $mes->command_body(\@d); 243} 244 245sub create_parse 246{ 247 my ($po,$otype,$oaction,$oname,$rinfo)=@_; 248 my $mes=$po->message(); 249 return unless $mes->is_success(); 250 my $credata=$mes->get_response('domain','creData'); 251 return unless defined $credata; 252 253 my $cs=$po->create_local_object('contactset'); 254 foreach my $el (Net::DRI::Util::xml_list_children($credata)) 255 { 256 my ($name,$c)=@$el; 257 if ($name eq 'name') 258 { 259 $oname=lc($c->textContent()); 260 $rinfo->{domain}->{$oname}->{action}='create'; 261 $rinfo->{domain}->{$oname}->{exist}=1; 262 } elsif ($name eq 'account') 263 { 264 my $node=$c->getChildrenByTagNameNS($mes->ns('account'),'creData')->get_node(1); 265 my $roid=Net::DRI::Protocol::EPP::Extensions::Nominet::Account::parse_credata($mes,$node,$po,$cs,$rinfo); 266 $rinfo->{account}->{$roid}->{action}='create'; 267 $rinfo->{domain}->{$oname}->{contact}=$cs; 268 } elsif ($name=~m/^(crDate|exDate)$/) 269 { 270 $rinfo->{domain}->{$oname}->{$1}=$po->parse_iso8601($c->textContent()); 271 } 272 } 273} 274 275sub update 276{ 277 my ($epp,$domain,$todo)=@_; 278 my $mes=$epp->message(); 279 280 Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo); 281 282 my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'update',$domain); 283 my $ns=$todo->set('ns'); 284 my $co=$todo->set('contact'); 285 286 ## account 287 if (Net::DRI::Util::isa_contactset($co)) 288 { 289 push @d,['domain:account',['account:update',{'xmlns:account'=>$mes->ns('account'),'xmlns:contact'=>$mes->ns('contact')},Net::DRI::Protocol::EPP::Extensions::Nominet::Account::add_account_data($mes,$co,1)]]; 290 } 291 292 ## NS 293 if (Net::DRI::Util::isa_hosts($ns,1)) 294 { 295 if ($ns->is_empty()) 296 { 297 push @d,['domain:ns']; ## empty domain:ns means removal of all nameservers from domain 298 } else 299 { 300 push @d,build_ns($mes,$ns,$domain); 301 } 302 } 303 304 my $tmp=$todo->set('first-bill'); 305 push @d,['domain:first-bill',$tmp] if (defined($tmp) && $tmp=~m/^(?:th|bc)$/); 306 $tmp=$todo->set('recur-bill'); 307 push @d,['domain:recur-bill',$tmp] if (defined($tmp) && $tmp=~m/^(?:th|bc)$/); 308 Net::DRI::Exception::usererr_invalid_parameters('For domain_update auto-bill and next-bill can not be there at the same time') if (defined($todo->set('auto-bill')) && $todo->set('auto-bill') && defined($todo->set('next-bill')) && $todo->set('next-bill')); 309 $tmp=$todo->set('auto-bill'); 310 push @d,['domain:auto-bill',$tmp] if (defined($tmp) && ($tmp eq '' || ($tmp=~m/^\d+$/ && $tmp>=1 && $tmp<=182))); 311 $tmp=$todo->set('next-bill'); 312 push @d,['domain:next-bill',$tmp] if (defined($tmp) && ($tmp eq '' || ($tmp=~m/^\d+$/ && $tmp>=1 && $tmp<=182))); 313 $tmp=$todo->set('notes'); 314 push @d,['domain:notes',$tmp] if defined($tmp); 315 316 $mes->command_body(\@d); 317} 318 319## Warning: this can also be used for multiple domain names at once, 320## see http://www.nominet.org.uk/registrars/systems/nominetepp/Unrenew/ 321## However, if we accept that, we will probably have to tweak Core::Domain::renew_parse 322## to handle multiple renData nodes in the response. 323sub unrenew 324{ 325 my ($epp,$domain,$rd)=@_; 326 my $mes=$epp->message(); 327 328 Net::DRI::Exception->die(1,'protocol/EPP',2,'Domain name needed') unless defined($domain) && $domain; 329 Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid domain name: '.$domain) unless Net::DRI::Util::is_hostname($domain); 330 331 $mes->command(['update','domain:unrenew',sprintf('xmlns:domain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('domain'))]); 332 my @d=(['domain:name',$domain]); 333 $mes->command_body(\@d); 334} 335 336#################################################################################################### 3371; 338