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