← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:13 2021

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