1## Domain Registry Interface, .NO policies for Net::DRI 2## 3## Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 4## Trond Haugen E<lt>info@norid.noE<gt> 5## All rights reserved. 6## 7## This file is part of Net::DRI 8## 9## Net::DRI is free software; you can redistribute it and/or modify 10## it under the terms of the GNU General Public License as published by 11## the Free Software Foundation; either version 2 of the License, or 12## (at your option) any later version. 13## 14## See the LICENSE file that comes with this distribution for more details. 15# 16# 17# 18######################################################################################### 19 20package Net::DRI::DRD::NO; 21 22use strict; 23use warnings; 24 25use base qw/Net::DRI::DRD/; 26 27use DateTime::Duration; 28use Net::DRI::Util; 29use Net::DRI::Exception; 30 31our $VERSION = do { my @r = ( q$Revision: 1.5 $ =~ /\d+/gxm ); sprintf( "%d" . ".%02d" x $#r, @r ); }; 32 33# let contact check support be decided by the server policy 34__PACKAGE__->make_exception_for_unavailable_operations(qw/domain_transfer_accept domain_transfer_refuse contact_transfer_stop contact_transfer_query contact_transfer_accept contact_transfer_refuse/); 35 36=pod 37 38=head1 NAME 39 40Net::DRI::DRD::NO - .NO policies for Net::DRI 41 42=head1 DESCRIPTION 43 44Please see the README file for details. 45 46=head1 SUPPORT 47 48For now, support questions should be sent to: 49 50E<lt>netdri@dotandco.comE<gt> 51 52Please also see the SUPPORT file in the distribution. 53 54=head1 SEE ALSO 55 56E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 57 58=head1 AUTHOR 59 60Trond Haugen E<lt>info@norid.noE<gt> 61 62=head1 COPYRIGHT 63 64Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 65Trond Haugen E<lt>info@norid.noE<gt> 66All rights reserved. 67 68This program is free software; you can redistribute it and/or modify 69it under the terms of the GNU General Public License as published by 70the Free Software Foundation; either version 2 of the License, or 71(at your option) any later version. 72 73See the LICENSE file that comes with this distribution for more details. 74 75=cut 76 77#################################################################################################### 78 79sub new { 80 my $class = shift; 81 my $self = $class->SUPER::new(@_); 82 $self->{info}->{host_as_attr} = 0; # means make host objects 83 $self->{info}->{use_null_auth}= 1; # means using domain:null for empty authinfo password 84 85 bless( $self, $class ); 86 return $self; 87} 88 89sub periods { 90 return map { DateTime::Duration->new( years => $_ ) } (1); 91} 92sub name { return 'NORID'; } 93sub tlds { return ('NO'); } 94sub object_types { return ( 'domain', 'contact', 'ns' ); } 95sub profile_types { return qw/epp/; } 96 97sub transport_protocol_default { 98 my ($self,$type)=@_; 99 100 return ('Net::DRI::Transport::Socket',{},'Net::DRI::Protocol::EPP::Extensions::NO',{}) if $type eq 'epp'; 101# suppress until whois is supported 102#return ('Net::DRI::Transport::Socket',{remote_host=>'whois.norid.no'},'Net::DRI::Protocol::Whois',{}) if $type eq 'whois'; 103 104 return; 105} 106 107#################################################################################################### 108 109=head1 verify_name_domain 110 111.NO allows country codes in labels on the left, so we need to subclass 112the verify_name_domain to avoid the CCA2 table check. 113 114We then clone the .AT code also here, but remove the dot-count and check 115in 'check_name'. 116 117However, we do not subclass the 'is_my_tld' as .AT has done, 118but we then have to call it in a non-strict mode to allow for 119domain names with multiple lables. 120 121The combination should then allow multiple labels and also 122to use CC-codes in lables, like 'se.vgs.no' 123 124=cut 125 126sub verify_name_domain 127{ 128 my ($self,$ndr,$domain,$op)=@_; 129 $self->_verify_name_rules($domain,$op,{check_name_no_dots => 1, 130 my_tld_not_strict => 0, 131 }); 132} 133 134sub verify_duration_renew { 135 my ( $self, $ndr, $duration, $domain, $curexp ) = @_; 136 ( $duration, $domain, $curexp ) = ( $ndr, $duration, $domain ) 137 unless ( defined($ndr) 138 && $ndr 139 && ( ref($ndr) eq 'Net::DRI::Registry' ) ); 140 141 if ( defined($duration) ) { 142 my ( $y, $m ) = $duration->in_units( 'years', 'months' ); 143 144 ## Only 1..12m or 1y allowed in a renew 145 unless ( ( $y == 1 && $m == 0 ) 146 || ( $y == 0 && ( $m >= 1 && $m <= 12 ) ) ) 147 { 148 Net::DRI::Exception::usererr_invalid_parameters( 149 'Invalid duration for renew/transfer_execute, must be 1..12 months' 150 ); 151 return 1; # if exception is removed, return an error 152 } 153 } 154 return 0; ## everything ok 155} 156 157sub domain_operation_needs_is_mine { 158 my ( $self, $ndr, $domain, $op ) = @_; 159 return unless defined($op); 160 161 return 1 if ( $op =~ m/^(?:renew|update|delete|withdraw)$/mx ); 162 return 0 if ( $op eq 'transfer' ); 163 return; 164} 165 166sub domain_withdraw { 167 my ( $self, $ndr, $domain, $rd ) = @_; 168 $self->enforce_domain_name_constraints($ndr,$domain,'withdraw'); 169 170 $rd = {} unless ( defined($rd) && ( ref($rd) eq 'HASH' ) ); 171 $rd->{transactionname} = 'withdraw'; 172 173 my $rc = $ndr->process( 'domain', 'withdraw', [ $domain, $rd ] ); 174 return $rc; 175} 176 177sub domain_transfer_execute 178{ 179 my ($self,$ndr,$domain,$rd)=@_; 180 $self->enforce_domain_name_constraints($ndr,$domain,'transfer_execute'); 181 182 $rd={} unless (defined($rd) && (ref($rd) eq 'HASH')); 183 $rd->{transactionname} = 'transfer_execute'; 184 185 my $rc=$ndr->process('domain','transfer_execute',[$domain,$rd]); 186 return $rc; 187} 188 189# need to accept also t=contact as an element-type to be updated 190# 191sub host_update { 192 my ( $self, $ndr, $dh, $tochange, $rh ) = @_; 193 my $fp = $ndr->protocol->nameversion(); 194 195 my $name 196 = ( UNIVERSAL::isa( $dh, 'Net::DRI::Data::Hosts' ) ) 197 ? $dh->get_details(1) 198 : $dh; 199 $self->enforce_host_name_constraints($ndr,$name); 200 Net::DRI::Util::check_isa( $tochange, 'Net::DRI::Data::Changes' ); 201 202 foreach my $t ( $tochange->types() ) { 203 Net::DRI::Exception->die( 0, 'DRD', 6, 204 "Change host_update/${t} not handled" ) 205 unless ( $t =~ m/^(?:ip|status|name|contact|facets)$/mx ); 206 next if $ndr->protocol_capable( 'host_update', $t ); 207 Net::DRI::Exception->die( 0, 'DRD', 5, 208 "Protocol ${fp} is not capable of host_update/${t}" ); 209 } 210 211 my %what = ( 212 'ip' => [ $tochange->all_defined('ip') ], 213 'status' => [ $tochange->all_defined('status') ], 214 'name' => [ $tochange->all_defined('name') ], 215 ); 216 foreach ( @{ $what{ip} } ) { 217 Net::DRI::Util::check_isa( $_, 'Net::DRI::Data::Hosts' ); 218 } 219 foreach ( @{ $what{status} } ) { 220 Net::DRI::Util::check_isa( $_, 'Net::DRI::Data::StatusList' ); 221 } 222 foreach ( @{ $what{name} } ) { 223 $self->enforce_host_name_constraints($ndr,$_); 224 } 225 226 foreach my $w ( keys(%what) ) { 227 my @s = @{ $what{$w} }; 228 next unless @s; ## no changes of that type 229 230 my $add = $tochange->add($w); 231 my $del = $tochange->del($w); 232 my $set = $tochange->set($w); 233 234 Net::DRI::Exception->die( 0, 'DRD', 5, 235 "Protocol ${fp} is not capable for host_update/${w} to add" ) 236 if ( defined($add) 237 && !$ndr->protocol_capable( 'host_update', $w, 'add' ) ); 238 Net::DRI::Exception->die( 0, 'DRD', 5, 239 "Protocol ${fp} is not capable for host_update/${w} to del" ) 240 if ( defined($del) 241 && !$ndr->protocol_capable( 'host_update', $w, 'del' ) ); 242 Net::DRI::Exception->die( 0, 'DRD', 5, 243 "Protocol ${fp} is not capable for host_update/${w} to set" ) 244 if ( defined($set) 245 && !$ndr->protocol_capable( 'host_update', $w, 'set' ) ); 246 Net::DRI::Exception->die( 0, 'DRD', 6, 247 "Change host_update/${w} with simultaneous set and add or del not supported" 248 ) if ( defined($set) && ( defined($add) || defined($del) ) ); 249 } 250 251 my $rc = $ndr->process( 'host', 'update', [ $dh, $tochange, $rh ] ); 252 return $rc; 253} 254 255sub message_retrieve { 256 my ( $self, $ndr, $rd ) = @_; 257 258 my $rc = $ndr->process( 'message', 'noretrieve', [$rd] ); 259 return $rc; 260} 261 262sub message_delete { 263 my ( $self, $ndr, $id, $rd ) = @_; 264 265 my $rc = $ndr->process( 'message', 'nodelete', [$id, $rd] ); 266 return $rc; 267} 268 269sub message_waiting { 270 my ( $self, $ndr, $rd ) = @_; 271 272 my $c = $self->message_count($ndr, $rd); 273 return ( defined($c) && $c ) ? 1 : 0; 274} 275 276sub message_count { 277 my ( $self, $ndr, $rd ) = @_; 278 279 my $count = $ndr->get_info( 'count', 'message', 'info' ); 280 return $count if defined($count); 281 282 my $rc = $ndr->process( 'message', 'noretrieve', [$rd] ); 283 284 return unless $rc->is_success(); 285 $count = $ndr->get_info( 'count', 'message', 'info' ); 286 return ( defined($count) && $count ) ? $count : 0; 287} 288 289#################################################################################################### 2901; 291