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