line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## Domain Registry Interface, Whois commands for .AT (RFC3912) |
2
|
|
|
|
|
|
|
## |
3
|
|
|
|
|
|
|
## Copyright (c) 2008,2009,2013,2014 Patrick Mevzek . 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
|
|
|
|
|
|
|
package Net::DRI::Protocol::Whois::Domain::AT; |
16
|
|
|
|
|
|
|
|
17
|
1
|
|
|
1
|
|
685
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
18
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
23
|
|
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
5
|
use Net::DRI::Exception; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
14
|
|
21
|
1
|
|
|
1
|
|
4
|
use Net::DRI::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
915
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=pod |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 NAME |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Net::DRI::Protocol::Whois::Domain::AT - .AT Whois commands (RFC3912) for Net::DRI |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 DESCRIPTION |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Please see the README file for details. |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 SUPPORT |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
For now, support questions should be sent to: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Enetdri@dotandco.comE |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Please also see the SUPPORT file in the distribution. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 SEE ALSO |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Ehttp://www.dotandco.com/services/software/Net-DRI/E |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 AUTHOR |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Patrick Mevzek, Enetdri@dotandco.comE |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 COPYRIGHT |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
Copyright (c) 2008,2009,2013,2014 Patrick Mevzek . |
52
|
|
|
|
|
|
|
All rights reserved. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
55
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
56
|
|
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or |
57
|
|
|
|
|
|
|
(at your option) any later version. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
See the LICENSE file that comes with this distribution for more details. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=cut |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
#################################################################################################### |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub register_commands |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
|
|
0
|
0
|
|
my ($class,$version)=@_; |
68
|
0
|
|
|
|
|
|
return { 'domain' => { info => [ \&info, \&info_parse ] } }; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub info |
72
|
|
|
|
|
|
|
{ |
73
|
0
|
|
|
0
|
0
|
|
my ($po,$domain,$rd)=@_; |
74
|
0
|
|
|
|
|
|
my $mes=$po->message(); |
75
|
0
|
0
|
|
|
|
|
Net::DRI::Exception->die(1,'protocol/whois',10,'Invalid domain name: '.$domain) unless Net::DRI::Util::is_hostname($domain); |
76
|
0
|
|
|
|
|
|
$mes->command(lc $domain); |
77
|
0
|
|
|
|
|
|
return; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub info_parse |
81
|
|
|
|
|
|
|
{ |
82
|
0
|
|
|
0
|
0
|
|
my ($po,$otype,$oaction,$oname,$rinfo)=@_; |
83
|
0
|
|
|
|
|
|
my $mes=$po->message(); |
84
|
0
|
0
|
|
|
|
|
return unless $mes->is_success(); |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
my $rr=$mes->response(); |
87
|
0
|
|
|
|
|
|
my $rd=$mes->response_raw(); |
88
|
0
|
|
|
|
|
|
my ($domain,$exist)=parse_domain($po,$rr,$rd,$rinfo); |
89
|
0
|
0
|
|
|
|
|
$domain=lc($oname) unless defined($domain); |
90
|
0
|
|
|
|
|
|
$rinfo->{domain}->{$domain}->{exist}=$exist; |
91
|
0
|
|
|
|
|
|
$rinfo->{domain}->{$domain}->{action}='info'; |
92
|
|
|
|
|
|
|
|
93
|
0
|
0
|
|
|
|
|
return unless $exist; |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
parse_ns($po,$domain,$rr,$rinfo); |
96
|
0
|
|
|
|
|
|
parse_dates($po,$domain,$rr,$rinfo); |
97
|
0
|
|
|
|
|
|
parse_contacts($po,$domain,$rr,$rd,$rinfo); |
98
|
0
|
|
|
|
|
|
return; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub parse_domain |
102
|
|
|
|
|
|
|
{ |
103
|
0
|
|
|
0
|
0
|
|
my ($po,$rr,$rd,$rinfo)=@_; |
104
|
0
|
|
|
|
|
|
my ($dom,$e); |
105
|
0
|
0
|
|
|
|
|
if (exists($rr->{'domain'})) |
106
|
|
|
|
|
|
|
{ |
107
|
0
|
|
|
|
|
|
$e=1; |
108
|
0
|
|
|
|
|
|
$dom=lc($rr->{'domain'}->[0]); |
109
|
|
|
|
|
|
|
} else |
110
|
|
|
|
|
|
|
{ |
111
|
0
|
|
|
|
|
|
$e=0; |
112
|
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
|
return ($dom,$e); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub parse_ns |
117
|
|
|
|
|
|
|
{ |
118
|
0
|
|
|
0
|
0
|
|
my ($po,$domain,$rr,$rinfo)=@_; |
119
|
0
|
0
|
|
|
|
|
return unless exists($rr->{'nserver'}); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
## I do not know how multiple IPs for one host are handled, we do the very crude way for now |
122
|
0
|
|
|
|
|
|
my $h=$po->create_local_object('hosts'); |
123
|
0
|
0
|
|
|
|
|
my @n=grep { defined($_) && $_ } @{$rr->{'nserver'}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
|
my @i=grep { defined($_) && $_ } @{$rr->{'remarks'}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
|
while(@n) |
126
|
|
|
|
|
|
|
{ |
127
|
0
|
|
|
|
|
|
$h->add(shift(@n),[shift(@i)]); |
128
|
|
|
|
|
|
|
} |
129
|
0
|
0
|
|
|
|
|
$rinfo->{domain}->{$domain}->{ns}=$h unless $h->is_empty(); |
130
|
0
|
|
|
|
|
|
return; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub parse_dates |
134
|
|
|
|
|
|
|
{ |
135
|
0
|
|
|
0
|
0
|
|
my ($po,$domain,$rr,$rinfo)=@_; |
136
|
0
|
|
|
|
|
|
my $strp=$po->build_strptime_parser(pattern => '%Y%m%d %T', time_zone => 'Europe/Vienna'); |
137
|
0
|
|
|
|
|
|
$rinfo->{domain}->{$domain}->{upDate}=$strp->parse_datetime($rr->{'changed'}->[0]); |
138
|
0
|
|
|
|
|
|
return; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub parse_contacts |
142
|
|
|
|
|
|
|
{ |
143
|
0
|
|
|
0
|
0
|
|
my ($po,$domain,$rr,$rd,$rinfo)=@_; |
144
|
0
|
|
|
|
|
|
my $cs=$po->create_local_object('contactset'); |
145
|
0
|
|
|
|
|
|
my %t=('registrant' => 'registrant', 'admin-c' => 'admin', 'tech-c' => 'tech'); |
146
|
0
|
|
|
|
|
|
my %tmp; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
## First pass, only the IDs |
149
|
0
|
|
|
|
|
|
foreach my $t (sort { $a cmp $b } keys %t) |
|
0
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
{ |
151
|
0
|
|
|
|
|
|
my $c=$po->create_local_object('contact'); |
152
|
0
|
|
|
|
|
|
my $id=$rr->{$t}->[0]; |
153
|
0
|
|
|
|
|
|
$tmp{$id}=$c; |
154
|
0
|
|
|
|
|
|
$c->srid($id); |
155
|
0
|
|
|
|
|
|
$cs->add($c,$t{$t}); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
## Now all details |
159
|
0
|
|
|
|
|
|
my ($id,@s); |
160
|
0
|
|
|
|
|
|
foreach my $l (reverse grep { (($_=~m/^personname:/)..($_=~m/^\s*$/)) } @$rd) |
|
0
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
{ |
162
|
0
|
0
|
|
|
|
|
next if ($l=~m/^(?:source|changed):/); |
163
|
0
|
0
|
|
|
|
|
$id=$1 if ($l=~m/^nic-hdl:\s+(\S+)\s*$/); |
164
|
0
|
0
|
|
|
|
|
if ($l=~m/^e-mail:\s+(\S+)\s*$/) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
165
|
|
|
|
|
|
|
{ |
166
|
0
|
|
|
|
|
|
$tmp{$id}->email($1); |
167
|
|
|
|
|
|
|
} elsif ($l=~m/^fax-no:\s+(\S.+\S)\s*$/) |
168
|
|
|
|
|
|
|
{ |
169
|
0
|
|
|
|
|
|
$tmp{$id}->fax($1); |
170
|
|
|
|
|
|
|
} elsif ($l=~m/^phone:\s+(\S.+\S)\s*$/) |
171
|
|
|
|
|
|
|
{ |
172
|
0
|
|
|
|
|
|
$tmp{$id}->voice($1); |
173
|
|
|
|
|
|
|
} elsif ($l=~m/^country:\s+(\S.+\S)\s*$/) |
174
|
|
|
|
|
|
|
{ |
175
|
0
|
|
|
|
|
|
$tmp{$id}->cc($1); |
176
|
|
|
|
|
|
|
} elsif ($l=~m/^city:\s+(\S.+\S)\s*$/) |
177
|
|
|
|
|
|
|
{ |
178
|
0
|
|
|
|
|
|
$tmp{$id}->city($1); |
179
|
|
|
|
|
|
|
} elsif ($l=~m/^postal code:\s+(\S.+\S)\s*$/) |
180
|
|
|
|
|
|
|
{ |
181
|
0
|
|
|
|
|
|
$tmp{$id}->pc($1); |
182
|
|
|
|
|
|
|
} elsif ($l=~m/^street address:\s+(\S.+\S)\s*$/) |
183
|
|
|
|
|
|
|
{ |
184
|
0
|
|
|
|
|
|
push @s,$1; |
185
|
|
|
|
|
|
|
} elsif ($l=~m/^organization:\s+(\S.+\S)\s*$/) |
186
|
|
|
|
|
|
|
{ |
187
|
0
|
|
|
|
|
|
$tmp{$id}->org($1); |
188
|
0
|
0
|
|
|
|
|
$tmp{$id}->street([reverse(@s)]) if @s; |
189
|
0
|
|
|
|
|
|
@s=(); |
190
|
|
|
|
|
|
|
} elsif ($l=~m/^personname:\s+(\S.+\S)\s*$/) |
191
|
|
|
|
|
|
|
{ |
192
|
0
|
|
|
|
|
|
$tmp{$id}->name($1); |
193
|
0
|
0
|
|
|
|
|
$tmp{$id}->street([reverse(@s)]) if @s; |
194
|
0
|
|
|
|
|
|
@s=(); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
0
|
|
|
|
|
|
$rinfo->{domain}->{$domain}->{contact}=$cs; |
198
|
0
|
|
|
|
|
|
return; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#################################################################################################### |
202
|
|
|
|
|
|
|
1; |