Filename | /usr/local/lib/perl5/site_perl/Net/DNS.pm |
Statements | Executed 19 statements in 2.42ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 48µs | 56µs | BEGIN@34 | Net::DNS::
1 | 1 | 1 | 27µs | 275µs | BEGIN@38 | Net::DNS::
1 | 1 | 1 | 26µs | 54µs | BEGIN@35 | Net::DNS::
1 | 1 | 1 | 25µs | 32µs | BEGIN@36 | Net::DNS::
0 | 0 | 0 | 0s | 0s | SEQUENTIAL | Net::DNS::
0 | 0 | 0 | 0s | 0s | UNIXTIME | Net::DNS::
0 | 0 | 0 | 0s | 0s | YYYYMMDDxx | Net::DNS::
0 | 0 | 0 | 0s | 0s | mx | Net::DNS::
0 | 0 | 0 | 0s | 0s | nxdomain | Net::DNS::
0 | 0 | 0 | 0s | 0s | nxrrset | Net::DNS::
0 | 0 | 0 | 0s | 0s | rr | Net::DNS::
0 | 0 | 0 | 0s | 0s | rr_add | Net::DNS::
0 | 0 | 0 | 0s | 0s | rr_del | Net::DNS::
0 | 0 | 0 | 0s | 0s | rrsort | Net::DNS::
0 | 0 | 0 | 0s | 0s | version | Net::DNS::
0 | 0 | 0 | 0s | 0s | yxdomain | Net::DNS::
0 | 0 | 0 | 0s | 0s | yxrrset | Net::DNS::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::DNS; | ||||
2 | |||||
3 | # | ||||
4 | # $Id: DNS.pm 1604 2017-10-18 09:00:29Z willem $ | ||||
5 | # | ||||
6 | 1 | 21µs | require 5.006; | ||
7 | our $VERSION; | ||||
8 | 1 | 2µs | $VERSION = '1.13'; | ||
9 | 1 | 46µs | $VERSION = eval $VERSION; # spent 6µs executing statements in string eval | ||
10 | 1 | 2µs | our $SVNVERSION = (qw$LastChangedRevision: 1604 $)[1]; | ||
11 | |||||
12 | |||||
13 | =head1 NAME | ||||
14 | |||||
15 | Net::DNS - Perl Interface to the Domain Name System | ||||
16 | |||||
17 | =head1 SYNOPSIS | ||||
18 | |||||
19 | use Net::DNS; | ||||
20 | |||||
21 | =head1 DESCRIPTION | ||||
22 | |||||
23 | Net::DNS is a collection of Perl modules that act as a Domain Name System | ||||
24 | (DNS) resolver. It allows the programmer to perform DNS queries that are | ||||
25 | beyond the capabilities of "gethostbyname" and "gethostbyaddr". | ||||
26 | |||||
27 | The programmer should be somewhat familiar with the format of a DNS packet | ||||
28 | and its various sections. See RFC 1035 or DNS and BIND (Albitz & Liu) for | ||||
29 | details. | ||||
30 | |||||
31 | =cut | ||||
32 | |||||
33 | |||||
34 | 2 | 63µs | 2 | 64µs | # spent 56µs (48+8) within Net::DNS::BEGIN@34 which was called:
# once (48µs+8µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 34 # spent 56µs making 1 call to Net::DNS::BEGIN@34
# spent 8µs making 1 call to strict::import |
35 | 2 | 76µs | 2 | 81µs | # spent 54µs (26+27) within Net::DNS::BEGIN@35 which was called:
# once (26µs+27µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 35 # spent 54µs making 1 call to Net::DNS::BEGIN@35
# spent 27µs making 1 call to warnings::import |
36 | 2 | 67µs | 2 | 39µs | # spent 32µs (25+7) within Net::DNS::BEGIN@36 which was called:
# once (25µs+7µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 36 # spent 32µs making 1 call to Net::DNS::BEGIN@36
# spent 7µs making 1 call to integer::import |
37 | |||||
38 | 2 | 1.58ms | 2 | 523µs | # spent 275µs (27+248) within Net::DNS::BEGIN@38 which was called:
# once (27µs+248µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 38 # spent 275µs making 1 call to Net::DNS::BEGIN@38
# spent 248µs making 1 call to base::import |
39 | 1 | 5µs | our @EXPORT = qw(SEQUENTIAL UNIXTIME YYYYMMDDxx | ||
40 | yxrrset nxrrset yxdomain nxdomain rr_add rr_del | ||||
41 | mx rr rrsort); | ||||
42 | |||||
43 | |||||
44 | 1 | 4µs | local $SIG{__DIE__}; | ||
45 | 1 | 257µs | require Net::DNS::Resolver; | ||
46 | 1 | 3µs | require Net::DNS::Packet; | ||
47 | 1 | 2µs | require Net::DNS::RR; | ||
48 | 1 | 263µs | require Net::DNS::Update; | ||
49 | |||||
50 | |||||
51 | sub version { $VERSION; } | ||||
52 | |||||
53 | |||||
54 | # | ||||
55 | # rr() | ||||
56 | # | ||||
57 | # Usage: | ||||
58 | # @rr = rr('example.com'); | ||||
59 | # @rr = rr('example.com', 'A', 'IN'); | ||||
60 | # @rr = rr($res, 'example.com' ... ); | ||||
61 | # | ||||
62 | sub rr { | ||||
63 | my ($arg1) = @_; | ||||
64 | my $res = ref($arg1) ? shift : new Net::DNS::Resolver(); | ||||
65 | |||||
66 | my $ans = $res->query(@_); | ||||
67 | my @list = $ans ? $ans->answer : (); | ||||
68 | } | ||||
69 | |||||
70 | |||||
71 | # | ||||
72 | # mx() | ||||
73 | # | ||||
74 | # Usage: | ||||
75 | # @mx = mx('example.com'); | ||||
76 | # @mx = mx($res, 'example.com'); | ||||
77 | # | ||||
78 | sub mx { | ||||
79 | my ($arg1) = @_; | ||||
80 | my @res = ( ref($arg1) ? shift : () ); | ||||
81 | my ( $name, @class ) = @_; | ||||
82 | |||||
83 | # This construct is best read backwards. | ||||
84 | # | ||||
85 | # First we take the answer section of the packet. | ||||
86 | # Then we take just the MX records from that list | ||||
87 | # Then we sort the list by preference | ||||
88 | # We do this into an array to force list context. | ||||
89 | # Then we return the list. | ||||
90 | |||||
91 | my @list = sort { $a->preference <=> $b->preference } | ||||
92 | grep $_->type eq 'MX', &rr( @res, $name, 'MX', @class ); | ||||
93 | return @list; | ||||
94 | } | ||||
95 | |||||
96 | |||||
97 | # | ||||
98 | # rrsort() | ||||
99 | # | ||||
100 | # Usage: | ||||
101 | # @prioritysorted = rrsort( "SRV", "priority", @rr_array ); | ||||
102 | # | ||||
103 | sub rrsort { | ||||
104 | my $rrtype = uc shift; | ||||
105 | my ( $attribute, @rr ) = @_; ## NB: attribute is optional | ||||
106 | ( @rr, $attribute ) = @_ if ref($attribute) =~ /^Net::DNS::RR/; | ||||
107 | |||||
108 | my @extracted = grep $_->type eq $rrtype, @rr; | ||||
109 | return @extracted unless scalar @extracted; | ||||
110 | my $func = "Net::DNS::RR::$rrtype"->get_rrsort_func($attribute); | ||||
111 | my @sorted = sort $func @extracted; | ||||
112 | } | ||||
113 | |||||
114 | |||||
115 | # | ||||
116 | # Auxiliary functions to support policy-driven zone serial numbering. | ||||
117 | # | ||||
118 | # $successor = $soa->serial(SEQUENTIAL); | ||||
119 | # $successor = $soa->serial(UNIXTIME); | ||||
120 | # $successor = $soa->serial(YYYYMMDDxx); | ||||
121 | # | ||||
122 | |||||
123 | sub SEQUENTIAL {undef} | ||||
124 | |||||
125 | sub UNIXTIME { return CORE::time; } | ||||
126 | |||||
127 | sub YYYYMMDDxx { | ||||
128 | my ( $dd, $mm, $yy ) = (localtime)[3 .. 5]; | ||||
129 | return 1900010000 + sprintf '%d%0.2d%0.2d00', $yy, $mm, $dd; | ||||
130 | } | ||||
131 | |||||
132 | |||||
133 | # | ||||
134 | # Auxiliary functions to support dynamic update. | ||||
135 | # | ||||
136 | |||||
137 | sub yxrrset { | ||||
138 | my $rr = new Net::DNS::RR(@_); | ||||
139 | $rr->ttl(0); | ||||
140 | $rr->class('ANY') unless $rr->rdata; | ||||
141 | return $rr; | ||||
142 | } | ||||
143 | |||||
144 | sub nxrrset { | ||||
145 | my $rr = new Net::DNS::RR(@_); | ||||
146 | new Net::DNS::RR( | ||||
147 | name => $rr->name, | ||||
148 | type => $rr->type, | ||||
149 | class => 'NONE' | ||||
150 | ); | ||||
151 | } | ||||
152 | |||||
153 | sub yxdomain { | ||||
154 | my ( $domain, @etc ) = map split, @_; | ||||
155 | my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) ); | ||||
156 | new Net::DNS::RR( | ||||
157 | name => $rr->name, | ||||
158 | type => 'ANY', | ||||
159 | class => 'ANY' | ||||
160 | ); | ||||
161 | } | ||||
162 | |||||
163 | sub nxdomain { | ||||
164 | my ( $domain, @etc ) = map split, @_; | ||||
165 | my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) ); | ||||
166 | new Net::DNS::RR( | ||||
167 | name => $rr->name, | ||||
168 | type => 'ANY', | ||||
169 | class => 'NONE' | ||||
170 | ); | ||||
171 | } | ||||
172 | |||||
173 | sub rr_add { | ||||
174 | my $rr = new Net::DNS::RR(@_); | ||||
175 | $rr->{ttl} = 86400 unless defined $rr->{ttl}; | ||||
176 | return $rr; | ||||
177 | } | ||||
178 | |||||
179 | sub rr_del { | ||||
180 | my ( $domain, @etc ) = map split, @_; | ||||
181 | my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain, type => 'ANY' ) ); | ||||
182 | $rr->class( $rr->rdata ? 'NONE' : 'ANY' ); | ||||
183 | $rr->ttl(0); | ||||
184 | return $rr; | ||||
185 | } | ||||
186 | |||||
187 | |||||
188 | 1 | 32µs | 1; | ||
189 | __END__ |