1## Domain Registry Interface, AFNIC Email Domain commands 2## 3## Copyright (c) 2006,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::Protocol::AFNIC::Email::Domain; 19 20use strict; 21use warnings; 22use Net::DRI::Util; 23 24our $VERSION=do { my @r=(q$Revision: 1.7 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 25 26=pod 27 28=head1 NAME 29 30Net::DRI::Protocol::AFNIC::Email::Domain - AFNIC Email Domain commands for Net::DRI 31 32=head1 DESCRIPTION 33 34Please see the README file for details. 35 36=head1 SUPPORT 37 38For now, support questions should be sent to: 39 40E<lt>netdri@dotandco.comE<gt> 41 42Please also see the SUPPORT file in the distribution. 43 44=head1 SEE ALSO 45 46E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 47 48=head1 AUTHOR 49 50Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 51 52=head1 COPYRIGHT 53 54Copyright (c) 2006,2008,2009 Patrick Mevzek <netdri@dotandco.com>. 55All rights reserved. 56 57This program is free software; you can redistribute it and/or modify 58it under the terms of the GNU General Public License as published by 59the Free Software Foundation; either version 2 of the License, or 60(at your option) any later version. 61 62See the LICENSE file that comes with this distribution for more details. 63 64=cut 65 66#################################################################################################### 67 68sub register_commands 69{ 70 my ($class,$version)=@_; 71 my %tmp=( 72 create => [ \&create, undef ], ## TODO : parsing of return messages 73 delete => [ \&delete, undef ], 74 update => [ \&update, undef ], 75 transfer_request => [ \&transfer_request, undef], 76 trade => [ \&trade, undef], 77 ); 78 79 return { 'domain' => \%tmp }; 80} 81 82## AFNIC says international format is : +code_pays 10 20 30 40 50 83## yeah right ! 84sub format_tel 85{ 86 my $in=shift; 87 $in=~s/x.*$//; 88 my @t=split(/\./,$in,2); 89 return $t[0].' '.reverse(join(' ',grep { defined($_) && $_ ne '' } split(/(\d{2})/,reverse($t[1])))); 90} 91 92sub add_starting_block 93{ 94 my ($action,$domain,$mes,$rd)=@_; 95 my $ca=$mes->client_auth(); 96 97 $mes->line('1a',$action); 98 $mes->line('1b',$ca->{id}); ## code fournisseur 99 $mes->line('1c',$ca->{pw}); ## mot de passe 100 $mes->line('1e',$mes->trid()); ## reference client (=trid) ## allow more/other ? 101 $mes->line('1f','2.5.0'); 102 $mes->line('1g',$rd->{auth_code}) if ($action=~m/^[CD]$/ && Net::DRI::Util::has_key($rd,'auth_code') && $rd->{auth_code}); ## authorization code for reserved domain names 103 104 $mes->line('2a',$domain); 105} 106 107sub create 108{ 109 my ($a,$domain,$rd)=@_; 110 my $mes=$a->message(); 111 112 add_starting_block('C',$domain,$mes,$rd); 113 Net::DRI::Exception::usererr_insufficient_parameters('authInfo is mandatory') unless Net::DRI::Util::has_auth($rd); 114 $mes->line('2z',$rd->{auth}->{pw}); 115 116 Net::DRI::Exception::usererr_insufficient_parameters('contacts are mandatory') unless Net::DRI::Util::has_contact($rd); 117 my $cs=$rd->{contact}; 118 my $co=$cs->get('registrant'); 119 Net::DRI::Exception::usererr_insufficient_parameters('registrant contact is mandatory') unless Net::DRI::Util::isa_contact($co,'Net::DRI::Data::Contact::AFNIC'); 120 $co->validate(); 121 $co->validate_registrant(); 122 123 if ($co->legal_form()) ## PM 124 { 125 $mes->line('3w','PM'); 126 add_company_info($mes,$co); 127 } else ## PP 128 { 129 $mes->line('3w','PP'); 130 Net::DRI::Exception::usererr_insufficient_parameters('name or key needed for PP') unless ($co->name() || $co->key()); 131 if ($co->key()) 132 { 133 $mes->line('3q',$co->key()); 134 } else 135 { 136 $mes->line('3a',sprintf('%s, %s',$co->firstname(),$co->name())); 137 my $b=$co->birth(); 138 Net::DRI::Exception::usererr_insufficient_parameters('birth data (date+city) mandatory, if no registrant key provided') unless ($b && (ref($b) eq 'HASH') && exists($b->{date}) && exists($b->{place})); 139 $mes->line('3r',(ref($b->{date}))? $b->{date}->strftime('%d/%m/%Y') : $b->{date}); 140 $mes->line('3s',$b->{place}); 141 } 142 } 143 144 add_owner_info($mes,$co); 145 add_maintainer_disclose($mes,$co,$rd->{maintainer}) unless $mes->line('3x'); 146 add_admin_contact($mes,$cs); ## optional 147 add_tech_contacts($mes,$cs); ## mandatory 148 149 add_all_ns($domain,$mes,$rd->{ns}) if Net::DRI::Util::has_ns($rd); 150 add_installation($mes,$rd); 151} 152 153sub add_company_info 154{ 155 my ($mes,$co)=@_; 156 $mes->line('3a',$co->name()); 157 Net::DRI::Exception::usererr_insufficient_parameters('one legal form must be provided') unless ($co->legal_form() || $co->legal_form_other()); 158 $mes->line('3h',$co->legal_form()) if $co->legal_form(); 159 $mes->line('3i',$co->legal_form_other()) if $co->legal_form_other(); 160 Net::DRI::Exception::usererr_insufficient_parameters('legal id must be provided if no trademark') if (($co->legal_form() eq 'S') && !$co->trademark() && !$co->legal_id()); 161 $mes->line('3j',$co->legal_id()) if $co->legal_id(); 162 my $jo=$co->jo(); 163 Net::DRI::Exception::usererr_insufficient_parameters('jo data is needed for non profit organization without legal id or trademark') if (($co->legal_form() eq 'A') && !$co->legal_id() && !$co->trademark() && (!$jo || (ref($jo) ne 'HASH') || !exists($jo->{date_publication}) || !exists($jo->{page}))); 164 if ($jo && (ref($jo) eq 'HASH')) 165 { 166 $mes->line('3k',$jo->{date_declaration}) if (exists($jo->{date_declaration}) && $jo->{date_declaration}); 167 $mes->line('3l',$jo->{date_publication}) if (exists($jo->{date_publication}) && $jo->{date_publication}); 168 $mes->line('3m',$jo->{number}) if (exists($jo->{number}) && $jo->{number}); 169 $mes->line('3n',$jo->{page}) if (exists($jo->{page}) && $jo->{page}); 170 } 171 $mes->line('3p',$co->trademark()) if $co->trademark(); 172} 173 174 175sub add_installation 176{ 177 my ($mes,$rd)=@_; 178 179 ## Default = A = waiting for client, otherwise I = direct installation 180 my $inst=(Net::DRI::Util::has_key($rd,'installation_type') && $rd->{installation_type}=~m/^[IA]$/)? $rd->{installation_type} : 'A'; 181 $mes->line('8a',$inst); 182 ## S = standard = fax need to be sent, Default = E = Express = no fax 183 my $form=(Net::DRI::Util::has_key($rd,'form_type') && $rd->{form_type}=~m/^[SE]$/)? $rd->{form_type} : 'E'; 184 $mes->line('9a',$form); 185} 186 187sub add_owner_info 188{ 189 my ($mes,$co)=@_; 190 191 if ($co->srid()) 192 { 193 $mes->line('3x',$co->srid().'-FRNIC'); 194 } else 195 { 196 my $s=$co->street(); 197 Net::DRI::Exception::usererr_insufficient_parameters('1 line of address at least needed if no nichandle') unless ($s && (ref($s) eq 'ARRAY') && @$s && $s->[0]); 198 $mes->line('3b',$s->[0]); 199 $mes->line('3c',$s->[1]) if $s->[1]; 200 $mes->line('3d',$s->[2]) if $s->[2]; 201 Net::DRI::Exception::usererr_insufficient_parameters('city, pc & cc mandatory if no nichandle') unless ($co->city() && $co->pc() && $co->cc()); 202 $mes->line('3e',$co->city()); 203 $mes->line('3f',$co->pc()); 204 $mes->line('3g',uc($co->cc())); 205 Net::DRI::Exception::usererr_insufficient_parameters('voice & email mandatory if no nichandle') unless ($co->voice() && $co->email()); 206 $mes->line('3t',format_tel($co->voice())); 207 $mes->line('3u',format_tel($co->fax())) if $co->fax(); 208 $mes->line('3v',$co->email()); 209 } 210} 211 212sub add_maintainer_disclose 213{ 214 my ($mes,$co,$maintainer)=@_; 215 Net::DRI::Exception::usererr_insufficient_parameters('maintainer mandatory if no nichandle') unless (defined($maintainer) && $maintainer=~m/^[A-Z0-9][-A-Z0-9]+[A-Z0-9]$/i); 216 $mes->line('3y',$maintainer); 217 Net::DRI::Exception::usererr_insufficient_parameters('disclose option is mandatory if no nichandle') unless ($co->disclose()); 218 $mes->line('3z',$co->disclose()); 219} 220 221sub add_admin_contact 222{ 223 my ($mes,$cs)=@_; 224 my $co=$cs->get('admin'); 225 $mes->line('4a',$co->srid().'-FRNIC') if (Net::DRI::Util::isa_contact($co) && $co->srid()); 226} 227 228sub add_tech_contacts 229{ 230 my ($mes,$cs)=@_; 231 my @co=map { $_->srid() } grep { Net::DRI::Util::isa_contact($_) && defined $_->srid() } $cs->get('tech'); 232 Net::DRI::Exception::usererr_insufficient_parameters('at least one technical contact is mandatory') unless @co; 233 $mes->line('5a',$co[0].'-FRNIC'); 234 $mes->line('5c',$co[1].'-FRNIC') if $co[1]; 235 $mes->line('5e',$co[2].'-FRNIC') if $co[2]; 236} 237 238sub add_all_ns 239{ 240 my ($domain,$mes,$ns)=@_; 241 Net::DRI::Exception::usererr_insufficient_parameters('at least 2 nameservers are mandatory') unless (Net::DRI::Util::isa_hosts($ns,'Net::DRI::Data::Hosts') && $ns->count()>=2); 242 243 add_one_ns($mes,$ns,1,$domain,'6a','6b'); 244 add_one_ns($mes,$ns,2,$domain,'7a','7b'); 245 my $nsc=$ns->count(); 246 add_one_ns($mes,$ns,3,$domain,'7c','7d') if ($nsc >= 3); 247 add_one_ns($mes,$ns,4,$domain,'7e','7f') if ($nsc >= 4); 248 add_one_ns($mes,$ns,5,$domain,'7g','7h') if ($nsc >= 5); 249 add_one_ns($mes,$ns,6,$domain,'7i','7j') if ($nsc >= 6); 250 add_one_ns($mes,$ns,7,$domain,'7k','7l') if ($nsc >= 7); 251 add_one_ns($mes,$ns,8,$domain,'7m','7n') if ($nsc >= 8); 252} 253 254sub add_one_ns 255{ 256 my ($mes,$ns,$pos,$domain,$l1,$l2)=@_; 257 my @g=$ns->get_details($pos); 258 return unless @g; 259 $mes->line($l1,$g[0]); ## name 260 return unless ($g[0]=~m/\S+\.${domain}/i || (lc($g[0]) eq lc($domain))); 261 $mes->line($l2,join(' ',@{$g[1]},@{$g[2]})); ## nameserver in domain, we add IPs 262} 263 264sub delete 265{ 266 my ($a,$domain,$rd)=@_; 267 my $mes=$a->message(); 268 269 add_starting_block('S',$domain,$mes,$rd); 270 add_installation($mes,$rd); 271} 272 273sub update 274{ 275 my ($a,$domain,$todo,$rd)=@_; 276 my $mes=$a->message(); 277 278 Net::DRI::Util::check_isa($todo,'Net::DRI::Data::Changes'); 279 280 if ((grep { ! /^(?:ns|contact)/ } $todo->types()) || 281 (grep { ! /^(?:set)$/ } $todo->types('ns')) || 282 (grep { ! /^(?:set)$/ } $todo->types('contact')) 283 ) 284 { 285 Net::DRI::Exception->die(0,'protocol/AFNIC/Email',11,'Only ns/contact set available for domain'); 286 } 287 288 my $ns=$todo->set('ns'); 289 my $cs=$todo->set('contact'); 290 291 my $wc=Net::DRI::Util::isa_contactset($cs); 292 Net::DRI::Exception::usererr_invalid_parameters('can not change both admin & tech contacts at the same time') if ($wc && $cs->has_type('tech') && ($cs->has_type('admin') || $cs->has_type('registrant'))); 293 294 ## Technical change (DNS / Tech contacts) 295 if ($wc && $cs->has_type('tech')) 296 { 297 add_starting_block('T',$domain,$mes); ## no $rd here ! 298 add_tech_contacts($mes,$cs); ## tech contacts mandatory even for only nameserver changes ! 299 add_all_ns($domain,$mes,$ns) if (defined $ns && Net::DRI::Util::isa_hosts($ns,'Net::DRI::Data::Hosts')); 300 add_installation($mes,$rd); 301 return; 302 } 303 304 ## Admin change (Admin contact) 305 if ($wc && ($cs->has_type('admin') || $cs->has_type('registrant'))) 306 { 307 add_starting_block('A',$domain,$mes); 308 my $co=$cs->get('registrant'); 309 if (Net::DRI::Util::isa_contact($co) && $co->legal_form()) ## only for PM 310 { 311 $co->validate(); 312 $mes->line('3a',$co->name()); 313 add_owner_info($mes,$co); 314 } else 315 { 316 my $ca=$cs->get('admin'); 317 Net::DRI::Exception::usererr_insufficient_parameters('contact admin is mandatory for PP admin change') unless (Net::DRI::Util::isa_contact($ca) && $ca->srid()); 318 } 319 add_admin_contact($mes,$cs); 320 add_installation($mes,$rd); 321 return; 322 } 323 324 Net::DRI::Exception::err_assert('We do not know how to handle this kind of update, please report.'); 325} 326 327sub trade 328{ 329 my ($a,$domain,$rd)=@_; 330 my $mes=$a->message(); 331 332 create($a,$domain,$rd); 333 my $type=(Net::DRI::Util::has_key($rd,'trade_type') && $rd->{trade_type}=~m/^[VF]$/)? $rd->{trade_type} : 'V'; 334 335 $mes->line('1a','P'); 336 $mes->line('1h',$type); 337 338 if ($type eq 'F') 339 { 340 Net::DRI::Exception::usererr_insufficient_parameters('authInfo is mandatory') unless Net::DRI::Util::has_auth($rd); 341 $mes->line('2z',$rd->{auth}->{pw}); 342 } 343 344} 345 346sub transfer_request 347{ 348 my ($a,$domain,$rd)=@_; 349 my $mes=$a->message(); 350 351 add_starting_block('D',$domain,$mes,$rd); 352 Net::DRI::Exception::usererr_invalid_parameters() unless (defined($rd) && (ref($rd) eq 'HASH') && keys(%$rd)); 353 Net::DRI::Exception::usererr_insufficient_parameters('contacts are mandatory') unless Net::DRI::Util::has_contact($rd); 354 my $cs=$rd->{contact}; 355 my $co=$cs->get('registrant'); 356 Net::DRI::Exception::usererr_insufficient_parameters('registrant contact is mandatory') unless Net::DRI::Util::isa_contact($co,'Net::DRI::Data::Contact::AFNIC'); 357 $co->validate(); 358 $co->validate_registrant(); 359 360 Net::DRI::Exception::usererr_insufficient_parameters('authInfo is mandatory') unless Net::DRI::Util::has_auth($rd); 361 $mes->line('2z',$rd->{auth}->{pw}); 362 363 if ($co->legal_form()) ## PM 364 { 365 add_company_info($mes,$co); 366 } else ## PP 367 { 368 Net::DRI::Exception::usererr_insufficient_parameters('key mandatory for PP') unless ($co->key()); 369 $mes->line('3q',$co->key()); 370 } 371 372 add_tech_contacts($mes,$cs); ## tech contacts mandatory 373 add_all_ns($domain,$mes,$rd->{ns}) if Net::DRI::Util::has_ns($rd); 374 add_installation($mes,$rd); 375} 376 377#################################################################################################### 3781; 379