1## Domain Registry Interface, .UK (Nominet) policies for Net::DRI
2##
3## Copyright (c) 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::DRD::Nominet;
19
20use strict;
21use warnings;
22
23use base qw/Net::DRI::DRD/;
24
25use Net::DRI::Util;
26use Net::DRI::Exception;
27
28use DateTime::Duration;
29
30our $VERSION=do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
31
32## No status at all with Nominet
33## Only domain:check is available
34## Only domain transfer op=req and refuse/accept
35## The delete command applies only to domain names.  Accounts, contacts and nameservers cannot be explicitly deleted, but are automatically deleted when no longer referenced.
36## No direct contact/host create
37__PACKAGE__->make_exception_for_unavailable_operations(qw/domain_update_status_add domain_update_status_del domain_update_status_set domain_update_status domain_status_allows_delete domain_status_allows_update domain_status_allows_transfer domain_status_allows_renew domain_status_allows domain_current_status host_update_status_add host_update_status_del host_update_status_set host_update_status host_current_status contact_update_status_add contact_update_status_del contact_update_status_set contact_update_status contact_current_status host_check host_check_multi host_exist contact_check contact_check_multi contact_exist contact_transfer contact_transfer_start contact_transfer_stop contact_transfer_query contact_transfer_accept contact_transfer_refuse domain_transfer_stop domain_transfer_query host_delete contact_delete host_create contact_create/);
38
39=pod
40
41=head1 NAME
42
43Net::DRI::DRD::Nominet - .UK (Nominet) policies for Net::DRI
44
45=head1 DESCRIPTION
46
47Please see the README file for details.
48
49=head1 SUPPORT
50
51For now, support questions should be sent to:
52
53E<lt>netdri@dotandco.comE<gt>
54
55Please also see the SUPPORT file in the distribution.
56
57=head1 SEE ALSO
58
59E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt>
60
61=head1 AUTHOR
62
63Patrick Mevzek, E<lt>netdri@dotandco.comE<gt>
64
65=head1 COPYRIGHT
66
67Copyright (c) 2007,2008,2009 Patrick Mevzek <netdri@dotandco.com>.
68All rights reserved.
69
70This program is free software; you can redistribute it and/or modify
71it under the terms of the GNU General Public License as published by
72the Free Software Foundation; either version 2 of the License, or
73(at your option) any later version.
74
75See the LICENSE file that comes with this distribution for more details.
76
77=cut
78
79####################################################################################################
80
81sub new
82{
83 my $class=shift;
84 my $self=$class->SUPER::new(@_);
85 $self->{info}->{host_as_attr}=1;
86
87 bless($self,$class);
88 return $self;
89}
90
91sub periods  { return map { DateTime::Duration->new(years => $_) } (2); }
92sub name     { return 'Nominet'; }
93sub tlds     { return qw/co.uk ltd.uk me.uk net.uk org.uk plc.uk sch.uk/; } ##�See http://www.nominet.org.uk/registrants/aboutdomainnames/rules/
94sub object_types { return ('domain','contact','ns','account'); }
95sub profile_types { return qw/epp/; }
96
97sub transport_protocol_default
98{
99 my ($self,$type)=@_;
100
101 return ('Net::DRI::Transport::Socket',{remote_host => 'epp.nominet.org.uk'},'Net::DRI::Protocol::EPP::Extensions::Nominet',{}) if ($type eq 'epp' || $type eq 'epp_nominet');
102 return ('Net::DRI::Transport::Socket',{remote_host => 'epp.nominet.org.uk'},'Net::DRI::Protocol::EPP',{}) if ($type eq 'epp_standard');
103 return;
104}
105
106sub transport_protocol_init
107{
108 my ($self,$type,$tc,$tp,$pc,$pp,$test)=@_;
109
110 ## As seen on http://www.nominet.org.uk/registrars/systems/nominetepp/login/
111 $tp->{client_login}='#'.$tp->{client_login} if ($type eq 'epp' && defined $tp->{client_login} && length $tp->{client_login}==2);
112 return;
113}
114
115####################################################################################################
116
117## http://www.nominet.org.uk/registrars/systems/epp/renew/
118sub verify_duration_renew
119{
120 my ($self,$ndr,$duration,$domain,$curexp)=@_;
121 ($duration,$domain,$curexp)=($ndr,$duration,$domain) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
122
123## +Renew commands will only be processed if the expiry date of the domain name is within 6 months.
124
125 if (defined($duration))
126 {
127  my ($y,$m)=$duration->in_units('years','months');
128  return 1 unless ($y==2 && $m==0); ## Only 24m or 2y allowed
129 }
130
131 return 0; ## everything ok
132}
133
134sub host_info
135{
136 my ($self,$ndr,$dh,$rh)=@_;
137 my $roid=Net::DRI::Util::isa_hosts($dh)? $dh->roid() : $dh;
138
139 ## when we do a domain:info we get all info needed to later on reply to a host:info (cache delay permitting) ; we do not take this information into account here
140 my $rc=$ndr->try_restore_from_cache('host',$roid,'info');
141 if (! defined $rc) { $rc=$ndr->process('host','info',[$dh,$rh]); }
142
143 return $rc unless $rc->is_success();
144 return (wantarray())? ($rc,$ndr->get_info('self')) : $rc;
145}
146
147sub host_update
148{
149 my ($self,$ndr,$dh,$tochange)=@_;
150 my $fp=$ndr->protocol->nameversion();
151
152 my $name=Net::DRI::Util::isa_hosts($dh)? $dh->get_details(1) : $dh;
153 $self->enforce_host_name_constraints($ndr,$name);
154 Net::DRI::Util::check_isa($tochange,'Net::DRI::Data::Changes');
155
156 foreach my $t ($tochange->types())
157 {
158  Net::DRI::Exception->die(0,'DRD',6,"Change host_update/${t} not handled") unless ($t=~m/^(?:ip|name)$/);
159  next if $ndr->protocol_capable('host_update',$t);
160  Net::DRI::Exception->die(0,'DRD',5,"Protocol ${fp} is not capable of host_update/${t}");
161 }
162
163 my %what=('ip'     => [ $tochange->all_defined('ip') ],
164           'name'   => [ $tochange->all_defined('name') ],
165          );
166 foreach (@{$what{ip}})     { Net::DRI::Util::check_isa($_,'Net::DRI::Data::Hosts'); }
167 foreach (@{$what{name}})   { $self->enforce_host_name_constraints($ndr,$_); }
168
169 foreach my $w (keys(%what))
170 {
171  my @s=@{$what{$w}};
172  next unless @s; ## no changes of that type
173
174  my $add=$tochange->add($w);
175  my $del=$tochange->del($w);
176  my $set=$tochange->set($w);
177
178  Net::DRI::Exception->die(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to add") if (defined($add) &&
179                                                                                       ! $ndr->protocol_capable('host_update',$w,'add'));
180  Net::DRI::Exception->die(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to del") if (defined($del) &&
181                                                                                       ! $ndr->protocol_capable('host_update',$w,'del'));
182  Net::DRI::Exception->die(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to set") if (defined($set) &&
183                                                                                       ! $ndr->protocol_capable('host_update',$w,'set'));
184  Net::DRI::Exception->die(0,'DRD',6,"Change host_update/${w} with simultaneous set and add or del not supported") if (defined($set) && (defined($add) || defined($del)));
185 }
186
187 my $rc=$ndr->process('host','update',[$dh,$tochange]);
188 return $rc;
189}
190
191sub account_info
192{
193 my ($self,$ndr,$c)=@_;
194 return $ndr->process('account','info',[$c]);
195 }
196
197sub account_update
198{
199 my ($self,$ndr,$c,$cs)=@_;
200 return $ndr->process('account','update',[$c,$cs]);
201}
202
203sub account_fork
204{
205 my ($self,$ndr,$c,$cs)=@_;
206 return $ndr->process('account','fork',[$c,$cs]);
207}
208
209sub account_merge
210{
211 my ($self,$ndr,$c,$cs)=@_;
212 return $ndr->process('account','merge',[$c,$cs]);
213}
214
215sub domain_unrenew
216{
217 my ($self,$ndr,$domain,$rd)=@_;
218 $self->enforce_domain_name_constraints($ndr,$domain,'unrenew');
219 return $ndr->process('domain','unrenew',[$domain,$rd]);
220}
221
222sub account_list_domains
223{
224 my ($self,$ndr,$rd,$rh)=@_;
225 my $rc=$ndr->try_restore_from_cache('account','domains','list');
226 if (! defined $rc) { $rc=$ndr->process('account','list_domains',[$rd,$rh]); }
227 return $rc;
228}
229
230####################################################################################################
2311;
232