line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::EPP::RRPProxy; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=encoding utf8 |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
IO::EPP::RRPProxy |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use IO::EPP::RRPProxy; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Parameters for IO::Socket::SSL |
14
|
|
|
|
|
|
|
my %sock_params = ( |
15
|
|
|
|
|
|
|
PeerHost => 'epp.rrpproxy.net', |
16
|
|
|
|
|
|
|
PeerPort => 700, |
17
|
|
|
|
|
|
|
Timeout => 30, |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Create object, get greeting and call login() |
21
|
|
|
|
|
|
|
my $conn = IO::EPP::RRPProxy->new( { |
22
|
|
|
|
|
|
|
user => 'login', |
23
|
|
|
|
|
|
|
pass => 'xxxxx', |
24
|
|
|
|
|
|
|
sock_params => \%sock_params, |
25
|
|
|
|
|
|
|
test_mode => 0, # real connect |
26
|
|
|
|
|
|
|
} ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Check domain |
29
|
|
|
|
|
|
|
my ( $answ, $code, $msg ) = $conn->check_domains( { domains => [ 'info.name', 'name.info' ] } ); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Call logout() and destroy object |
32
|
|
|
|
|
|
|
undef $conn; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 DESCRIPTION |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Work with RRPProxy EPP API |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Features: |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=over 3 |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
item * |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has its own epp extension for specifying additional parameters; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=item * |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
has additional functions. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=back |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Examples: L, L. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
1
|
|
|
1
|
|
1851
|
use IO::EPP::Base; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
57
|
1
|
|
|
1
|
|
6
|
use parent qw( IO::EPP::Base ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
58
|
|
|
|
|
|
|
|
59
|
1
|
|
|
1
|
|
59
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
15
|
|
60
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1477
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $ks_ext = 'xmlns:keysys="http://www.key-systems.net/epp/keysys-1.0"'; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub make_request { |
65
|
0
|
|
|
0
|
1
|
|
my ( $action, $params ) = @_; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
my ( $self, $code, $msg, $answ ); |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
unless ( $params->{conn} ) { |
70
|
0
|
|
0
|
|
|
|
$params->{sock_params}{PeerHost} ||= 'epp.rrpproxy.net'; |
71
|
0
|
|
0
|
|
|
|
$params->{sock_params}{PeerPort} ||= 700; |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
( $self, $code, $msg ) = __PACKAGE__->new( $params ); |
74
|
|
|
|
|
|
|
|
75
|
0
|
0
|
0
|
|
|
|
unless ( $code and $code == 1000 ) { |
76
|
0
|
|
|
|
|
|
goto END_MR; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
0
|
|
|
|
|
|
$self = $params->{conn}; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
|
$self->{critical_error} = ''; |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
if ( $self->can( $action ) ) { |
87
|
0
|
|
|
|
|
|
( $answ, $code, $msg ) = $self->$action( $params ); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
else { |
90
|
0
|
|
|
|
|
|
$msg = "undefined command <$action>, request cancelled"; |
91
|
0
|
|
|
|
|
|
$code = 0; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
END_MR: |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
|
$msg .= '; ' . $self->{critical_error} if $self->{critical_error}; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
my $full_answ = "code: $code\nmsg: $msg"; |
100
|
|
|
|
|
|
|
|
101
|
0
|
0
|
0
|
|
|
|
$answ = {} unless $answ && ref $answ; |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
$answ->{code} = $code; |
104
|
0
|
|
|
|
|
|
$answ->{msg} = $msg; |
105
|
|
|
|
|
|
|
|
106
|
0
|
0
|
|
|
|
|
return wantarray ? ( $answ, $full_answ, $self ) : $answ; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 METHODS |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Further overlap functions where the provider has features |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 login |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Ext params for login, |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
INPUT: new password for change |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub login { |
122
|
0
|
|
|
0
|
1
|
|
my ( $self, $pw ) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $svcs = ' |
125
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:contact-1.0 |
126
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:domain-1.0 |
127
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:host-1.0'; |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
my $extension = ' |
130
|
|
|
|
|
|
|
http://www.key-systems.net/epp/keysys-1.0 |
131
|
|
|
|
|
|
|
http://www.key-systems.net/epp/query-1.0 |
132
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:secDNS-1.1 |
133
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:rgp-1.0 |
134
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:launchphase-1.0 |
135
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:launch-1.0 |
136
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:idn-1.0 |
137
|
|
|
|
|
|
|
urn:ietf:params:xml:ns:fee-0.7'; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
return $self->SUPER::login( $pw, $svcs, $extension ); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head2 create_contact |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Contact id is generated automatically by the reseller |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=cut |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub create_contact { |
149
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
$params->{id} = 'AUTO'; |
152
|
|
|
|
|
|
|
|
153
|
0
|
0
|
|
|
|
|
$params->{company} =~ s/&/&/g if $params->{company}; |
154
|
0
|
0
|
|
|
|
|
$params->{addr} =~ s/&/&/g if $params->{addr}; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=pod |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
For german characters changes html codes to double symbols: |
159
|
|
|
|
|
|
|
ß = ss |
160
|
|
|
|
|
|
|
ä = ae |
161
|
|
|
|
|
|
|
ü = ue |
162
|
|
|
|
|
|
|
ö = oe |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=cut |
165
|
0
|
|
|
|
|
|
foreach my $f ( 'name', 'company', 'addr', 'city', 'state' ) { |
166
|
0
|
0
|
|
|
|
|
next unless $params->{$f}; |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
$params->{$f} =~ s/Ä/Ae/g; |
169
|
0
|
|
|
|
|
|
$params->{$f} =~ s/Ö/Oe/g; |
170
|
0
|
|
|
|
|
|
$params->{$f} =~ s/Ü/Ue/g; |
171
|
0
|
|
|
|
|
|
$params->{$f} =~ s/ß/ss/g; |
172
|
0
|
|
|
|
|
|
$params->{$f} =~ s/ä/ae/g; |
173
|
0
|
|
|
|
|
|
$params->{$f} =~ s/ö/oe/g; |
174
|
0
|
|
|
|
|
|
$params->{$f} =~ s/ü/ue/g; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# the extension fields must be arranged in alphabetical order |
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
my $fields = "\n 1\n"; |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# each contact is registered separately even if they are the same |
182
|
|
|
|
|
|
|
$params->{extension} = |
183
|
0
|
|
|
|
|
|
qq| |
184
|
|
|
|
|
|
|
$fields |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|; |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
return $self->SUPER::create_contact( $params ); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head2 check_claims |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Get info on Claims Notice |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
For details see L |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
INPUT: |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
key of params: |
202
|
|
|
|
|
|
|
C -- domain name |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=cut |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub check_claims { |
207
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
$params->{domains} = [ $params->{dname} ]; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
$params->{extension} = |
212
|
0
|
|
|
|
|
|
' |
213
|
|
|
|
|
|
|
claims |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
'; |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
return $self->SUPER::check_domains( $params ); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Compile trade, premium and tlds extension |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub _keysys_domain_ext { |
224
|
0
|
|
|
0
|
|
|
my ( $params ) = @_; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
foreach my $f ( keys %$params ) { |
227
|
0
|
0
|
|
|
|
|
if ( $f =~ /^x-/ ) { |
228
|
0
|
|
|
|
|
|
$params->{ uc($f) } = delete $params->{$f}; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
0
|
0
|
|
|
|
|
unless ( $params->{tld} ) { |
233
|
0
|
|
|
|
|
|
( $params->{tld} ) = $params->{dname} =~ /\.([0-9A-Za-z\-]+)$/; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my $tld = uc $params->{tld}; |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
my %ext; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# for epp need lc |
241
|
0
|
|
|
|
|
|
foreach my $f ( keys %$params ) { |
242
|
0
|
0
|
0
|
|
|
|
if ( $f =~ /^X-$tld-$/ or $f eq 'X-ACCEPT-PREMIUMPRICE' or $f eq 'X-ACCEPT-TRADE' ) { |
|
|
|
0
|
|
|
|
|
243
|
0
|
|
|
|
|
|
$ext{ lc($f) } = delete $params->{$f}; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
|
my $extension = ''; |
248
|
|
|
|
|
|
|
# the extension fields must be arranged in alphabetical order |
249
|
0
|
|
|
|
|
|
foreach my $f ( sort keys %ext ) { |
250
|
0
|
|
|
|
|
|
my $f1 = $f; |
251
|
0
|
|
|
|
|
|
$f1 =~ s/^x-//; |
252
|
0
|
|
|
|
|
|
$extension .= " $ext{$f}\n"; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
0
|
|
|
|
|
|
return $extension; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head2 create_domain |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
additional keys of params: |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
C -- register a premium domain without specifying the price, but it must be allowed in the panel; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
C, C -- price for premium domain; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
C -- currency for price for premium domain; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
C -- subhash for claims parameters: |
269
|
|
|
|
|
|
|
C, C, C. |
270
|
|
|
|
|
|
|
For details see L; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
The other parameters are zone-specific and are set as specified in The RRPProxy documentation: C. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=cut |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub create_domain { |
277
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
$params->{authinfo} = ''; # need empty |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Set as RRPProxy documentation, but not epp extension documentation |
282
|
0
|
0
|
|
|
|
|
$params->{'X-ACCEPT-PREMIUMPRICE'} = 1 if delete $params->{is_premium}; # https://wiki.rrpproxy.net/domains/premium-domains |
283
|
0
|
0
|
|
|
|
|
$params->{'X-FEE-AMOUNT'} = delete $params->{premium_price} if defined $params->{premium_price}; # zero is correct price |
284
|
0
|
0
|
|
|
|
|
$params->{'X-FEE-AMOUNT'} = delete $params->{'fee-fee'} if defined $params->{'fee-fee'}; |
285
|
0
|
0
|
|
|
|
|
$params->{'X-FEE-CURRENCY'} = delete $params->{premium_currency} if $params->{premium_currency}; |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
my $extension = _keysys_domain_ext( $params ); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# closing special domain extensions |
290
|
0
|
0
|
|
|
|
|
if ( $extension ) { |
291
|
0
|
|
|
|
|
|
$extension = |
292
|
|
|
|
|
|
|
qq| |
293
|
|
|
|
|
|
|
$extension |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
|; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
0
|
0
|
|
|
|
|
if ( defined $params->{'X-FEE-AMOUNT'} ) { # https://wiki.rrpproxy.net/domains/premium-domains/x-fee-parameters |
301
|
|
|
|
|
|
|
# price can be zero |
302
|
0
|
|
|
|
|
|
$extension .= qq| \n|; |
303
|
|
|
|
|
|
|
|
304
|
0
|
0
|
|
|
|
|
if ( $params->{'X-FEE-CURRENCY'} ) { |
305
|
0
|
|
|
|
|
|
$extension .= ' ' . $params->{'X-FEE-CURRENCY'} . "\n"; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
$extension .= ' ' . $params->{'X-FEE-AMOUNT'} . "\n \n"; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
|
312
|
0
|
0
|
|
|
|
|
if ( $params->{claims} ) { |
313
|
|
|
|
|
|
|
$extension .= |
314
|
|
|
|
|
|
|
' |
315
|
|
|
|
|
|
|
claims |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
'. $params->{claims}{noticeID} .' |
318
|
|
|
|
|
|
|
'. $params->{claims}{notAfter} .' |
319
|
0
|
|
|
|
|
|
'.$params->{claims}{acceptedDate}.' |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
'; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
0
|
0
|
|
|
|
|
$params->{extension} = $extension if $extension; |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
return $self->SUPER::create_domain( $params ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head2 transfer |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
INPUT |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
For premium domains, you need to pass a special parameter is_premium |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
You can also specify contact id for some tlds: C, C, C, C |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
All other parameters such as L. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub transfer { |
344
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
345
|
|
|
|
|
|
|
|
346
|
0
|
0
|
|
|
|
|
if ( defined $params->{authinfo} ) { |
347
|
0
|
|
|
|
|
|
$params->{authinfo} =~ s/&/&/g; |
348
|
0
|
|
|
|
|
|
$params->{authinfo} =~ s/</g; |
349
|
0
|
|
|
|
|
|
$params->{authinfo} =~ s/>/>/g; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
0
|
|
|
|
|
|
my $extension = ''; |
353
|
|
|
|
|
|
|
|
354
|
0
|
0
|
0
|
|
|
|
if ( $params->{is_premium} || $params->{'X-ACCEPT-PREMIUMPRICE'} || $params->{'x-accept-premiumprice'} ) { |
|
|
|
0
|
|
|
|
|
355
|
0
|
|
|
|
|
|
$extension .= " 1\n"; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
0
|
|
|
|
if ( $params->{reg_id} || $params->{admin_id} ) { |
359
|
0
|
0
|
|
|
|
|
$extension .= " $$params{reg_id}\n" if $params->{reg_id}; |
360
|
0
|
0
|
|
|
|
|
$extension .= " $$params{admin_id}\n" if $params->{admin_id}; |
361
|
0
|
0
|
|
|
|
|
$extension .= " $$params{tech_id}\n" if $params->{tech_id}; |
362
|
0
|
0
|
|
|
|
|
$extension .= " $$params{billing_id}\n" if $params->{billing_id}; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
0
|
0
|
|
|
|
|
if ( $extension ) { |
366
|
|
|
|
|
|
|
$params->{extension} = |
367
|
0
|
|
|
|
|
|
qq| |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
$extension |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
|; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
return $self->SUPER::transfer( $params ); |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=head2 renew_domain |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
For renewal of the premium domain name, you need to pass a parameter C or C |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=cut |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub renew_domain { |
384
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
385
|
|
|
|
|
|
|
|
386
|
0
|
0
|
0
|
|
|
|
if ( $params->{is_premium} || $params->{'X-ACCEPT-PREMIUMPRICE'} || $params->{'x-accept-premiumprice'} ) { |
|
|
|
0
|
|
|
|
|
387
|
|
|
|
|
|
|
# https://wiki.rrpproxy.net/domains/premium-domains |
388
|
|
|
|
|
|
|
$params->{extension} = |
389
|
0
|
|
|
|
|
|
qq| |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
1 |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
|
return $self->SUPER::renew_domain( $params ); |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 update_domain |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
C – option for special change of domain owner – paid or requires confirmation; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=cut |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub update_domain { |
408
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
409
|
|
|
|
|
|
|
|
410
|
0
|
0
|
|
|
|
|
$params->{'X-ACCEPT-TRADE'} = 1 if delete $params->{trade}; |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
|
my $extension = _keysys_domain_ext( $params ); |
413
|
|
|
|
|
|
|
|
414
|
0
|
0
|
|
|
|
|
if ( $extension ) { |
415
|
|
|
|
|
|
|
$params->{extension} = |
416
|
0
|
|
|
|
|
|
qq| |
417
|
|
|
|
|
|
|
$extension |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
|; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
|
return $self->SUPER::update_domain( $params ); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=head2 set_domain_renewal_mode |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Set renewal mode for domain. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
INPUT: |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
params with key: |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
C – valid values: C, C, C, C, C |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
For details see L |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
OUTPUT: |
440
|
|
|
|
|
|
|
see L |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=cut |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub set_domain_renewal_mode { |
445
|
0
|
|
|
0
|
1
|
|
my ( $self, $params ) = @_; |
446
|
|
|
|
|
|
|
|
447
|
0
|
|
|
|
|
|
$params->{renewal_mode} = uc $params->{renewal_mode}; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
$params->{extension} = |
450
|
0
|
|
|
|
|
|
qq| |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
$$params{renewal_mode} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
|; |
456
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
|
return $self->update_domain( $params ); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head2 req_poll_ext |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
keysys extension for the req poll |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=cut |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub req_poll_ext { |
468
|
0
|
|
|
0
|
1
|
|
my ( undef, $ext ) = @_; |
469
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
|
my %info; |
471
|
|
|
|
|
|
|
|
472
|
0
|
0
|
|
|
|
|
if ( $ext =~ /]+>(.+?)<\/keysys:poll>/s ) { |
473
|
0
|
|
|
|
|
|
my $key_ext = $1; |
474
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
|
foreach my $type ( 'data', 'info' ) { |
476
|
0
|
0
|
|
|
|
|
if ( $key_ext =~ /(.+?)<\/keysys:$type>/s ) { |
477
|
0
|
|
|
|
|
|
my $data = $1; |
478
|
|
|
|
|
|
|
|
479
|
0
|
|
|
|
|
|
my @data = $data =~ /<[^<>]+>[^<>]+<\/[^<>]+>/g; |
480
|
|
|
|
|
|
|
|
481
|
0
|
0
|
|
|
|
|
if ( scalar @data ) { |
482
|
0
|
|
|
|
|
|
foreach my $row ( @data ) { |
483
|
0
|
0
|
|
|
|
|
if ( $row =~ /<([^<>]+)>([^<>]+)<\/[^<>]+>/ ) { |
484
|
0
|
|
|
|
|
|
$info{$1} = $2; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
else { |
489
|
0
|
|
|
|
|
|
$info{$type} = $data; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
0
|
|
|
|
|
|
return \%info; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
1; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
__END__ |