/usr/lib/perl5/Net/DNS/Question.pm is in libnet-dns-perl 0.66-2ubuntu3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | package Net::DNS::Question;
#
# $Id: Question.pm 836 2009-12-30 09:41:53Z olaf $
#
use strict;
BEGIN {
eval { require bytes; }
}
use vars qw($VERSION $AUTOLOAD);
use Carp;
use Net::DNS;
$VERSION = (qw$LastChangedRevision: 800$)[1];
=head1 NAME
Net::DNS::Question - DNS question class
=head1 SYNOPSIS
C<use Net::DNS::Question>
=head1 DESCRIPTION
A C<Net::DNS::Question> object represents a record in the
question section of a DNS packet.
=head1 METHODS
=head2 new
$question = Net::DNS::Question->new("example.com", "MX", "IN");
Creates a question object from the domain, type, and class passed
as arguments.
RFC4291 and RFC4632 IP address/prefix notation is supported for
queries in in-addr.arpa and ip6.arpa subdomains.
=cut
sub new {
my $self = bless {}, shift;
my $qname = shift;
my $qtype = uc (shift || '');
my $qclass = uc (shift || '');
$qname = '' unless defined $qname; # || ''; is NOT same!
$qname =~ s/\.+$//o; # strip gratuitous trailing dot
# tolerate (possibly unknown) type and class in zone file order
unless ( exists $Net::DNS::classesbyname{$qclass} ) {
( $qtype, $qclass ) = ( $qclass, $qtype )
if exists $Net::DNS::classesbyname{$qtype};
( $qtype, $qclass ) = ( $qclass, $qtype ) if $qtype =~ /CLASS/;
}
unless ( exists $Net::DNS::typesbyname{$qtype} ) {
( $qtype, $qclass ) = ( $qclass, $qtype )
if exists $Net::DNS::typesbyname{$qclass};
( $qtype, $qclass ) = ( $qclass, $qtype ) if $qclass =~ /TYPE/;
}
# if argument is an IP address, do appropriate reverse lookup
my $reverse = _dns_addr($qname) if $qname =~ m/:|\d$/o;
if ( $reverse ) {
$qname = $reverse;
$qtype ||= 'PTR';
}
$self->{qname} = $qname;
$self->{qtype} = ( $qtype || 'A' );
$self->{qclass} = ( $qclass || 'IN' );
return $self;
}
sub _dns_addr {
my $arg = shift; # name or IP address
# IP address must contain address characters only
return undef if $arg =~ m#[^a-fA-F0-9:./]#o;
# if arg looks like IPv4 address then map to in-addr.arpa space
if ( $arg =~ m#(^|:.*:)((^|\d+\.)+\d+)(/(\d+))?$#o ) {
my @parse = split /\./, $2;
my $prefx = $5 || @parse<<3;
my $last = $prefx > 24 ? 3 : ($prefx-1)>>3;
return join '.', reverse( (@parse,(0)x3)[0 .. $last] ), 'in-addr.arpa';
}
# if arg looks like IPv6 address then map to ip6.arpa space
if ( $arg =~ m#^((\w*:)+)(\w*)(/(\d+))?$#o ) {
my @parse = split /:/, (reverse "0${1}0${3}"), 9;
my @xpand = map{/./ ? $_ : ('0')x(9-@parse)} @parse; # expand ::
my $prefx = $5 || @xpand<<4; # implicit length if unspecified
my $hex = pack 'A4'x8, map{$_.'000'} ('0')x(8-@xpand), @xpand;
my $len = $prefx > 124 ? 32 : ($prefx+3)>>2;
return join '.', split(//, substr($hex,-$len) ), 'ip6.arpa';
}
return undef;
}
=head2 parse
($question, $offset) = Net::DNS::Question->parse(\$data, $offset);
Parses a question section record at the specified location within a DNS packet.
The first argument is a reference to the packet data.
The second argument is the offset within the packet where the question record begins.
Returns a Net::DNS::Question object and the offset of the next location in the packet.
Parsing is aborted if the question object cannot be created (e.g., corrupt or insufficient data).
=cut
use constant PACKED_LENGTH => length pack 'n2', (0)x2;
sub parse {
my ($class, $data, $offset) = @_;
my ($qname, $index) = Net::DNS::Packet::dn_expand($data, $offset);
die 'Exception: corrupt or incomplete data' unless $index;
my $next = $index + PACKED_LENGTH;
die 'Exception: incomplete data' if length $$data < $next;
my ($qtype, $qclass) = unpack("\@$index n2", $$data);
my $self = { qname => $qname,
qtype => Net::DNS::typesbyval($qtype),
qclass => Net::DNS::classesbyval($qclass)
};
bless $self, $class;
return wantarray ? ($self, $next) : $self;
}
#
# Some people have reported that Net::DNS dies because AUTOLOAD picks up
# calls to DESTROY.
#
sub DESTROY {}
=head2 qname, zname
print "qname = ", $question->qname, "\n";
print "zname = ", $question->zname, "\n";
Returns the domain name. In dynamic update packets, this field is
known as C<zname> and refers to the zone name.
=head2 qtype, ztype
print "qtype = ", $question->qtype, "\n";
print "ztype = ", $question->ztype, "\n";
Returns the record type. In dymamic update packets, this field is
known as C<ztype> and refers to the zone type (must be SOA).
=head2 qclass, zclass
print "qclass = ", $question->qclass, "\n";
print "zclass = ", $question->zclass, "\n";
Returns the record class. In dynamic update packets, this field is
known as C<zclass> and refers to the zone's class.
=cut
sub zname { &qname; }
sub ztype { &qtype; }
sub zclass { &qclass; }
sub AUTOLOAD {
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/.*://o;
croak "$AUTOLOAD: no such method" unless exists $self->{$name};
return $self->{$name} unless @_;
my $value = shift;
$value =~ s/\.+$//o if defined $value; # strip gratuitous trailing dot
$self->{$name} = $value;
}
=head2 print
$question->print;
Prints the question record on the standard output.
=cut
sub print { print &string, "\n"; }
=head2 string
print $qr->string, "\n";
Returns a string representation of the question record.
=cut
sub string {
my $self = shift;
return "$self->{qname}.\t$self->{qclass}\t$self->{qtype}";
}
=head2 data
$qdata = $question->data($packet, $offset);
Returns the question record in binary format suitable for inclusion
in a DNS packet.
Arguments are a C<Net::DNS::Packet> object and the offset within
that packet's data where the C<Net::DNS::Question> record is to
be stored. This information is necessary for using compressed
domain names.
=cut
sub data {
my ($self, $packet, $offset) = @_;
my $data = $packet->dn_comp($self->{qname}, $offset);
$data .= pack('n2', Net::DNS::typesbyname(uc $self->{qtype}),
Net::DNS::classesbyname(uc $self->{qclass})
);
return $data;
}
1;
__END__
=head1 COPYRIGHT
Copyright (c) 1997-2002 Michael Fuhr.
Portions Copyright (c) 2002-2004 Chris Reinhardt.
Portions Copyright (c) 2003,2006-2009 Dick Franks.
All rights reserved.
This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::RR>,
RFC 1035 Section 4.1.2
=cut
|