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
|
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;
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,
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};
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 => <<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+',
},
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;
|
