bindings/perl/lib/Net/Oping.pm

   1 #
   2 # Net-Oping - lib/Net/Oping.pm
   3 # Copyright (C) 2007       Olivier Fredj
   4 # Copyright (C) 2008,2009  Florian octo Forster
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; only version 2 of the License is
   9 # applicable.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  19 #
  20 # Authors:
  21 #   Olivier Fredj <ofredj at proxad.net>
  22 #   Florian octo Forster <octo at verplant.org>
  23 #
  24
  25 package Net::Oping;
  26
  27 =head1 NAME
  28
  29 Net::Oping - ICMP latency measurement module using the oping library.
  30
  31 =head1 SYNOPSIS
  32
  33   use Net::Oping;
  34
  35   my $obj = Net::Oping->new ();
  36   $obj->host_add (qw(one.example.org two.example.org));
  37
  38   my $ret = $obj->ping ();
  39   print "Latency to `one' is " . $ret->{'one.example.org'} . "\n";
  40
  41 =head1 DESCRIPTION
  42
  43 This Perl module is a high-level interface to the
  44 L<oping library|http://verplant.org/liboping/>. Its purpose it to send
  45 C<ICMP ECHO_REQUEST> packets (also known as "ping") to a host and measure the
  46 time that elapses until the reception of an C<ICMP ECHO_REPLY> packet (also
  47 known as "pong"). If no such packet is received after a certain timeout the
  48 host is considered to be unreachable.
  49
  50 The used I<oping> library supports "ping"ing multiple hosts in parallel and
  51 works with IPv4 and IPv6 transparently. Other advanced features that are
  52 provided by the underlying library, such as setting the data sent or
  53 configuring the time of live (TTL) are not yet supported by this interface.
  54
  55 =cut
  56
  57 use 5.006;
  58
  59 use strict;
  60 use warnings;
  61
  62 use Carp (qw(cluck confess));
  63
  64 our $VERSION = '1.02';
  65
  66 require XSLoader;
  67 XSLoader::load ('Net::Oping', $VERSION);
  68 return (1);
  69
  70 =head1 INTERFACE
  71
  72 The interface is kept simple and clean. First you need to create an object to
  73 which you then add hosts. Using the C<ping> method you can request a latency
  74 measurement and get the current values returned. If necessary you can remove
  75 hosts from the object, too.
  76
  77 The constructor and methods are defined as follows:
  78
  79 =over 4
  80
  81 =item my I<$obj> = Net::Oping-E<gt>B<new> ();
  82
  83 Creates and returns a new object.
  84
  85 =cut
  86
  87 sub new
  88 {
  89   my $pkg = shift;
  90   my $ping_obj = _ping_construct ();
  91
  92   my $obj = bless ({ c_obj => $ping_obj }, $pkg);
  93   return ($obj);
  94 }
  95
  96 sub DESTROY
  97 {
  98   my $obj = shift;
  99   _ping_destroy ($obj->{'c_obj'});
 100 }
 101
 102 =item my I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);
 103
 104 Sets the timeout before a host is considered unreachable to I<$timeout>
 105 seconds, which may be a floating point number to specify fractional seconds.
 106
 107 =cut
 108
 109 sub timeout
 110 {
 111   my $obj = shift;
 112   my $timeout = shift;
 113   my $status;
 114
 115   $status = _ping_setopt_timeout ($obj->{'c_obj'}, $timeout);
 116   if ($status != 0)
 117   {
 118     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 119     return;
 120   }
 121
 122   return (1);
 123 }
 124
 125 =item my I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);
 126
 127 Sets the source IP-address to use. I<$ip_addr> must be a string containing an
 128 IP-address, such as "192.168.0.1" or "2001:f00::1". As a side-effect this will
 129 set the address-family (IPv4 or IPv6) to a fixed, value, too, for obvious
 130 reasons.
 131
 132 =cut
 133
 134 sub bind
 135 {
 136   my $obj = shift;
 137   my $addr = shift;
 138   my $status;
 139
 140   $status = _ping_setopt_source ($obj->{'c_obj'}, $addr);
 141   if ($status != 0)
 142   {
 143     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 144     return;
 145   }
 146
 147   return (1);
 148 }
 149
 150 =item my I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);
 151
 152 Adds one or more hosts to the Net::Oping-object I<$obj>. The number of
 153 successfully added hosts is returned. If this number differs from the number of
 154 hosts that were passed to the method you can use B<get_error> (see below) to
 155 get the error message of the last failure.
 156
 157 =cut
 158
 159 sub host_add
 160 {
 161   my $obj = shift;
 162   my $i;
 163
 164   $i = 0;
 165   for (@_)
 166   {
 167     my $status = _ping_host_add ($obj->{'c_obj'}, $_);
 168     if ($status != 0)
 169     {
 170       $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 171     }
 172     else
 173     {
 174       $i++;
 175     }
 176   }
 177
 178   return ($i);
 179 }
 180
 181 =item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
 182
 183 Same semantic as B<host_add> but removes hosts.
 184
 185 =cut
 186
 187 sub host_remove
 188 {
 189   my $obj = shift;
 190   my $i;
 191
 192   $i = 0;
 193   for (@_)
 194   {
 195     my $status = _ping_host_remove ($obj->{'c_obj'}, $_);
 196     if ($status != 0)
 197     {
 198       $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 199     }
 200     else
 201     {
 202       $i++;
 203     }
 204   }
 205   return ($i);
 206 }
 207
 208 =item my I<$latency> = I<$obj>-E<gt>B<ping> ()
 209
 210 The central method of this module sends ICMP packets to the hosts and waits for
 211 replies. The time it takes for replies to arrive is measured and returned.
 212
 213 The returned scalar is a hash reference where each host associated with the
 214 I<$obj> object is a key and the associated value is the corresponding latency
 215 in milliseconds. An example hash reference would be:
 216
 217   $latency = { host1 => 51.143, host2 => undef, host3 => 54.697, ... };
 218
 219 If a value is C<undef>, as for "host2" in this example, the host has timed out
 220 and considered unreachable.
 221
 222 =cut
 223
 224 sub ping
 225 {
 226   my $obj = shift;
 227   my $iter;
 228   my $data = {};
 229   my $status;
 230
 231   $status = _ping_send ($obj->{'c_obj'});
 232   if ($status < 0)
 233   {
 234     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 235     return;
 236   }
 237
 238   $iter = _ping_iterator_get ($obj->{'c_obj'});
 239   if (!$iter)
 240   {
 241     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 242     return;
 243   }
 244
 245   while ($iter)
 246   {
 247     my $host = _ping_iterator_get_hostname ($iter);
 248     if (!$host)
 249     {
 250       $iter = _ping_iterator_next ($iter);
 251       next;
 252     }
 253
 254     my $latency = _ping_iterator_get_latency ($iter);
 255     if ($latency < 0.0)
 256     {
 257       $latency = undef;
 258     }
 259
 260     $data->{$host} = $latency;
 261
 262     $iter = _ping_iterator_next ($iter);
 263   }
 264
 265   return ($data);
 266 } # ping
 267
 268 =item my I<$dropped> = I<$obj>-E<gt>B<get_dropped> ()
 269
 270 Returns a hash reference holding the number of "drops" (echo requests which
 271 were not answered in time) for each host. An example return
 272 values would be:
 273
 274   $droprate = { host1 => 0, host2 => 3, host3 => undef, ... };
 275
 276 Hosts to which no data has been sent yet will return C<undef> ("host3" in thie
 277 example).
 278
 279 =cut
 280
 281 sub get_dropped
 282 {
 283   my $obj = shift;
 284   my $iter;
 285   my $data = {};
 286
 287   $iter = _ping_iterator_get ($obj->{'c_obj'});
 288   if (!$iter)
 289   {
 290     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 291     return;
 292   }
 293
 294   while ($iter)
 295   {
 296     my $host = _ping_iterator_get_hostname ($iter);
 297     if (!$host)
 298     {
 299       $iter = _ping_iterator_next ($iter);
 300       next;
 301     }
 302
 303     my $dropped = _ping_iterator_get_dropped ($iter);
 304     if ($dropped < 0)
 305     {
 306       $dropped = undef;
 307     }
 308
 309     $data->{$host} = $dropped;
 310
 311     $iter = _ping_iterator_next ($iter);
 312   }
 313
 314   return ($data);
 315 } # get_dropped
 316
 317 =item my I<$dropped> = I<$obj>-E<gt>B<get_recv_ttl> ()
 318
 319 Returns a hash reference holding the I<Time to Live> (TTL) of the last received
 320 packet for each host. An example return value would be:
 321
 322   $ttl = { host1 => 60, host2 => 41, host3 => 243, ... };
 323
 324 To signal an invalid or unavailable TTL, a negative number is returned.
 325
 326 =cut
 327
 328 sub get_recv_ttl
 329 {
 330   my $obj = shift;
 331   my $iter;
 332   my $data = {};
 333
 334   $iter = _ping_iterator_get ($obj->{'c_obj'});
 335   if (!$iter)
 336   {
 337     $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
 338     return;
 339   }
 340
 341   while ($iter)
 342   {
 343     my $host = _ping_iterator_get_hostname ($iter);
 344     if ($host)
 345     {
 346       $data->{$host} = _ping_iterator_get_recv_ttl ($iter);
 347     }
 348
 349     $iter = _ping_iterator_next ($iter);
 350   }
 351
 352   return ($data);
 353 } # get_recv_ttl
 354
 355 =item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
 356
 357 Returns the last error that occurred.
 358
 359 =cut
 360
 361 sub get_error
 362 {
 363   my $obj = shift;
 364   return ($obj->{'err_msg'} || 'Success');
 365 }
 366
 367 =back
 368
 369 =head1 CAVEATS
 370
 371 The I<oping> library opens a raw socket to be able to send ICMP packets. On
 372 most systems normal users are not allowed to do this. This is why on most
 373 systems the L<ping(1)> utility is installed as SetUID-root. Since, when using
 374 this module, no external process is spawned B<this> process needs the
 375 appropriate permissions. This means that either your script has to run as
 376 superuser or, under Linux, needs the C<CAP_NET_RAW> capability.
 377
 378 =head1 SEE ALSO
 379
 380 L<liboping(3)>
 381
 382 The I<liboping> homepage may be found at L<http://verplant.org/liboping/>.
 383 Information about its mailing list may be found at
 384 L<http://mailman.verplant.org/listinfo/liboping>.
 385
 386 =head1 AUTHOR
 387
 388 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
 389 Perl interface by Florian Forster.
 390
 391 =head1 COPYRIGHT AND LICENSE
 392
 393 Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
 394
 395 Copyright (C) 2008,2009 by Florian Forster
 396 E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
 397
 398 This library is free software; you can redistribute it and/or modify
 399 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 400 at your option, any later version of Perl 5 you may have available.
 401
 402 Please note that I<liboping> is licensed under the GPLv2. Derived works of
 403 both, I<Net::Oping> and I<liboping>, (i.E<nbsp>e. binary packages) may
 404 therefore be subject to stricter licensing terms than the source code of this
 405 package.
 406
 407 =cut
 408
 409 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :