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
|
package Smokeping::probes::SipSak;
=head1 301 Moved Permanently
This is a Smokeping probe module. Please use the command
C<smokeping -man Smokeping::probes::SipSak>
to view the documentation or the command
C<smokeping -makepod Smokeping::probes::SipSak>
to generate the POD document.
=cut
use strict;
use base qw(Smokeping::probes::basefork);
use Carp;
sub pod_hash {
return {
name => <<DOC,
Smokeping::probes::SipSak - tests sip server
DOC
overview => <<DOC,
This probe sends OPTIONS messages to a sip server testing the latency.
DOC
description => <<DOC,
The probe uses the L<sipsak|http://sipsak.org/> tool to measure sip server latency by sending an OPTIONS message.
The sipsak command supports a large number of additional parameters to fine-tune its operation. Use the
params variable to configure them.
DOC
authors => <<'DOC',
Tobias Oetiker <tobi@oetiker.ch> sponsored by ANI Networks
DOC
}
}
sub ProbeDesc ($) {
my $self = shift;
return sprintf("SIP OPTIONS messages");
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
return $self;
}
sub pingone {
my $self = shift;
my $target = shift;
my $host = $target->{addr};
my $vars = $target->{vars};
my @times;
my $elapsed;
my $pingcount = $self->pings($target);
my $keep = $vars->{keep_second};
$host = $vars->{user}.'@'.$host if $vars->{user};
$host = $host . ':' . $vars->{port} if $vars->{port};
my @extra_opts = ();
@extra_opts = split /\s/, $vars->{params} if $vars->{params};
open (my $sak,'-|',$self->{properties}{binary},'-vv','-A',$pingcount,'-s','sip:'.$host,@extra_opts)
or die("ERROR: $target->{binary}: $!\n");
my $reply = join ("",<$sak>);
close $sak;
my @reply = split /\*\*\sreply/, $reply;
# don't need the stuff before the first replyx
shift @reply;
my $filter = '.*';
if (scalar @reply > $pingcount){
$filter = $keep eq 'yes' ? 'final' : 'provisional';
}
for my $item (@reply){
next unless $item =~ /$filter/;
if (/^(?:\s+and|\sreceived\safter)\s(\d+(?:\.\d+))\sms\s/){
push @times,$1/1000;
}
}
return sort { $a <=> $b } @times;
}
sub probevars {
my $class = shift;
my $h = $class->SUPER::probevars;
return $class->_makevars($h, {
binary => {
_doc => "The location of your echoping binary.",
_default => '/usr/bin/sipsak',
_sub => sub {
my $val = shift;
-x $val or return "ERROR: binary '$val' is not executable";
return undef;
},
},
});
}
sub targetvars {
my $class = shift;
return $class->_makevars($class->SUPER::targetvars, {
user => {
_doc => "User to use for sip connection.",
_example => 'nobody',
},
port => {
_doc => "usa non-default port for the sip connection.",
_example => 5061,
},
params => {
_doc => "additional sipsak options. The options will get split on space.",
_example => '--numeric --password=mysecret'
},
keep_second => {
_doc => "If OPTIONS is actually implemented by the server, SipSak will receive two responses. If this option is set, the timeing from the second, final response will be counter",
_example => 'yes',
_re => 'yes|no'
}
});
}
1;
|
