package Smokeping::probes::AnotherDNS; =head1 301 Moved Permanently This is a Smokeping probe module. Please use the command C to view the documentation or the command C to generate the POD document. =cut use strict; use base qw(Smokeping::probes::basefork); use IPC::Open3; use Symbol; use Carp; use Time::HiRes qw(sleep ualarm gettimeofday tv_interval); use IO::Socket; use IO::Select; use Net::DNS; sub pod_hash { return { name => < < <<'DOC', Christoph Heine DOC } } sub new($$$) { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new(@_); return $self; } sub ProbeDesc($) { my $self = shift; return "DNS requests"; } sub pingone ($) { my $self = shift; my $target = shift; my $host = $target->{addr}; my $lookuphost = $target->{vars}{lookup}; my $mininterval = $target->{vars}{mininterval}; my $recordtype = $target->{vars}{recordtype}; my $timeout = $target->{vars}{timeout}; my $port = $target->{vars}{port}; my $require_noerror = $target->{vars}{require_noerror}; $lookuphost = $target->{addr} unless defined $lookuphost; my $packet = Net::DNS::Packet->new( $lookuphost, $recordtype )->data; my $sock = IO::Socket::INET->new( "PeerAddr" => $host, "PeerPort" => $port, "Proto" => "udp", ); my $sel = IO::Select->new($sock); my @times; my $elapsed; for ( my $run = 0 ; $run < $self->pings($target) ; $run++ ) { if (defined $elapsed) { my $timeleft = $mininterval - $elapsed; sleep $timeleft if $timeleft > 0; } my $t0 = [gettimeofday()]; $sock->send($packet); my ($ready) = $sel->can_read($timeout); my $t1 = [gettimeofday()]; $elapsed = tv_interval( $t0, $t1 ); if ( defined $ready ) { my $buf = ''; $ready->recv( $buf, &Net::DNS::PACKETSZ ); my ($recvPacket, $err) = Net::DNS::Packet->new(\$buf); if (defined $recvPacket) { my $recvHeader = $recvPacket->header(); next if $recvHeader->ancount() < $target->{vars}{require_answers}; if (not $require_noerror) { push @times, $elapsed; } else { # Check the Response Code for the NOERROR. if ($recvHeader->rcode() eq "NOERROR") { push @times, $elapsed; } } } } } @times = map { sprintf "%.10e", $_ } sort { $a <=> $b } grep { $_ ne "-" } @times; return @times; } sub probevars { my $class = shift; my $h = $class->SUPER::probevars; delete $h->{timeout}; return $h; } sub targetvars { my $class = shift; return $class->_makevars($class->SUPER::targetvars, { lookup => { _doc => < 'www.example.org', }, mininterval => { _doc => < .5, _re => '(\d*\.)?\d+', }, require_noerror => { _doc => 'Only Count Answers with Response Status NOERROR.', _default => 0, }, require_answers => { _doc => 'Only Count Answers with answer count >= this value.', _default => 0, }, recordtype => { _doc => 'Record type to look up.', _default => 'A', }, timeout => { _doc => 'Timeout for a single request in seconds.', _default => 5, _re => '\d+', }, port => { _doc => 'The UDP Port to use.', _default => 53, _re => '\d+', }, }); } 1;