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