line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## Domain Registry Interface, EPP NSgroup extension commands |
2
|
|
|
|
|
|
|
## (based on .BE Registration_guidelines_v4_7_1) |
3
|
|
|
|
|
|
|
## |
4
|
|
|
|
|
|
|
## Copyright (c) 2005-2010,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::Protocol::EPP::Extensions::NSgroup; |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
667
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
19
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
18
|
|
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
|
4
|
use Net::DRI::Util; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
13
|
|
22
|
1
|
|
|
1
|
|
3
|
use Net::DRI::Exception; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
849
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=pod |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 NAME |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Net::DRI::Protocol::EPP::Extensions::NSgroup - EPP NSgroup extension commands for Net::DRI |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Please see the README file for details. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SUPPORT |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
For now, support questions should be sent to: |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Enetdri@dotandco.comE |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Please also see the SUPPORT file in the distribution. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 SEE ALSO |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Ehttp://www.dotandco.com/services/software/Net-DRI/E |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 AUTHOR |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Patrick Mevzek, Enetdri@dotandco.comE |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 COPYRIGHT |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Copyright (c) 2005-2010,2013 Patrick Mevzek . |
53
|
|
|
|
|
|
|
All rights reserved. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
56
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
57
|
|
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or |
58
|
|
|
|
|
|
|
(at your option) any later version. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
See the LICENSE file that comes with this distribution for more details. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
#################################################################################################### |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub register_commands |
67
|
|
|
|
|
|
|
{ |
68
|
0
|
|
|
0
|
0
|
|
my ($class,$version)=@_; |
69
|
0
|
|
|
|
|
|
my %tmp1=( create => [ \&create ], |
70
|
|
|
|
|
|
|
check => [ \&check, \&check_parse ], |
71
|
|
|
|
|
|
|
info => [ \&info, \&info_parse ], |
72
|
|
|
|
|
|
|
delete => [ \&delete ], |
73
|
|
|
|
|
|
|
update => [ \&update ], |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
0
|
|
|
|
|
|
$tmp1{check_multi}=$tmp1{check}; |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
return { 'nsgroup' => \%tmp1 }; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
0
|
0
|
|
sub capabilities_add { return ('nsgroup_update','ns',['set']); } |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub ns |
84
|
|
|
|
|
|
|
{ |
85
|
0
|
|
|
0
|
0
|
|
my ($mes)=@_; |
86
|
0
|
|
|
|
|
|
my $ns=$mes->ns('nsgroup'); |
87
|
0
|
0
|
|
|
|
|
return defined $ns? $ns : 'http://www.dns.be/xml/epp/nsgroup-1.0'; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub build_command |
91
|
|
|
|
|
|
|
{ |
92
|
0
|
|
|
0
|
0
|
|
my ($epp,$msg,$command,$hosts)=@_; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
my @gn; |
95
|
0
|
0
|
|
|
|
|
foreach my $h ( grep { defined } (ref $hosts eq 'ARRAY')? @$hosts : ($hosts)) |
|
0
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
{ |
97
|
0
|
0
|
|
|
|
|
my $gn=Net::DRI::Util::isa_nsgroup($h)? $h->name() : $h; |
98
|
0
|
0
|
0
|
|
|
|
Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid NSgroup name: '.$gn) unless (defined $gn && $gn && ! ref $gn && Net::DRI::Util::xml_is_normalizedstring($gn,1,100)); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
99
|
0
|
|
|
|
|
|
push @gn,$gn; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
0
|
0
|
|
|
|
|
Net::DRI::Exception->die(1,'protocol/EPP',2,'NSgroup name needed') unless @gn; |
103
|
0
|
|
|
|
|
|
$msg->command([$command,'nsgroup:'.$command,sprintf('xmlns:nsgroup="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('nsgroup'))]); |
104
|
0
|
|
|
|
|
|
return map { ['nsgroup:name',$_] } @gn; |
|
0
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub add_nsname |
108
|
|
|
|
|
|
|
{ |
109
|
0
|
|
|
0
|
0
|
|
my ($ns)=@_; |
110
|
0
|
0
|
|
|
|
|
return () unless defined $ns; |
111
|
0
|
|
|
|
|
|
my @names; |
112
|
0
|
0
|
|
|
|
|
if (! ref $ns) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
113
|
|
|
|
|
|
|
{ |
114
|
0
|
|
|
|
|
|
@names=($ns); |
115
|
|
|
|
|
|
|
} elsif (ref $ns eq 'ARRAY') |
116
|
|
|
|
|
|
|
{ |
117
|
0
|
|
|
|
|
|
@names=@$ns; |
118
|
|
|
|
|
|
|
} elsif (Net::DRI::Util::isa_nsgroup($ns)) |
119
|
|
|
|
|
|
|
{ |
120
|
0
|
|
|
|
|
|
@names=$ns->get_names(); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
foreach my $n (@names) |
124
|
|
|
|
|
|
|
{ |
125
|
0
|
0
|
|
|
|
|
next if Net::DRI::Util::is_hostname($n); |
126
|
0
|
|
|
|
|
|
Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid host name: '.$n); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
return map { ['nsgroup:ns',$_] } @names; |
|
0
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#################################################################################################### |
133
|
|
|
|
|
|
|
########### Query commands |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub check |
136
|
|
|
|
|
|
|
{ |
137
|
0
|
|
|
0
|
0
|
|
my ($epp,@hosts)=@_; |
138
|
0
|
|
|
|
|
|
my $mes=$epp->message(); |
139
|
0
|
|
|
|
|
|
my @d=build_command($epp,$mes,'check',\@hosts); |
140
|
0
|
|
|
|
|
|
$mes->command_body(\@d); |
141
|
0
|
|
|
|
|
|
return; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub check_parse |
145
|
|
|
|
|
|
|
{ |
146
|
0
|
|
|
0
|
0
|
|
my ($po,$otype,$oaction,$oname,$rinfo)=@_; |
147
|
0
|
|
|
|
|
|
my $mes=$po->message(); |
148
|
0
|
0
|
|
|
|
|
return unless $mes->is_success(); |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
my $ns=$mes->ns('nsgroup'); |
151
|
0
|
|
|
|
|
|
my $chkdata=$mes->get_response($ns,'chkData'); |
152
|
0
|
0
|
|
|
|
|
return unless defined $chkdata; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
foreach my $cd ($chkdata->getChildrenByTagNameNS($ns,'cd')) |
155
|
|
|
|
|
|
|
{ |
156
|
0
|
|
|
|
|
|
my $nsgroup; |
157
|
0
|
|
|
|
|
|
foreach my $el (Net::DRI::Util::xml_list_children($cd)) |
158
|
|
|
|
|
|
|
{ |
159
|
0
|
|
|
|
|
|
my ($n,$c)=@$el; |
160
|
0
|
0
|
|
|
|
|
if ($n eq 'name') |
161
|
|
|
|
|
|
|
{ |
162
|
0
|
|
|
|
|
|
$nsgroup=$c->textContent(); |
163
|
0
|
|
|
|
|
|
$rinfo->{nsgroup}->{$nsgroup}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail')); |
164
|
0
|
|
|
|
|
|
$rinfo->{nsgroup}->{$nsgroup}->{action}='check'; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
0
|
|
|
|
|
|
return; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub info |
172
|
|
|
|
|
|
|
{ |
173
|
0
|
|
|
0
|
0
|
|
my ($epp,$hosts)=@_; |
174
|
0
|
|
|
|
|
|
my $mes=$epp->message(); |
175
|
0
|
|
|
|
|
|
my @d=build_command($epp,$mes,'info',$hosts); |
176
|
0
|
|
|
|
|
|
$mes->command_body(\@d); |
177
|
0
|
|
|
|
|
|
return; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub info_parse |
181
|
|
|
|
|
|
|
{ |
182
|
0
|
|
|
0
|
0
|
|
my ($po,$otype,$oaction,$oname,$rinfo)=@_; |
183
|
0
|
|
|
|
|
|
my $mes=$po->message(); |
184
|
0
|
0
|
|
|
|
|
return unless $mes->is_success(); |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
my $infdata=$mes->get_response($mes->ns('nsgroup'),'infData'); |
187
|
0
|
0
|
|
|
|
|
return unless defined $infdata; |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
my $ns=$po->create_local_object('hosts'); |
190
|
0
|
|
|
|
|
|
foreach my $el (Net::DRI::Util::xml_list_children($infdata)) |
191
|
|
|
|
|
|
|
{ |
192
|
0
|
|
|
|
|
|
my ($name,$c)=@$el; |
193
|
0
|
0
|
|
|
|
|
if ($name eq 'name') |
|
|
0
|
|
|
|
|
|
194
|
|
|
|
|
|
|
{ |
195
|
0
|
|
|
|
|
|
$oname=$c->textContent(); |
196
|
0
|
|
|
|
|
|
$ns->name($oname); |
197
|
0
|
|
|
|
|
|
$rinfo->{nsgroup}->{$oname}->{exist}=1; |
198
|
0
|
|
|
|
|
|
$rinfo->{nsgroup}->{$oname}->{action}='info'; |
199
|
|
|
|
|
|
|
} elsif ($name eq 'ns') |
200
|
|
|
|
|
|
|
{ |
201
|
0
|
|
|
|
|
|
$ns->add($c->textContent()); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
$rinfo->{nsgroup}->{$oname}->{self}=$ns; |
206
|
0
|
|
|
|
|
|
return; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
############ Transform commands |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub create |
212
|
|
|
|
|
|
|
{ |
213
|
0
|
|
|
0
|
0
|
|
my ($epp,$hosts)=@_; |
214
|
0
|
|
|
|
|
|
my $mes=$epp->message(); |
215
|
0
|
|
|
|
|
|
my @d=build_command($epp,$mes,'create',$hosts); |
216
|
0
|
|
|
|
|
|
push @d,add_nsname($hosts); |
217
|
0
|
|
|
|
|
|
$mes->command_body(\@d); |
218
|
0
|
|
|
|
|
|
return; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms) |
222
|
|
|
|
|
|
|
{ |
223
|
0
|
|
|
0
|
0
|
|
my ($epp,$hosts)=@_; |
224
|
0
|
|
|
|
|
|
my $mes=$epp->message(); |
225
|
0
|
|
|
|
|
|
my @d=build_command($epp,$mes,'delete',$hosts); |
226
|
0
|
|
|
|
|
|
$mes->command_body(\@d); |
227
|
0
|
|
|
|
|
|
return; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub update |
231
|
|
|
|
|
|
|
{ |
232
|
0
|
|
|
0
|
0
|
|
my ($epp,$hosts,$todo)=@_; |
233
|
0
|
|
|
|
|
|
my $mes=$epp->message(); |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
|
Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo); |
236
|
|
|
|
|
|
|
|
237
|
0
|
0
|
0
|
|
|
|
if ((grep { ! /^(?:ns)$/ } $todo->types()) || (grep { ! /^(?:set)$/ } $todo->types('ns') )) |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
{ |
239
|
0
|
|
|
|
|
|
Net::DRI::Exception->die(0,'protocol/EPP',11,'Only ns set available for nsgroup'); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
my $ns=$todo->set('ns'); |
243
|
0
|
|
|
|
|
|
my @d=build_command($epp,$mes,'update',$hosts); |
244
|
0
|
|
|
|
|
|
push @d,add_nsname($ns); |
245
|
0
|
|
|
|
|
|
$mes->command_body(\@d); |
246
|
0
|
|
|
|
|
|
return; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
#################################################################################################### |
250
|
|
|
|
|
|
|
1; |