File Coverage

blib/lib/Net/DRI/DRD/NO.pm
Criterion Covered Total %
statement 27 105 25.7
branch 1 36 2.7
condition 0 33 0.0
subroutine 10 23 43.4
pod 4 17 23.5
total 42 214 19.6


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