1## Domain Registry Interface, OpenSRS XCP Domain 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::OpenSRS::XCP::Domain;
19
20use strict;
21use warnings;
22
23use Net::DRI::Exception;
24use Net::DRI::Util;
25
26our $VERSION=do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
27
28=pod
29
30=head1 NAME
31
32Net::DRI::Protocol::OpenSRS::XCP::Domain - OpenSRS XCP Domain 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          check => [\&check, \&check_parse ],
76          create => [ \&create, \&create_parse ], ## TODO : parsing of return messages
77          delete => [ \&delete, \&delete_parse ],
78	  renew => [ \&renew, \&renew_parse ],
79          transfer_request => [ \&transfer_request, \&transfer_request_parse ],
80          transfer_query => [ \&transfer_query, \&transfer_query_parse ],
81          transfer_cancel => [ \&transfer_cancel, \&transfer_cancel_parse ],
82         );
83
84 return { 'domain' => \%tmp };
85}
86
87sub build_msg_cookie
88{
89 my ($msg,$action,$cookie,$regip)=@_;
90 my %r=(action=>$action,object=>'domain',cookie=>$cookie);
91 $r{registrant_ip}=$regip if defined($regip);
92 $msg->command(\%r);
93}
94
95sub info
96{
97 my ($xcp,$domain,$rd)=@_;
98 my $msg=$xcp->message();
99 Net::DRI::Exception::usererr_insufficient_parameters('A cookie is needed for domain_info') unless Net::DRI::Util::has_key($rd,'cookie');
100 build_msg_cookie($msg,'get',$rd->{cookie},$rd->{registrant_ip});
101 $msg->command_attributes({type => 'all_info'});
102
103}
104
105sub info_parse
106{
107 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
108 my $mes=$xcp->message();
109 return unless $mes->is_success();
110
111 $rinfo->{domain}->{$oname}->{action}='info';
112 $rinfo->{domain}->{$oname}->{exist}=1;
113 my $ra=$mes->response_attributes(); ## Not parsed: dns_errors, descr
114
115 my %d=(registry_createdate => 'crDate', registry_expiredate => 'exDate', registry_updatedate => 'upDate', registry_transferdate => 'trDate', expiredate => 'exDateLocal');
116 while (my ($k,$v)=each(%d))
117 {
118  next unless exists($ra->{$k});
119  $ra->{$k}=~s/\s+/T/; ## with a little effort we become ISO8601
120  $rinfo->{domain}->{$oname}->{$v}=$xcp->parse_iso8601($ra->{$k});
121 }
122
123 my $ns=$ra->{nameserver_list};
124 if (defined($ns) && ref($ns) && @$ns)
125 {
126  my $nso=$xcp->create_local_object('hosts');
127  foreach my $h (@$ns)
128  {
129   $nso->add($h->{name},[$h->{ipaddress}]);
130  }
131  $rinfo->{domain}->{$oname}->{ns}=$nso;
132 }
133
134 foreach my $bool (qw/sponsoring_rsp auto_renew let_expire/)
135 {
136  next unless exists($ra->{$bool});
137  $rinfo->{domain}->{$oname}->{$bool}=$ra->{$bool};
138 }
139
140 my $c=$ra->{contact_set};
141 if (defined($c) && ref($c) && keys(%$c))
142 {
143  my $cs=$xcp->create_local_object('contactset');
144  while (my ($type,$v)=each(%$c))
145  {
146   my $c=parse_contact($xcp,$v);
147   $cs->add($c,$type eq 'owner'? 'registrant' : $type);
148  }
149  $rinfo->{domain}->{$oname}->{contact}=$cs;
150 }
151
152 ## No data about status ?
153}
154
155sub parse_contact
156{
157 my ($xcp,$rh)=@_;
158 my $c=$xcp->create_local_object('contact');
159 ## No ID given back ! Waouh that is great... not !
160 $c->firstname($rh->{first_name});
161 $c->name($rh->{last_name});
162 $c->org($rh->{org_name}) if exists($rh->{org_name});
163 $c->street([map { $rh->{'address'.$_} } grep {exists($rh->{'address'.$_}) && defined($rh->{'address'.$_}) } (1,2,3)]);
164 $c->city($rh->{city}) if exists($rh->{city});
165 $c->sp($rh->{state}) if exists($rh->{state});
166 $c->pc($rh->{postal_code}) if exists($rh->{postal_code});
167 $c->cc($rh->{country}) if exists($rh->{country});
168 $c->voice($rh->{phone}) if exists($rh->{voice});
169 $c->fax($rh->{fax}) if exists($rh->{fax});
170 $c->email($rh->{email}) if exists($rh->{email});
171 $c->url($rh->{url}) if exists($rh->{url});
172 return $c;
173}
174
175sub check
176{
177 my ($xcp,$domain,$rd)=@_;
178 my $msg=$xcp->message();
179 my %r=(action=>'lookup',object=>'domain');
180 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
181 $msg->command(\%r);
182 $msg->command_attributes({domain => $domain});
183}
184
185sub check_parse
186{
187 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
188 my $mes=$xcp->message();
189 return unless $mes->is_success();
190
191 $rinfo->{domain}->{$oname}->{action}='check';
192 my $ra=$mes->response_attributes();
193 $rinfo->{domain}->{$oname}->{exist}=(exists $ra->{status} && defined($ra->{status}) && $ra->{status} eq 'available' && $mes->response_code()==210)? 0 : 1;
194 $rinfo->{domain}->{$oname}->{exist_reason}=$mes->response_text();
195}
196
197sub create
198{
199 my ($xcp,$domain,$rd)=@_;
200
201 sw_register($xcp, $domain, $rd, 'new'); # TBD: premium, sunrise, whois_privacy
202}
203
204sub create_parse
205{
206 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
207 my $mes=$xcp->message();
208 return unless $mes->is_success();
209
210 $rinfo->{domain}->{$oname}->{action}='create';
211 my $ra=$mes->response_attributes();
212 foreach (qw/admin_email cancelled_orders error id queue_request_id forced_pending whois_privacy/) {
213  $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
214 }
215}
216
217sub sw_register
218{
219 my ($xcp,$domain,$rd,$reg_type)=@_;
220
221 my $msg=$xcp->message();
222
223 my %r=(action => 'sw_register', object => 'domain');
224 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
225
226 $msg->command(\%r);
227
228 Net::DRI::Exception::usererr_insufficient_parameters('Username+Password are required for sw_register') if grep { ! Net::DRI::Util::has_key($rd,$_) } qw/username password/;
229
230 Net::DRI::Exception::usererr_insufficient_parameters('contacts are mandatory') unless Net::DRI::Util::has_contact($rd);
231 my $cs=$rd->{contact};
232 foreach my $t (qw/registrant admin billing/)
233 {
234  my @t=$cs->get($t);
235  Net::DRI::Exception::usererr_invalid_parameters('one ' . $t . ' contact is mandatory') unless @t==1;
236  my $co=$cs->get($t);
237  Net::DRI::Exception::usererr_insufficient_parameters($t . 'contact is mandatory') unless Net::DRI::Util::isa_contact($co);
238  $co->validate();
239 }
240
241 my %contact_set = ();
242 my $attr = {reg_type => $reg_type, domain => $domain, contact_set => \%contact_set};
243 $contact_set{owner} = add_owner_contact($msg,$cs);
244 $contact_set{admin} = add_admin_contact($msg,$cs);
245 $contact_set{billing} = add_billing_contact($msg,$cs);
246 if ($cs->get('tech')) {
247  $contact_set{tech} = add_tech_contact($msg,$cs); ## optional
248  $attr->{custom_tech_contact} = 1;
249 } else {
250  $attr->{custom_tech_contact} = 0; # Use default tech contact
251 }
252
253 # These are all the OpenSRS names for optional parameters.  Might need to map generic names to OpenSRS namespace later.
254 foreach (qw/auto_renew affiliate_id f_lock_domain f_parkp f_whois_privacy/) {
255  $attr->{$_} = ($rd->{$_} ? 1 : 0 ) if Net::DRI::Util::has_key($rd, $_);
256 }
257 foreach (qw/affiliate_id reg_domain/) {
258  $attr->{$_} = ($rd->{$_}) if Net::DRI::Util::has_key($rd, $_);
259 }
260
261 # TBD: ccTLD-specific flags including domain encoding.
262 # TBD: handle, link_domains, etc.
263
264 if ($reg_type eq 'new') {
265  Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd);
266  $attr->{period} = $rd->{duration}->years();
267 }
268
269 $attr->{reg_username} = $rd->{username};
270 $attr->{reg_password} = $rd->{password};
271
272 $msg->command_attributes($attr);
273
274 add_all_ns($domain,$msg,$rd->{ns});
275}
276
277sub add_contact_info
278{
279 my ($msg,$co)=@_;
280 my %contact = ();
281
282 $contact{first_name} = $co->firstname();
283 $contact{last_name} = $co->name();
284
285 $contact{org_name} = $co->org() if $co->org();
286
287 my $s=$co->street();
288 Net::DRI::Exception::usererr_insufficient_parameters('1 line of address at least needed') unless ($s && (ref($s) eq 'ARRAY') && @$s && $s->[0]);
289
290 $contact{address1} = $s->[0];
291 $contact{address2} = $s->[1] if $s->[1];
292 $contact{address3} = $s->[2] if $s->[2];
293 Net::DRI::Exception::usererr_insufficient_parameters('city, sp, pc & cc mandatory') unless ($co->city() && $co->sp() && $co->pc() && $co->cc());
294 $contact{city} = $co->city();
295 $contact{state} = $co->sp();
296 $contact{postal_code} = $co->pc();
297 $contact{country} = uc($co->cc());
298 Net::DRI::Exception::usererr_insufficient_parameters('voice & email mandatory') unless ($co->voice() && $co->email());
299 $contact{phone} = $co->voice();
300 $contact{fax} = $co->fax() if $co->fax();
301 $contact{email} = $co->email();
302 $contact{url} = $co->url() if $co->url();
303 return \%contact;
304}
305
306sub add_owner_contact
307{
308 my ($msg,$cs)=@_;
309 my $co=$cs->get('registrant');
310 return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
311}
312
313sub add_admin_contact
314{
315 my ($msg,$cs)=@_;
316 my $co=$cs->get('admin');
317 return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
318}
319
320sub add_billing_contact
321{
322 my ($msg,$cs)=@_;
323 my $co=$cs->get('billing');
324 return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
325}
326
327sub add_tech_contact
328{
329 my ($msg,$cs)=@_;
330 my $co=$cs->get('tech');
331 return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
332}
333
334sub add_all_ns
335{
336 my ($domain,$msg,$ns)=@_;
337 my @nslist = ();
338
339 my $attr = $msg->command_attributes();
340 $attr->{custom_nameservers} = 0;
341
342 if (defined($ns)) {
343  Net::DRI::Exception::usererr_insufficient_parameters('at least 2 nameservers are mandatory') unless (Net::DRI::Util::isa_hosts($ns) && $ns->count()>=2); # Name servers are optional; if present must be >=2
344
345  for (my $i = 1; $i <= $ns->count(); $i++) { # Net:DRI name server list starts at 1.
346   my $name = $ns->get_details($i); # get_details in scalar returns name
347   push @nslist, { sortorder => $i, name => $name };
348  }
349  $attr->{custom_nameservers} = 1;
350  $attr->{nameserver_list} =  \@nslist;
351 }
352 $msg->command_attributes($attr);
353}
354
355sub delete
356{
357 my ($xcp,$domain,$rd)=@_;
358 my $msg=$xcp->message();
359
360 Net::DRI::Exception::usererr_insufficient_parameters('Reseller ID is mandatory') unless (Net::DRI::Util::has_key($rd, 'reseller_id'));
361
362 my %r=(action => 'revoke', object => 'domain');
363 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
364
365 $msg->command(\%r);
366 my $attr = {domain => $domain, reseller => $rd->{reseller_id}};
367 $attr->{notes} = $rd->{notes} if Net::DRI::Util::has_key($rd, 'notes');
368 $msg->command_attributes({domain => $domain, reseller => $rd->{reseller_id}});
369}
370
371sub delete_parse
372{
373 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
374 my $mes=$xcp->message();
375 return unless $mes->is_success();
376
377 $rinfo->{domain}->{$oname}->{action}='delete';
378 my $ra=$mes->response_attributes();
379 foreach (qw/charge price/) {
380  $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
381 }
382}
383
384sub renew
385{
386 my ($xcp,$domain,$rd)=@_;
387 my $msg=$xcp->message();
388
389 my %r=(action => 'renew', object => 'domain');
390 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
391
392 Net::DRI::Exception::usererr_insufficient_parameters('auto_renew setting is mandatory') unless (Net::DRI::Util::has_key($rd, 'auto_renew'));
393
394 Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd);
395 Net::DRI::Exception::usererr_insufficient_parameters('current expiration is mandatory') unless (Net::DRI::Util::has_key($rd, 'current_expiration') && Net::DRI::Util::check_isa($rd->{current_expiration}, 'DateTime')); # Can get this from set_cookie response.
396
397 my $attr = {domain => $domain, period => $rd->{duration}->years(), currentexpirationyear => $rd->{current_expiration}->year()};
398
399 # These are all the OpenSRS names for optional parameters.  Might need to map generic names to OpenSRS namespace later.
400 foreach (qw/auto_renew f_parkp/) {
401  $attr->{$_} = ($rd->{$_} ? 1 : 0 ) if Net::DRI::Util::has_key($rd, $_);
402 }
403 foreach (qw/affiliate_id notes/) {
404  $attr->{$_} = ($rd->{$_}) if Net::DRI::Util::has_key($rd, $_);
405 }
406
407 # TBD: handle, etc.
408
409 $msg->command(\%r);
410 $msg->command_attributes($attr);
411}
412
413sub renew_parse
414{
415 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
416 my $mes=$xcp->message();
417 return unless $mes->is_success();
418
419 $rinfo->{domain}->{$oname}->{action}='renew';
420 my $ra=$mes->response_attributes();
421 foreach (qw/auto_renew admin_email order_id id queue_request_id/) {
422  $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
423 }
424 my ($k,$v)=('registration expiration date', 'exDate');
425 $ra->{$k}=~s/\s+/T/; ## with a little effort we become ISO8601
426 $rinfo->{domain}->{$oname}->{$v}=$xcp->parse_iso8601($ra->{$k});
427}
428
429sub transfer_request
430{
431 my ($xcp,$domain,$rd)=@_;
432
433 sw_register($xcp, $domain, $rd, 'transfer');
434}
435
436sub transfer_request_parse
437{
438 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
439 my $mes=$xcp->message();
440 return unless $mes->is_success();
441
442 $rinfo->{domain}->{$oname}->{action}='transfer_start';
443 my $ra=$mes->response_attributes();
444 foreach (qw/admin_email cancelled_orders error id queue_request_id forced_pending whois_privacy/) {
445  $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
446 }
447}
448
449sub transfer_query
450{
451 my ($xcp,$domain,$rd)=@_;
452 my $msg=$xcp->message();
453
454 my %r=(action => 'check_transfer', object => 'domain');
455 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
456
457 $msg->command(\%r);
458 $msg->command_attributes({domain => $domain, check_status => 1, get_request_address => 1}); # TBD: usable for checking transferability
459}
460
461sub transfer_query_parse
462{
463 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
464 my $mes=$xcp->message();
465 return unless $mes->is_success();
466
467 $rinfo->{domain}->{$oname}->{action}='check_transfer';
468 my $ra=$mes->response_attributes();
469 foreach (qw/transferrable status request_address timestamp unixtime reason type noservice/) {
470  $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
471 }
472}
473
474sub transfer_cancel
475{
476 my ($xcp,$domain,$rd)=@_;
477 my $msg=$xcp->message();
478
479 Net::DRI::Exception::usererr_insufficient_parameters('Reseller ID is mandatory') unless (Net::DRI::Util::has_key($rd, 'reseller_id'));
480
481 my %r=(action => 'cancel_transfer', object => 'transfer');
482 $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
483
484 $msg->command(\%r);
485 $msg->command_attributes({domain => $domain, reseller => $rd->{reseller_id}}); # TBD: optional order ID
486}
487
488sub transfer_cancel_parse
489{
490 my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
491 my $mes=$xcp->message();
492 return unless $mes->is_success();
493
494 $rinfo->{domain}->{$oname}->{action}='cancel_transfer';
495 # This response has no attributes to capture
496}
497
498####################################################################################################
4991;
500