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