line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SRS::EPP::Command::Update::Domain; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$SRS::EPP::Command::Update::Domain::VERSION = '0.22'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
3773
|
use Moose; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
7
|
|
|
|
|
|
|
extends 'SRS::EPP::Command::Update'; |
8
|
|
|
|
|
|
|
with 'SRS::EPP::Common::Domain::NameServers'; |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
7576
|
use MooseX::Params::Validate; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
13
|
|
11
|
1
|
|
|
1
|
|
967
|
use XML::SRS::Server; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use XML::SRS::Server::List; |
13
|
|
|
|
|
|
|
use XML::SRS::DS; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# List of statuses the user is allowed to add or remove |
16
|
|
|
|
|
|
|
my @ALLOWED_STATUSES = qw(clientHold); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $allowed = { |
19
|
|
|
|
|
|
|
action => { |
20
|
|
|
|
|
|
|
add => 1, |
21
|
|
|
|
|
|
|
remove => 1, |
22
|
|
|
|
|
|
|
}, |
23
|
|
|
|
|
|
|
}; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# for plugin system to connect |
26
|
|
|
|
|
|
|
sub xmlns { |
27
|
|
|
|
|
|
|
return XML::EPP::Domain::Node::xmlns(); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has 'state' => ( |
31
|
|
|
|
|
|
|
'is' => 'rw', |
32
|
|
|
|
|
|
|
'isa' => 'Str', |
33
|
|
|
|
|
|
|
'default' => 'EPP-DomainUpdate' |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has 'status_changes' => ( |
37
|
|
|
|
|
|
|
'is' => 'rw', |
38
|
|
|
|
|
|
|
'isa' => 'HashRef', |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
has 'contact_changes' => ( |
42
|
|
|
|
|
|
|
'is' => 'rw', |
43
|
|
|
|
|
|
|
'isa' => 'HashRef', |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
has 'dnssec_changes' => ( |
47
|
|
|
|
|
|
|
'is' => 'rw', |
48
|
|
|
|
|
|
|
'isa' => 'HashRef', |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# we only ever enter here once, so we know what state we're in |
52
|
|
|
|
|
|
|
sub process { |
53
|
|
|
|
|
|
|
my $self = shift; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my ( $session ) = pos_validated_list( |
56
|
|
|
|
|
|
|
\@_, |
57
|
|
|
|
|
|
|
{ isa => 'SRS::EPP::Session' }, |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
$self->session($session); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $epp = $self->message; |
63
|
|
|
|
|
|
|
my $message = $epp->message; |
64
|
|
|
|
|
|
|
my $payload = $message->argument->payload; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# firstly check that we have at least one of add, rem and chg |
67
|
|
|
|
|
|
|
unless ( $payload->add or $payload->remove or $payload->change or $message->extension ) { |
68
|
|
|
|
|
|
|
return $self->make_error( |
69
|
|
|
|
|
|
|
code => 2002, |
70
|
|
|
|
|
|
|
message => 'Incomplete request, expecting add, rem, chg or extension element', |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Validate statuses supplied (if any) |
75
|
|
|
|
|
|
|
my %statuses = ( |
76
|
|
|
|
|
|
|
($payload->add ? (add => $payload->add->status) : ()), |
77
|
|
|
|
|
|
|
($payload->remove ? (remove => $payload->remove->status) : ()), |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
my %allowed_statuses = map { $_ => 1 } @ALLOWED_STATUSES; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
my %used; |
83
|
|
|
|
|
|
|
foreach my $key (keys %statuses) { |
84
|
|
|
|
|
|
|
foreach my $status (@{$statuses{$key}}) { |
85
|
|
|
|
|
|
|
unless ($allowed_statuses{$status->status}) { |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# They supplied a status that's not allowed |
88
|
|
|
|
|
|
|
return $self->make_error( |
89
|
|
|
|
|
|
|
code => 2307, |
90
|
|
|
|
|
|
|
value => $status->status, |
91
|
|
|
|
|
|
|
reason => |
92
|
|
|
|
|
|
|
'Adding or removing this status is not allowed', |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
if ($used{$status->status}) { |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# They've added and removed the same |
99
|
|
|
|
|
|
|
# status. Throw an error |
100
|
|
|
|
|
|
|
return $self->make_error( |
101
|
|
|
|
|
|
|
code => 2002, |
102
|
|
|
|
|
|
|
value => $status->status, |
103
|
|
|
|
|
|
|
reason => |
104
|
|
|
|
|
|
|
'Cannot add and remove the same status', |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$used{$status->status} = 1; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
$self->status_changes(\%statuses); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# In some cases, we need to do a DomainDetailsQry before the update |
115
|
|
|
|
|
|
|
my %ddq_fields; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# if they want to add/remove a nameserver, then we need to hit the SRS |
118
|
|
|
|
|
|
|
# first to find out what they are currently set to |
119
|
|
|
|
|
|
|
if ( |
120
|
|
|
|
|
|
|
( $payload->add and $payload->add->ns ) |
121
|
|
|
|
|
|
|
or ( $payload->remove and $payload->remove->ns ) |
122
|
|
|
|
|
|
|
) |
123
|
|
|
|
|
|
|
{ |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
$ddq_fields{name_servers} = 1; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# If they've added or removed contacts, we also need to do a ddq |
129
|
|
|
|
|
|
|
# to make sure they've added or removed the correct contacts |
130
|
|
|
|
|
|
|
# We also validate that contact data they've sent here |
131
|
|
|
|
|
|
|
if ( |
132
|
|
|
|
|
|
|
$payload->add && $payload->add->contact |
133
|
|
|
|
|
|
|
|| $payload->remove && $payload->remove->contact |
134
|
|
|
|
|
|
|
) |
135
|
|
|
|
|
|
|
{ |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my $result = $self->check_contacts($payload); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
return $result if blessed $result && $result->isa('SRS::EPP::Response::Error'); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
%ddq_fields = (%ddq_fields, %{ $result }); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# Handle DNS sec changes |
146
|
|
|
|
|
|
|
if ($message->extension) { |
147
|
|
|
|
|
|
|
foreach my $ext_obj (@{ $message->extension->ext_objs }) { |
148
|
|
|
|
|
|
|
if ($ext_obj->isa('XML::EPP::DNSSEC::Update')) { |
149
|
|
|
|
|
|
|
my $result = $self->check_dnssec($ext_obj); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
return $result if blessed $result && $result->isa('SRS::EPP::Response::Error'); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
%ddq_fields = (%ddq_fields, %{ $result }); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
if (%ddq_fields) { |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# remember the fact that we're doing a domain details |
161
|
|
|
|
|
|
|
# query first |
162
|
|
|
|
|
|
|
$self->state('SRS-DomainDetailsQry'); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# two stages = stall. |
165
|
|
|
|
|
|
|
$self->session->stalled($self); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# need to do a DomainDetailsQry |
168
|
|
|
|
|
|
|
return XML::SRS::Domain::Query->new( |
169
|
|
|
|
|
|
|
domain_name_filter => $payload->name, |
170
|
|
|
|
|
|
|
field_list => XML::SRS::FieldList->new( |
171
|
|
|
|
|
|
|
\%ddq_fields, |
172
|
|
|
|
|
|
|
), |
173
|
|
|
|
|
|
|
); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# ok, we have all the info we need, so create the request |
177
|
|
|
|
|
|
|
my $request = $self->make_request($message, $payload); |
178
|
|
|
|
|
|
|
$self->state('SRS-DomainUpdate'); |
179
|
|
|
|
|
|
|
return $request; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub notify{ |
183
|
|
|
|
|
|
|
my $self = shift; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my ( $rs ) = pos_validated_list( |
186
|
|
|
|
|
|
|
\@_, |
187
|
|
|
|
|
|
|
{ isa => 'ArrayRef[SRS::EPP::SRSResponse]' }, |
188
|
|
|
|
|
|
|
); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# original payload |
191
|
|
|
|
|
|
|
my $epp = $self->message; |
192
|
|
|
|
|
|
|
my $message = $epp->message; |
193
|
|
|
|
|
|
|
my $payload = $message->argument->payload; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# response from SRS (either a DomainDetailsQry or a DomainUpdate) |
196
|
|
|
|
|
|
|
my $res = $rs->[0]->message->response; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
if ( $self->state eq 'SRS-DomainDetailsQry' ) { |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# restart the processing pipeline |
201
|
|
|
|
|
|
|
$self->session->stalled(0); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# If no response returned, they must not own this domain |
204
|
|
|
|
|
|
|
unless ($res) { |
205
|
|
|
|
|
|
|
return $self->make_response( |
206
|
|
|
|
|
|
|
code => 2303, |
207
|
|
|
|
|
|
|
); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Check if the contacts added or removed are correct |
211
|
|
|
|
|
|
|
if (my $cc = $self->contact_changes) { |
212
|
|
|
|
|
|
|
foreach my $contact_type (qw/admin tech/) { |
213
|
|
|
|
|
|
|
my $long_type = $contact_type eq 'tech' |
214
|
|
|
|
|
|
|
? 'technical' : $contact_type; |
215
|
|
|
|
|
|
|
my $method = 'contact_' . $long_type; |
216
|
|
|
|
|
|
|
my $existing_contact = $res->$method; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $contact_removed = |
219
|
|
|
|
|
|
|
$cc->{$contact_type}{remove}[0]; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Throw an error if they're removing a |
222
|
|
|
|
|
|
|
# contact that doesn't exist |
223
|
|
|
|
|
|
|
if ( |
224
|
|
|
|
|
|
|
$contact_removed |
225
|
|
|
|
|
|
|
&& |
226
|
|
|
|
|
|
|
( |
227
|
|
|
|
|
|
|
!$existing_contact |
228
|
|
|
|
|
|
|
|| |
229
|
|
|
|
|
|
|
$existing_contact->handle_id |
230
|
|
|
|
|
|
|
ne $contact_removed->value |
231
|
|
|
|
|
|
|
) |
232
|
|
|
|
|
|
|
) |
233
|
|
|
|
|
|
|
{ |
234
|
|
|
|
|
|
|
return $self->make_error( |
235
|
|
|
|
|
|
|
code => 2002, |
236
|
|
|
|
|
|
|
value => |
237
|
|
|
|
|
|
|
$contact_removed->value || '', |
238
|
|
|
|
|
|
|
reason => |
239
|
|
|
|
|
|
|
"Attempting to remove $contact_type contact which does not exist on the domain", |
240
|
|
|
|
|
|
|
); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# If they're adding a contact, but one |
244
|
|
|
|
|
|
|
# already exists (which hasn't been |
245
|
|
|
|
|
|
|
# removed), throw an error |
246
|
|
|
|
|
|
|
my $contact_added = |
247
|
|
|
|
|
|
|
$cc->{$contact_type}{add}[0]; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
if ( |
250
|
|
|
|
|
|
|
$contact_added |
251
|
|
|
|
|
|
|
&& $existing_contact |
252
|
|
|
|
|
|
|
&& !$contact_removed |
253
|
|
|
|
|
|
|
) |
254
|
|
|
|
|
|
|
{ |
255
|
|
|
|
|
|
|
return $self->make_error( |
256
|
|
|
|
|
|
|
code => 2306, |
257
|
|
|
|
|
|
|
value => '', |
258
|
|
|
|
|
|
|
reason => |
259
|
|
|
|
|
|
|
"Only one $contact_type contact per domain supported", |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
my @dnssec_update; |
266
|
|
|
|
|
|
|
if (my $dnssec_changes = $self->dnssec_changes) { |
267
|
|
|
|
|
|
|
my @existing_ds = (); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
unless ($dnssec_changes->{remove_all}) { |
270
|
|
|
|
|
|
|
@existing_ds = @{ $res->dns_sec->ds_list } if $res->dns_sec && $res->dns_sec->ds_list; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# Translate changes to SRS DS objects |
273
|
|
|
|
|
|
|
for my $action (keys %$dnssec_changes) { |
274
|
|
|
|
|
|
|
next if $action eq 'remove_all'; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
$dnssec_changes->{$action} = |
277
|
|
|
|
|
|
|
[ map { $self->_translate_ds_epp_to_srs($_) } @{$dnssec_changes->{$action}} ]; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Check if removes were correct |
281
|
|
|
|
|
|
|
foreach my $ds_to_rem (@{ $dnssec_changes->{remove} }) { |
282
|
|
|
|
|
|
|
my $found = 0; |
283
|
|
|
|
|
|
|
foreach my $existing_ds (@existing_ds) { |
284
|
|
|
|
|
|
|
next unless $ds_to_rem->is_equal($existing_ds); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
$found = 1; |
287
|
|
|
|
|
|
|
last; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
unless ($found) { |
291
|
|
|
|
|
|
|
return $self->make_error( |
292
|
|
|
|
|
|
|
code => 2002, |
293
|
|
|
|
|
|
|
value => |
294
|
|
|
|
|
|
|
$ds_to_rem->digest, |
295
|
|
|
|
|
|
|
reason => |
296
|
|
|
|
|
|
|
"Attempting to remove a DS record that does not exist on this domain", |
297
|
|
|
|
|
|
|
); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# We can now remove from the existing list |
301
|
|
|
|
|
|
|
@existing_ds = grep { ! $_->is_equal($ds_to_rem) } @existing_ds; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# The list of ds records to keep is the existing list, minus removals, plus additions |
306
|
|
|
|
|
|
|
@dnssec_update = (@existing_ds, @{ $dnssec_changes->{add} || [] }); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my %nservers; |
310
|
|
|
|
|
|
|
if ($res->nameservers) { |
311
|
|
|
|
|
|
|
foreach my $ns (@{$res->nameservers->nameservers} ) { |
312
|
|
|
|
|
|
|
$nservers{$ns->fqdn} = |
313
|
|
|
|
|
|
|
$self->translate_ns_srs_to_epp($ns); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# check what the user wants to do (it's either |
318
|
|
|
|
|
|
|
# an add, rem or both) do the add first |
319
|
|
|
|
|
|
|
if ( $payload->add and $payload->add->ns ) { |
320
|
|
|
|
|
|
|
my $add_ns = $payload->add->ns->ns; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# loop through and add them |
323
|
|
|
|
|
|
|
foreach my $ns (@$add_ns) { |
324
|
|
|
|
|
|
|
$nservers{$ns->name} = $ns; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# now do the remove, being careful to ignore the case of the NS |
329
|
|
|
|
|
|
|
if ( $payload->remove and $payload->remove->ns ) { |
330
|
|
|
|
|
|
|
my $rem_ns = $payload->remove->ns->ns; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# loop through and remove them |
333
|
|
|
|
|
|
|
foreach my $ns (@$rem_ns) { |
334
|
|
|
|
|
|
|
for my $existing ( keys %nservers ) { |
335
|
|
|
|
|
|
|
if ( lc($ns->name) eq lc($existing) ) { |
336
|
|
|
|
|
|
|
delete $nservers{$existing}; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my @ns_list = values %nservers; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# so far all is good, now send the DomainUpdate |
345
|
|
|
|
|
|
|
# request to the SRS |
346
|
|
|
|
|
|
|
my $request = $self->make_request( |
347
|
|
|
|
|
|
|
$message, $payload, \@ns_list, \@dnssec_update |
348
|
|
|
|
|
|
|
); |
349
|
|
|
|
|
|
|
$self->state('SRS-DomainUpdate'); |
350
|
|
|
|
|
|
|
return $request; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
elsif ( $self->state eq 'SRS-DomainUpdate' ) { |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# if we get no response, then it's likely the domain |
355
|
|
|
|
|
|
|
# name doesn't exist ie. the DomainNameFilter didn't |
356
|
|
|
|
|
|
|
# match anything |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
unless ( defined $res ) { |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# Object does not exist |
361
|
|
|
|
|
|
|
return $self->make_response( |
362
|
|
|
|
|
|
|
code => 2303, |
363
|
|
|
|
|
|
|
); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# everything looks ok, so let's return a successful message |
367
|
|
|
|
|
|
|
return $self->make_response( |
368
|
|
|
|
|
|
|
code => 1000, |
369
|
|
|
|
|
|
|
); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
sub make_request { |
374
|
|
|
|
|
|
|
my $self = shift; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
my ( $message, $payload, $new_nameservers, $new_ds_records ) = pos_validated_list( |
377
|
|
|
|
|
|
|
\@_, |
378
|
|
|
|
|
|
|
{ }, |
379
|
|
|
|
|
|
|
{ }, |
380
|
|
|
|
|
|
|
{ isa => 'ArrayRef', optional => 1 }, |
381
|
|
|
|
|
|
|
{ isa => 'ArrayRef', optional => 1 }, |
382
|
|
|
|
|
|
|
); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# the first thing we're going to check for is a change to the |
385
|
|
|
|
|
|
|
# registrant |
386
|
|
|
|
|
|
|
my %contacts; |
387
|
|
|
|
|
|
|
if ( $payload->change ) { |
388
|
|
|
|
|
|
|
if ( my $registrant = $payload->change->registrant ) { |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# changing the registrant, so let's remember that |
391
|
|
|
|
|
|
|
$contacts{contact_registrant} = |
392
|
|
|
|
|
|
|
_make_contact($registrant); |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Get the contacts (if any) |
397
|
|
|
|
|
|
|
for my $contact (qw/admin technical/) { |
398
|
|
|
|
|
|
|
my $contact_new = _extract_contact( |
399
|
|
|
|
|
|
|
$payload, 'add', $contact, |
400
|
|
|
|
|
|
|
); |
401
|
|
|
|
|
|
|
my $contact_old = _extract_contact( |
402
|
|
|
|
|
|
|
$payload, 'remove', $contact, |
403
|
|
|
|
|
|
|
); |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
my $new_contact = _make_contact( |
406
|
|
|
|
|
|
|
$contact_new, $contact_old, |
407
|
|
|
|
|
|
|
); |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
$contacts{'contact_' . $contact} = $new_contact |
410
|
|
|
|
|
|
|
if defined $new_contact; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# now set the nameserver list |
414
|
|
|
|
|
|
|
my $ns_list; |
415
|
|
|
|
|
|
|
if ( defined $new_nameservers and @$new_nameservers ) { |
416
|
|
|
|
|
|
|
my @ns_objs = eval { |
417
|
|
|
|
|
|
|
$self->translate_ns_epp_to_srs(@$new_nameservers); |
418
|
|
|
|
|
|
|
}; |
419
|
|
|
|
|
|
|
my $error = $@; |
420
|
|
|
|
|
|
|
if ($error) { |
421
|
|
|
|
|
|
|
return $error |
422
|
|
|
|
|
|
|
if $error->isa('SRS::EPP::Response::Error'); |
423
|
|
|
|
|
|
|
die $error; # rethrow |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
$ns_list = XML::SRS::Server::List->new( |
426
|
|
|
|
|
|
|
nameservers => \@ns_objs, |
427
|
|
|
|
|
|
|
); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
my $request = XML::SRS::Domain::Update->new( |
431
|
|
|
|
|
|
|
filter => [ $payload->name() ], |
432
|
|
|
|
|
|
|
%contacts, |
433
|
|
|
|
|
|
|
( $ns_list ? ( nameservers => $ns_list ) : () ), |
434
|
|
|
|
|
|
|
action_id => $self->client_id || $self->server_id, |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Always uncancel domains when updating. This should |
437
|
|
|
|
|
|
|
# (theoretically) have no affect on active |
438
|
|
|
|
|
|
|
# domains. For pending release domains, this is the |
439
|
|
|
|
|
|
|
# only way they can be uncancelled via EPP (since this |
440
|
|
|
|
|
|
|
# is not supported without an extension). |
441
|
|
|
|
|
|
|
cancel => 0, |
442
|
|
|
|
|
|
|
); |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# Do we need to set or clear Delegate flag? |
445
|
|
|
|
|
|
|
my $status_changes = $self->status_changes; |
446
|
|
|
|
|
|
|
if ($status_changes) { |
447
|
|
|
|
|
|
|
if ( |
448
|
|
|
|
|
|
|
$status_changes->{add} |
449
|
|
|
|
|
|
|
&& |
450
|
|
|
|
|
|
|
grep { $_->status eq 'clientHold' } |
451
|
|
|
|
|
|
|
@{$status_changes->{add}} |
452
|
|
|
|
|
|
|
) |
453
|
|
|
|
|
|
|
{ |
454
|
|
|
|
|
|
|
$request->delegate(0); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
elsif ( |
457
|
|
|
|
|
|
|
$status_changes->{remove} |
458
|
|
|
|
|
|
|
&& |
459
|
|
|
|
|
|
|
grep { $_->status eq 'clientHold' } |
460
|
|
|
|
|
|
|
@{$status_changes->{remove}} |
461
|
|
|
|
|
|
|
) |
462
|
|
|
|
|
|
|
{ |
463
|
|
|
|
|
|
|
$request->delegate(1); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Have we been asked to get a new UDAI? |
468
|
|
|
|
|
|
|
if ( $payload->change() ) { |
469
|
|
|
|
|
|
|
if ( $payload->change()->auth_info() ) { |
470
|
|
|
|
|
|
|
$request->new_udai(1); |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# Add ds record changes, if any |
475
|
|
|
|
|
|
|
$request->dns_sec($new_ds_records) if $new_ds_records; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
return $request; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# Check the contacts on a request, make sure they are valid, |
481
|
|
|
|
|
|
|
# (returning a SRS::EPP::Response::Error if not), store |
482
|
|
|
|
|
|
|
# the changes for later use, and return a hashref indicating |
483
|
|
|
|
|
|
|
# which contacts need to be queried before the update can be performed |
484
|
|
|
|
|
|
|
sub check_contacts { |
485
|
|
|
|
|
|
|
my $self = shift; |
486
|
|
|
|
|
|
|
my $payload = shift; |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
my %contact_changes = (); |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
my %epp_contacts = ( |
491
|
|
|
|
|
|
|
add => [$payload->add && $payload->add->contact ? @{$payload->add->contact} : ()], |
492
|
|
|
|
|
|
|
remove => [$payload->remove && $payload->remove->contact ? @{$payload->remove->contact} : ()], |
493
|
|
|
|
|
|
|
); |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Firstly check only contacts of type 'admin' or 'tech' |
496
|
|
|
|
|
|
|
# were requested. |
497
|
|
|
|
|
|
|
foreach my $action (keys %epp_contacts) { |
498
|
|
|
|
|
|
|
if (grep { $_->type ne 'admin' && $_->type ne 'tech' } @{$epp_contacts{$action}}) { |
499
|
|
|
|
|
|
|
return $self->make_error( |
500
|
|
|
|
|
|
|
code => 2102, |
501
|
|
|
|
|
|
|
message => "Only contacts of type 'admin' or 'tech' are supported", |
502
|
|
|
|
|
|
|
); |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
for my $contact_type (qw/admin tech/) { |
507
|
|
|
|
|
|
|
for my $action (qw/add remove/) { |
508
|
|
|
|
|
|
|
my @contacts; |
509
|
|
|
|
|
|
|
@contacts = grep { |
510
|
|
|
|
|
|
|
$_->type eq $contact_type |
511
|
|
|
|
|
|
|
} @{$epp_contacts{$action}}; |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
$contact_changes{$contact_type}{$action} |
514
|
|
|
|
|
|
|
= \@contacts; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
$self->contact_changes(\%contact_changes); |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
my %queries_needed; |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
for my $contact_type (keys %contact_changes) { |
523
|
|
|
|
|
|
|
my %changes = %{$contact_changes{$contact_type}}; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
next unless %changes; |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# Check they're not adding or removing more than |
528
|
|
|
|
|
|
|
# one contact of the same type |
529
|
|
|
|
|
|
|
for my $action (keys %changes) { |
530
|
|
|
|
|
|
|
if (scalar @{$changes{$action}} > 1) { |
531
|
|
|
|
|
|
|
return $self->make_error( |
532
|
|
|
|
|
|
|
code => 2306, |
533
|
|
|
|
|
|
|
value => '', |
534
|
|
|
|
|
|
|
reason => |
535
|
|
|
|
|
|
|
"Only one $contact_type contact per domain supported", |
536
|
|
|
|
|
|
|
); |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# The only valid actions are to remove, or add |
541
|
|
|
|
|
|
|
# & remove. An add on its own is invalid |
542
|
|
|
|
|
|
|
# (because there's always a default) so |
543
|
|
|
|
|
|
|
# reject it |
544
|
|
|
|
|
|
|
if (@{$changes{add}} && !@{$changes{remove}}) { |
545
|
|
|
|
|
|
|
return $self->make_error( |
546
|
|
|
|
|
|
|
code => 2306, |
547
|
|
|
|
|
|
|
value => '', |
548
|
|
|
|
|
|
|
reason => |
549
|
|
|
|
|
|
|
"Only one $contact_type contact per domain supported", |
550
|
|
|
|
|
|
|
); |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
# We have some changes to this contact type, |
554
|
|
|
|
|
|
|
# so we need to request it in the ddq |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
my $long_type = $contact_type eq 'tech' |
557
|
|
|
|
|
|
|
? 'technical' : $contact_type; |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
$queries_needed{$long_type . '_contact'} = 1; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
return \%queries_needed; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub check_dnssec { |
566
|
|
|
|
|
|
|
my $self = shift; |
567
|
|
|
|
|
|
|
my $update = shift; |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# Reject chg element - it only contains maxSigLife, which we don't support |
570
|
|
|
|
|
|
|
if ($update->chg) { |
571
|
|
|
|
|
|
|
return $self->make_error( |
572
|
|
|
|
|
|
|
code => 2306, |
573
|
|
|
|
|
|
|
message => "maxSigLife element not supported", |
574
|
|
|
|
|
|
|
); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
# keyData elements rejected |
578
|
|
|
|
|
|
|
if ($update->add && $update->add->key_data || |
579
|
|
|
|
|
|
|
$update->rem && $update->rem->key_data) { |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
return $self->make_error( |
582
|
|
|
|
|
|
|
code => 2306, |
583
|
|
|
|
|
|
|
message => "keyData not supported", |
584
|
|
|
|
|
|
|
); |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Must add or remove something |
588
|
|
|
|
|
|
|
unless ($update->add || $update->rem) { |
589
|
|
|
|
|
|
|
return $self->make_error( |
590
|
|
|
|
|
|
|
code => 2003, |
591
|
|
|
|
|
|
|
message => "No dsData to add or remove", |
592
|
|
|
|
|
|
|
); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
my %dnssec_changes; |
596
|
|
|
|
|
|
|
my %query_required; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
$dnssec_changes{remove_all} = $update->rem && $update->rem->all && $update->rem->all eq 'true' ? 1 : 0; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
if ($update->rem && ! $dnssec_changes{remove_all}) { |
601
|
|
|
|
|
|
|
$dnssec_changes{remove} = $update->rem->ds_data; |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
if ($update->add) { |
605
|
|
|
|
|
|
|
$dnssec_changes{add} = $update->add->ds_data; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# We could avoid a query if they're removing all, but this ends up |
609
|
|
|
|
|
|
|
# complicating everything else a fair bit |
610
|
|
|
|
|
|
|
$query_required{dns_sec} = 1; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
$self->dnssec_changes(\%dnssec_changes); |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
return \%query_required; |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub _make_contact { |
620
|
|
|
|
|
|
|
my ($new, $old) = @_; |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# if we have a new contact, replace it (independent of $old) |
623
|
|
|
|
|
|
|
return XML::SRS::Contact->new( handle_id => $new ) |
624
|
|
|
|
|
|
|
if $new; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# return an empty contact element so that the handle gets deleted |
627
|
|
|
|
|
|
|
return XML::SRS::Contact->new() |
628
|
|
|
|
|
|
|
if $old; |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
# if neither of the above, there is nothing to do |
631
|
|
|
|
|
|
|
return; |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
sub _extract_contact { |
635
|
|
|
|
|
|
|
my ($payload, $action, $type ) = @_; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# check the input |
638
|
|
|
|
|
|
|
die q{Program error: '$action' should be 'add' or 'remove'} |
639
|
|
|
|
|
|
|
unless $allowed->{action}{$action}; |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
$type = 'tech' if $type eq 'technical'; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# check that action is there |
644
|
|
|
|
|
|
|
return unless $payload->$action; |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
my $contacts = $payload->$action->contact; |
647
|
|
|
|
|
|
|
foreach my $c (@$contacts) { |
648
|
|
|
|
|
|
|
return $c->value if $c->type eq $type; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
return; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub _translate_ds_epp_to_srs { |
654
|
|
|
|
|
|
|
my $self = shift; |
655
|
|
|
|
|
|
|
my $epp_ds = shift; |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
return XML::SRS::DS->new( |
658
|
|
|
|
|
|
|
key_tag => $epp_ds->key_tag, |
659
|
|
|
|
|
|
|
algorithm => $epp_ds->alg, |
660
|
|
|
|
|
|
|
digest_type => $epp_ds->digest_type, |
661
|
|
|
|
|
|
|
digest => $epp_ds->digest, |
662
|
|
|
|
|
|
|
); |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
1; |