?? base.pm
字號:
print ';; answer from ',
$ready->peerhost, ':',
$ready->peerport, ' : ',
length($buf), " bytes\n"
if $self->{'debug'};
my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
if (defined $ans) {
next unless $ans->header->qr;
next unless $ans->header->id == $packet->header->id;
$self->errorstring($ans->header->rcode);
$ans->answerfrom($self->answerfrom);
$ans->answersize($self->answersize);
} elsif (defined $err) {
$self->errorstring($err);
}
return $ans;
} else {
$self->errorstring($!);
print ';; recv ERROR(',
$ready->peerhost, ':',
$ready->peerport, '): ',
$self->errorstring, "\n"
if $self->{'debug'};
@ns = grep { $_->[0] ne $ready->peerhost } @ns;
return unless @ns;
}
}
}
}
if ($sel->handles) {
$self->errorstring('query timed out');
}
else {
$self->errorstring('all nameservers failed');
}
return;
}
sub bgsend {
my $self = shift;
unless (@{$self->{'nameservers'}}) {
$self->errorstring('no nameservers');
return;
}
$self->_reset_errorstring;
my $packet = $self->make_query_packet(@_);
my $packet_data = $packet->data;
my $srcaddr = $self->{'srcaddr'};
my $srcport = $self->{'srcport'};
my $dstaddr = $self->{'nameservers'}->[0];
my $dstport = $self->{'port'};
my $sock = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $srcaddr,
LocalPort => ($srcport || undef),
);
unless ($sock) {
$self->errorstring(q|couldn't get socket|); #'
return;
}
my $dst_sockaddr = sockaddr_in($dstport, inet_aton($dstaddr));
print ";; bgsend($dstaddr:$dstport)\n" if $self->{'debug'};
unless ($sock->send($packet_data, 0, $dst_sockaddr)) {
my $err = $!;
print ";; send ERROR($dstaddr): $err\n" if $self->{'debug'};
$self->errorstring($err);
return;
}
return $sock;
}
sub bgread {
my ($self, $sock) = @_;
my $buf = '';
my $peeraddr = $sock->recv($buf, $self->_packetsz);
if ($peeraddr) {
print ';; answer from ', $sock->peerhost, ':',
$sock->peerport, ' : ', length($buf), " bytes\n"
if $self->{'debug'};
my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
if (defined $ans) {
$self->errorstring($ans->header->rcode);
} elsif (defined $err) {
$self->errorstring($err);
}
return $ans;
} else {
$self->errorstring($!);
return;
}
}
sub bgisready {
my $self = shift;
my $sel = Net::DNS::Select->new(@_);
my @ready = $sel->can_read(0.0);
return @ready > 0;
}
sub make_query_packet {
my $self = shift;
my $packet;
if (ref($_[0]) and $_[0]->isa('Net::DNS::Packet')) {
$packet = shift;
} else {
my ($name, $type, $class) = @_;
$name ||= '';
$type ||= 'A';
$class ||= 'IN';
# If the name looks like an IP address then do an appropriate
# PTR query.
if ($name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
$name = "$4.$3.$2.$1.in-addr.arpa.";
$type = 'PTR';
}
$packet = Net::DNS::Packet->new($name, $type, $class);
}
if ($packet->header->opcode eq 'QUERY') {
$packet->header->rd($self->{'recurse'});
}
if ($self->{'dnssec'}) {
# RFC 3225
print ";; Adding EDNS extention with UDP packetsize $self->{'udppacketsize'} and DNS OK bit set\n"
if $self->{'debug'};
my $optrr = Net::DNS::RR->new(
Type => 'OPT',
Name => '',
Class => $self->{'udppacketsize'}, # Decimal UDPpayload
ednsflags => 0x8000, # first bit set see RFC 3225
);
$packet->push('additional', $optrr);
} elsif ($self->{'udppacketsize'} > &Net::DNS::PACKETSZ) {
print ";; Adding EDNS extention with UDP packetsize $self->{'udppacketsize'}.\n" if $self->{'debug'};
# RFC 3225
my $optrr = Net::DNS::RR->new(
Type => 'OPT',
Name => '',
Class => $self->{'udppacketsize'}, # Decimal UDPpayload
TTL => 0x0000 # RCODE 32bit Hex
);
$packet->push('additional', $optrr);
}
if ($self->{'tsig_rr'}) {
if (!grep { $_->type eq 'TSIG' } $packet->additional) {
$packet->push('additional', $self->{'tsig_rr'});
}
}
return $packet;
}
sub axfr {
my $self = shift;
my @zone;
if ($self->axfr_start(@_)) {
my ($rr, $err);
while (($rr, $err) = $self->axfr_next, $rr && !$err) {
push @zone, $rr;
}
@zone = () if $err && $err ne 'no zone transfer in progress';
}
return @zone;
}
sub axfr_old {
warn "Use of " . __PACKAGE__ . "::axfr_old() is deprecated. Use axfr() or axfr_start().\n";
my $self = shift;
my ($dname, $class) = @_;
$dname ||= $self->{'searchlist'}->[0];
$class ||= 'IN';
unless ($dname) {
print ";; ERROR: axfr: no zone specified\n" if $self->{'debug'};
$self->errorstring('no zone');
return;
}
print ";; axfr($dname, $class)\n" if $self->{'debug'};
unless (@{$self->{'nameservers'}}) {
$self->errorstring('no nameservers');
print ";; ERROR: no nameservers\n" if $self->{'debug'};
return;
}
my $packet = $self->make_query_packet($dname, 'AXFR', $class);
my $packet_data = $packet->data;
my $ns = $self->{'nameservers'}->[0];
print ";; axfr nameserver = $ns\n" if $self->{'debug'};
my $srcport = $self->{'srcport'};
my $sock;
my $sock_key = "$ns:$self->{'port'}";
if ($self->{'persistent_tcp'} && $self->{'sockets'}{$sock_key}) {
$sock = $self->{'sockets'}{$sock_key};
print ";; using persistent socket\n" if $self->{'debug'};
}
else {
# IO::Socket carps on errors if Perl's -w flag is turned on.
# Uncomment the next two lines and the line following the "new"
# call to turn off these messages.
my $old_wflag = $^W;
$^W = 0;
$sock = IO::Socket::INET->new(
PeerAddr => $ns,
PeerPort => $self->{'port'},
LocalAddr => $self->{'srcaddr'},
LocalPort => ($srcport || undef),
Proto => 'tcp',
Timeout => $self->{'tcp_timeout'}
);
$^W = $old_wflag;
unless ($sock) {
$self->errorstring(q|couldn't connect|);
return;
}
$self->{'sockets'}{$sock_key} = $sock;
}
my $lenmsg = pack('n', length($packet_data));
unless ($sock->send($lenmsg)) {
$self->errorstring($!);
return;
}
unless ($sock->send($packet_data)) {
$self->errorstring($!);
return;
}
my $sel = Net::DNS::Select->new($sock);
my @zone;
my $soa_count = 0;
my $timeout = $self->{'tcp_timeout'};
while (1) {
my @ready = $sel->can_read($timeout);
unless (@ready) {
$self->errorstring('timeout');
return;
}
my $buf = read_tcp($sock, &Net::DNS::INT16SZ, $self->{'debug'});
last unless length($buf);
my ($len) = unpack('n', $buf);
last unless $len;
@ready = $sel->can_read($timeout);
unless (@ready) {
$self->errorstring('timeout');
return;
}
$buf = read_tcp($sock, $len, $self->{'debug'});
print ';; received ', length($buf), " bytes\n"
if $self->{'debug'};
unless (length($buf) == $len) {
$self->errorstring("expected $len bytes, received " . length($buf));
return;
}
my ($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
if (defined $ans) {
if ($ans->header->ancount < 1) {
$self->errorstring($ans->header->rcode);
last;
}
}
elsif (defined $err) {
$self->errorstring($err);
last;
}
foreach ($ans->answer) {
# $_->print if $self->{'debug'};
if ($_->type eq 'SOA') {
++$soa_count;
push @zone, $_ unless $soa_count >= 2;
}
else {
push @zone, $_;
}
}
last if $soa_count >= 2;
}
return @zone;
}
sub axfr_start {
my $self = shift;
my ($dname, $class) = @_;
$dname ||= $self->{'searchlist'}->[0];
$class ||= 'IN';
unless ($dname) {
print ";; ERROR: axfr: no zone specified\n" if $self->{'debug'};
$self->errorstring('no zone');
return;
}
print ";; axfr_start($dname, $class)\n" if $self->{'debug'};
unless (@{$self->{'nameservers'}}) {
$self->errorstring('no nameservers');
print ";; ERROR: no nameservers\n" if $self->{'debug'};
return;
}
my $packet = $self->make_query_packet($dname, 'AXFR', $class);
my $packet_data = $packet->data;
my $ns = $self->{'nameservers'}->[0];
print ";; axfr_start nameserver = $ns\n" if $self->{'debug'};
my $srcport = $self->{'srcport'};
my $sock;
my $sock_key = "$ns:$self->{'port'}";
if ($self->{'persistent_tcp'} && $self->{'sockets'}->{$sock_key}) {
$sock = $self->{'sockets'}->{$sock_key};
print ";; using persistent socket\n" if $self->{'debug'};
} else {
# IO::Socket carps on errors if Perl's -w flag is turned on.
# Uncomment the next two lines and the line following the "new"
# call to turn off these messages.
#my $old_wflag = $^W;
#$^W = 0;
$sock = IO::Socket::INET->new(
PeerAddr => $ns,
PeerPort => $self->{'port'},
LocalAddr => $self->{'srcaddr'},
LocalPort => ($srcport || undef),
Proto => 'tcp',
Timeout => $self->{'tcp_timeout'}
);
#$^W = $old_wflag;
unless ($sock) {
$self->errorstring(q|couldn't connect|);
return;
}
$self->{'sockets'}->{$sock_key} = $sock;
}
my $lenmsg = pack('n', length($packet_data));
unless ($sock->send($lenmsg)) {
$self->errorstring($!);
return;
}
unless ($sock->send($packet_data)) {
$self->errorstring($!);
return;
}
my $sel = Net::DNS::Select->new($sock);
$self->{'axfr_sel'} = $sel;
$self->{'axfr_rr'} = [];
$self->{'axfr_soa_count'} = 0;
return $sock;
}
sub axfr_next {
my $self = shift;
my $err = '';
unless (@{$self->{'axfr_rr'}}) {
unless ($self->{'axfr_sel'}) {
$err = 'no zone transfer in progress';
$self->errorstring($err);
return wantarray ? (undef, $err) : undef;
}
my $sel = $self->{'axfr_sel'};
my $timeout = $self->{'tcp_timeout'};
#--------------------------------------------------------------
# Read the length of the response packet.
#--------------------------------------------------------------
my @ready = $sel->can_read($timeout);
unless (@ready) {
$err = 'timeout';
$self->errorstring($err);
return wantarray ? (undef, $err) : undef;
}
my $buf = read_tcp($ready[0], &Net::DNS::INT16SZ, $self->{'debug'});
unless (length $buf) {
$err = 'truncated zone transfer';
$self->errorstring($err);
return wantarray ? (undef, $err) : undef;
}
my ($len) = unpack('n', $buf);
unless ($len) {
$err = 'truncated zone transfer';
$self->errorstring($err);
return wantarray ? (undef, $err) : undef;
}
#--------------------------------------------------------------
# Read the response packet.
#--------------------------------------------------------------
@ready = $sel->can_read($timeout);
unless (@ready) {
$err = 'timeout';
$self->errorstring($err);
return wantarray ? (undef, $err) : undef;
}
$buf = read_tcp($ready[0], $len, $self->{'debug'});
print ';; received ', length($buf), " bytes\n"
if $self->{'debug'};
unless (length($buf) == $len) {
$err = "expected $len bytes, received " . length($buf);
$self->errorstring($err);
print ";; $err\n" if $self->{'debug'};
return wantarray ? (undef, $err) : undef;
}
my $ans;
($ans, $err) = Net::DNS::Packet->new(\$buf, $self->{'debug'});
if ($ans) {
if ($ans->header->rcode ne 'NOERROR') {
$self->errorstring('Response code from server: ' . $ans->header->rcode);
print ';; Response code from server: ' . $ans->header->rcode . "\n" if $self->{'debug'};
return wantarray ? (undef, $err) : undef;
}
if ($ans->header->ancount < 1) {
$err = 'truncated zone transfer';
$self->errorstring($err);
print ";; $err\n" if $self->{'debug'};
return wantarray ? (undef, $err) : undef;
}
}
else {
$err ||= 'unknown error during packet parsing';
$self->errorstring($err);
print ";; $err\n" if $self->{'debug'};
return wantarray ? (undef, $err) : undef;
}
foreach my $rr ($ans->answer) {
if ($rr->type eq 'SOA') {
if (++$self->{'axfr_soa_count'} < 2) {
push @{$self->{'axfr_rr'}}, $rr;
}
}
else {
push @{$self->{'axfr_rr'}}, $rr;
}
}
if ($self->{'axfr_soa_count'} >= 2) {
$self->{'axfr_sel'} = undef;
}
}
my $rr = shift @{$self->{'axfr_rr'}};
return wantarray ? ($rr, undef) : $rr;
}
sub tsig {
my $self = shift;
if (@_ == 1) {
if ($_[0] && ref($_[0])) {
$self->{'tsig_rr'} = $_[0];
}
else {
$self->{'tsig_rr'} = undef;
}
}
elsif (@_ == 2) {
my ($key_name, $key) = @_;
$self->{'tsig_rr'} = Net::DNS::RR->new("$key_name TSIG $key");
}
return $self->{'tsig_rr'};
}
#
# Usage: $data = read_tcp($socket, $nbytes, $debug);
#
sub read_tcp {
my ($sock, $nbytes, $debug) = @_;
my $buf = '';
while (length($buf) < $nbytes) {
my $nread = $nbytes - length($buf);
my $read_buf = '';
print ";; read_tcp: expecting $nread bytes\n" if $debug;
# During some of my tests recv() returned undef even
# though there wasn't an error. Checking for the amount
# of data read appears to work around that problem.
unless ($sock->recv($read_buf, $nread)) {
if (length($read_buf) < 1) {
my $errstr = $!;
print ";; ERROR: read_tcp: recv failed: $!\n"
if $debug;
if ($errstr eq 'Resource temporarily unavailable') {
warn "ERROR: read_tcp: recv failed: $errstr\n";
warn "ERROR: try setting \$res->timeout(undef)\n";
}
last;
}
}
print ';; read_tcp: received ', length($read_buf), " bytes\n"
if $debug;
last unless length($read_buf);
$buf .= $read_buf;
}
return $buf;
}
sub AUTOLOAD {
my ($self) = @_;
my $name = $AUTOLOAD;
$name =~ s/.*://;
Carp::croak "$name: no such method" unless exists $self->{$name};
no strict q/refs/;
*{$AUTOLOAD} = sub {
my ($self, $new_val) = @_;
if (defined $new_val) {
$self->{"$name"} = $new_val;
}
return $self->{"$name"};
};
goto &{$AUTOLOAD};
}
1;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -