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 }
 267
 268 =item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
 269
 270 Returns the last error that occurred.
 271
 272 =cut
 273
 274 sub get_error
 275 {
 276   my $obj = shift;
 277   return ($obj->{'err_msg'} || 'Success');
 278 }
 279
 280 =back
 281
 282 =head1 CAVEATS
 283
 284 The I<oping> library opens a raw socket to be able to send ICMP packets. On
 285 most systems normal users are not allowed to do this. This is why on most
 286 systems the L<ping(1)> utility is installed as SetUID-root. Since, when using
 287 this module, no external process is spawned B<this> process needs the
 288 appropriate permissions. This means that either your script has to run as
 289 superuser or, under Linux, needs the C<CAP_NET_RAW> capability.
 290
 291 =head1 SEE ALSO
 292
 293 L<liboping(3)>
 294
 295 The I<liboping> homepage may be found at L<http://verplant.org/liboping/>.
 296 Information about its mailing list may be found at
 297 L<http://mailman.verplant.org/listinfo/liboping>.
 298
 299 =head1 AUTHOR
 300
 301 First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
 302 Perl interface by Florian Forster.
 303
 304 =head1 COPYRIGHT AND LICENSE
 305
 306 Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
 307
 308 Copyright (C) 2008,2009 by Florian Forster
 309 E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
 310
 311 This library is free software; you can redistribute it and/or modify
 312 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 313 at your option, any later version of Perl 5 you may have available.
 314
 315 Please note that I<liboping> is licensed under the GPLv2. Derived works of
 316 both, I<Net::Oping> and I<liboping>, (i.E<nbsp>e. binary packages) may
 317 therefore be subject to stricter licensing terms than the source code of this
 318 package.
 319
 320 =cut
 321
 322 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :