summaryrefslogtreecommitdiffstats
path: root/lib/Smokeping/probes/AnotherDNS.pm
diff options
context:
space:
mode:
authorNiko Tyni <ntyni@iki.fi>2005-02-13 20:23:04 +0100
committerNiko Tyni <ntyni@iki.fi>2005-02-13 20:23:04 +0100
commit6d76521656e91daa160bc8019828f1b68d7aa5dc (patch)
treeaaa27615a0702942fa1606d9a5c89f0a3547467c /lib/Smokeping/probes/AnotherDNS.pm
parent6dba1afbe4b475a7d34f5ef867b7b37291cd1484 (diff)
downloadsmokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.gz
smokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.xz
Moved probes, matchers and ciscoRttMonMIB modules to lib/Smokeping.
Diffstat (limited to 'lib/Smokeping/probes/AnotherDNS.pm')
-rw-r--r--lib/Smokeping/probes/AnotherDNS.pm157
1 files changed, 157 insertions, 0 deletions
diff --git a/lib/Smokeping/probes/AnotherDNS.pm b/lib/Smokeping/probes/AnotherDNS.pm
new file mode 100644
index 0000000..6d5a63f
--- /dev/null
+++ b/lib/Smokeping/probes/AnotherDNS.pm
@@ -0,0 +1,157 @@
+package Smokeping::probes::AnotherDNS;
+
+=head1 301 Moved Permanently
+
+This is a Smokeping probe module. Please use the command
+
+C<smokeping -man Smokeping::probes::AnotherDNS>
+
+to view the documentation or the command
+
+C<smokeping -makepod Smokeping::probes::AnotherDNS>
+
+to generate the POD document.
+
+=cut
+
+use strict;
+
+# And now, an extra ugly hack
+# Reason: Net::DNS does an eval("use Win32:Registry") to
+# find out if it is running on Windows. This triggers the signal
+# handler in the cgi mode.
+
+my $tmp = $SIG{__DIE__};
+$SIG{__DIE__} = sub { };
+eval("use Net::DNS;");
+$SIG{__DIE__} = $tmp;
+
+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;
+
+sub pod_hash {
+ return {
+ name => <<DOC,
+Smokeping::probes::AnotherDNS - Alternate DNS Probe
+DOC
+ description => <<DOC,
+Like DNS, but uses Net::DNS and Time::HiRes instead of dig. This probe does
+*not* retry the request three times before it is considerd "lost", like dig and
+other resolver do by default. If operating as caching Nameserver, BIND (and
+maybe others) expect clients to retry the request if the answer is not in the
+cache. So, ask the nameserver for something that he is authoritative for if you
+want measure the network packet loss correctly.
+
+If you have a really fast network and nameserver, you will notice that this
+probe reports the query time in microsecond resolution. :-)
+DOC
+ authors => <<'DOC',
+Christoph Heine <Christoph.Heine@HaDiKo.DE>
+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};
+ $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 ) {
+ push @times, $elapsed;
+ my $buf = '';
+ $ready->recv( $buf, &Net::DNS::PACKETSZ );
+ }
+ }
+ @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 => <<DOC,
+Name of the host to look up in the dns.
+DOC
+ _example => 'www.example.org',
+ },
+ mininterval => {
+ _doc => <<DOC,
+Minimum time between sending two lookup queries in (possibly fractional) seconds.
+DOC
+ _default => .5,
+ _re => '(\d*\.)?\d+',
+ },
+ 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;
+