--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <assert.h>
+#include <netdb.h> /* NI_MAXHOST */
+#include <oping.h>
+
+MODULE = Net::Oping PACKAGE = Net::Oping
+
+PROTOTYPES: DISABLE
+
+pingobj_t *
+_ping_construct ()
+ CODE:
+ RETVAL = ping_construct ();
+ OUTPUT:
+ RETVAL
+
+void
+_ping_destroy (obj);
+ pingobj_t *obj
+ CODE:
+ ping_destroy(obj);
+
+int
+_ping_setopt_timeout (obj, timeout)
+ pingobj_t *obj
+ double timeout
+ CODE:
+ RETVAL = ping_setopt (obj, PING_OPT_TIMEOUT, &timeout);
+ OUTPUT:
+ RETVAL
+
+int
+_ping_setopt_source (obj, addr)
+ pingobj_t *obj
+ char *addr
+ CODE:
+ RETVAL = ping_setopt (obj, PING_OPT_SOURCE, addr);
+ OUTPUT:
+ RETVAL
+
+int
+_ping_host_add (obj, host);
+ pingobj_t *obj
+ const char *host
+ CODE:
+ RETVAL = ping_host_add (obj, host);
+ OUTPUT:
+ RETVAL
+
+int
+_ping_host_remove (obj, host)
+ pingobj_t *obj
+ const char *host
+ CODE:
+ RETVAL = ping_host_remove (obj, host);
+ OUTPUT:
+ RETVAL
+
+int
+_ping_send (obj)
+ pingobj_t *obj
+ CODE:
+ RETVAL=ping_send (obj);
+ OUTPUT:
+ RETVAL
+
+pingobj_iter_t *
+_ping_iterator_get (obj)
+ pingobj_t *obj
+ CODE:
+ RETVAL = ping_iterator_get (obj);
+ OUTPUT:
+ RETVAL
+
+pingobj_iter_t *
+_ping_iterator_next (iter)
+ pingobj_iter_t *iter
+ CODE:
+ RETVAL = ping_iterator_next (iter);
+ OUTPUT:
+ RETVAL
+
+double
+_ping_iterator_get_latency (iter)
+ pingobj_iter_t *iter
+ CODE:
+ double tmp;
+ size_t tmp_size;
+ int status;
+
+ RETVAL = -1.0;
+
+ tmp_size = sizeof (tmp);
+ status = ping_iterator_get_info (iter, PING_INFO_LATENCY,
+ (void *) &tmp, &tmp_size);
+ if (status == 0)
+ RETVAL = tmp;
+ OUTPUT:
+ RETVAL
+
+char *
+_ping_iterator_get_hostname (iter)
+ pingobj_iter_t *iter
+ CODE:
+ char *buffer;
+ size_t buffer_size;
+ int status;
+
+ RETVAL = NULL;
+
+ do {
+ buffer = NULL;
+ buffer_size = 0;
+ status = ping_iterator_get_info (iter, PING_INFO_HOSTNAME,
+ (void *) buffer, &buffer_size);
+ if (status != ENOMEM)
+ break;
+
+ /* FIXME: This is a workaround for a bug in 0.3.5. */
+ buffer_size++;
+
+ buffer = (char *) malloc (buffer_size);
+ if (buffer == NULL)
+ break;
+
+ status = ping_iterator_get_info (iter, PING_INFO_HOSTNAME,
+ (void *) buffer, &buffer_size);
+ if (status != 0)
+ break;
+
+ RETVAL = buffer;
+ } while (0);
+ OUTPUT:
+ RETVAL
+
+const char *
+_ping_get_error (obj)
+ pingobj_t *obj
+ CODE:
+ RETVAL = ping_get_error(obj);
+ OUTPUT:
+ RETVAL
--- /dev/null
+Net::Oping version 1.00
+=======================
+
+ ICMP latency measurement module using the oping library.
+
+DESCRIPTION
+
+ This Perl module is a high-level interface to the oping library. Its purpose
+ it to send "ICMP ECHO_REQUEST" packets (also known as "ping") to a host and
+ measure the time that elapses until the reception of an "ICMP ECHO_REPLY"
+ packet (also known as "pong"). If no such packet is received after a certain
+ timeout the host is considered to be unreachable.
+
+ The used "oping" library supports "ping"ing multiple hosts in parallel and
+ works with IPv4 and IPv6 transparently. Other advanced features that are
+ provided by the underlying library, such as setting the data sent or
+ configuring the time of live (TTL) are not yet supported by this interface.
+
+INSTALLATION
+
+ This module is compiled and installed in the standard Perl way:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+ This module requires the "oping" library to be installed. The library is
+ available at <http://verplant.org/liboping/>.
+
+COPYRIGHT AND LICENSE
+
+ Copyright (C) 2007 by Olivier Fredj <ofredj at proxad.net>
+
+ Copyright (C) 2008 by Florian Forster <octo at verplant.org>
+
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself, either Perl version 5.8.7 or, at your
+ option, any later version of Perl 5 you may have available.
--- /dev/null
+package Net::Oping;
+
+=head1 NAME
+
+Net::Oping - ICMP latency measurement module using the oping library.
+
+=head1 SYNOPSIS
+
+ use Net::Oping;
+
+ my $obj = Net::Oping->new ();
+ $obj->host_add (qw(one.example.org two.example.org));
+
+ my $ret = $obj->ping ();
+ print "Latency to `one' is " . $ret->{'one.example.org'} . "\n";
+
+=head1 DESCRIPTION
+
+This Perl module is a high-level interface to the
+L<oping library|http://verplant.org/liboping/>. Its purpose it to send C<ICMP
+ECHO_REQUEST> packets (also known as "ping") to a host and measure the time
+that elapses until the reception of an C<ICMP ECHO_REPLY> packet (also known as
+"pong"). If no such packet is received after a certain timeout the host is considered to be unreachable.
+
+The used C<oping> library supports "ping"ing multiple hosts in parallel and
+works with IPv4 and IPv6 transparently. Other advanced features that are
+provided by the underlying library, such as setting the data sent or
+configuring the time of live (TTL) are not yet supported by this interface.
+
+=cut
+
+use 5.008007;
+
+use strict;
+use warnings;
+
+use Carp (qw(cluck confess));
+
+our $VERSION = '1.00';
+
+require XSLoader;
+XSLoader::load('Net::Oping', $VERSION);
+return (1);
+
+=head1 INTERFACE
+
+The interface is kept simple and clean. First you need to create an object to
+which you then add hosts. Using the C<ping> method you can request a latency
+measurement and get the current values returned. If neccessary you can remove
+hosts from the object, too.
+
+The constructor and methods are defined as follows:
+
+=over 4
+
+=item my I<$obj> = Net::Oping-E<gt>B<new> ();
+
+Creates and returns a new object.
+
+=cut
+
+sub new
+{
+ my $pkg = shift;
+ my $ping_obj = _ping_construct ();
+
+ my $obj = bless ({ c_obj => $ping_obj }, $pkg);
+ return ($obj);
+}
+
+sub DESTROY
+{
+ my $obj = shift;
+ _ping_destroy ($obj->{'c_obj'});
+}
+
+=item my I<$status> = I<$obj>-E<gt>B<timeout> (I<$timeout>);
+
+Sets the timeout before a host is considered unreachable to I<$timeout>
+seconds, which may be a floating point number to specify fractional seconds.
+
+=cut
+
+sub timeout
+{
+ my $obj = shift;
+ my $timeout = shift;
+ my $status;
+
+ $status = _ping_setopt_timeout ($obj->{'c_obj'}, $timeout);
+ if ($status != 0)
+ {
+ $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+ return;
+ }
+
+ return (1);
+}
+
+=item my I<$status> = I<$obj>-E<gt>B<bind> (I<$ip_addr>);
+
+Sets the source IP-address to use. I<$ip_addr> must be a string containing an
+IP-address, such as "192.168.0.1" or "2001:f00::1". As a side-effect this will
+set the address-family (IPv4 or IPv6) to a fixed, value, too, for obvious
+reasons.
+
+=cut
+
+sub bind
+{
+ my $obj = shift;
+ my $addr = shift;
+ my $status;
+
+ $status = _ping_setopt_source ($obj->{'c_obj'}, $addr);
+ if ($status != 0)
+ {
+ $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+ return;
+ }
+
+ return (1);
+}
+
+=item my I<$status> = I<$obj>-E<gt>B<host_add> (I<$host>, [I<$host>, ...]);
+
+Adds one or more hosts to the Net::Oping-object I<$obj>. The number of
+successfully added hosts is returned. If this number differs from the number of
+hosts that were passed to the method you can use B<get_error> (see below) to
+get the error message of the last failure.
+
+=cut
+
+sub host_add
+{
+ my $obj = shift;
+ my $i;
+
+ $i = 0;
+ for (@_)
+ {
+ my $status = _ping_host_add ($obj->{'c_obj'}, $_);
+ if ($status != 0)
+ {
+ $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+ }
+ else
+ {
+ $i++;
+ }
+ }
+
+ return ($i);
+}
+
+=item my I<$status> = I<$obj>-E<gt>B<host_remove> (I<$host>, [I<$host>, ...]);
+
+Same semantic as B<host_add> but removes hosts.
+
+=cut
+
+sub host_remove
+{
+ my $obj = shift;
+ my $i;
+
+ $i = 0;
+ for (@_)
+ {
+ my $status = _ping_host_remove ($obj->{'c_obj'}, $_);
+ if ($status != 0)
+ {
+ $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+ }
+ else
+ {
+ $i++;
+ }
+ }
+ return ($i);
+}
+
+=item my I<$latency> = I<$obj>-E<gt>B<ping> ()
+
+The central method of this module sends ICMP packets to the hosts and waits for
+replies. The time it takes for replies to arrive is measured and returned.
+
+The returned scalar is a hash reference where each host associated with the
+I<$obj> object is a key and the associated value is the corresponding latency
+in milliseconds. An example hash reference would be:
+
+ $latency = { host1 => 51.143, host2 => undef, host3 => 54.697, ... };
+
+If a value is C<undef>, as for "host2" in this example, the host has timed out
+and considered unreachable.
+
+=cut
+
+sub ping
+{
+ my $obj = shift;
+ my $iter;
+ my $data = {};
+ my $status;
+
+ $status = _ping_send ($obj->{'c_obj'});
+ if ($status < 0)
+ {
+ print "\$status = $status;\n";
+ $obj->{'err_msg'} = "" . _ping_get_error ($obj->{'c_obj'});
+ return;
+ }
+
+ $iter = _ping_iterator_get ($obj->{'c_obj'});
+ while ($iter)
+ {
+ my $host = _ping_iterator_get_hostname ($iter);
+ if (!$host)
+ {
+ $iter = _ping_iterator_next ($iter);
+ next;
+ }
+
+ my $latency = _ping_iterator_get_latency ($iter);
+ if ($latency < 0.0)
+ {
+ $latency = undef;
+ }
+
+ $data->{$host} = $latency;
+
+ $iter = _ping_iterator_next ($iter);
+ }
+
+ return ($data);
+}
+
+=item my I<$errmsg> = I<$obj>-E<gt>B<get_error> ();
+
+Returns the last error that occured.
+
+=cut
+
+sub get_error
+{
+ my $obj = shift;
+ return ($obj->{'err_msg'} || 'Success');
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<liboping(3)>
+
+The C<liboping> homepage may be found at L<http://verplant.org/liboping/>.
+Information about its mailing list may be found at
+L<http://mailman.verplant.org/listinfo/liboping>.
+
+=head1 AUTHOR
+
+First XSE<nbsp>port by Olivier Fredj, extended XS functionality and high-level
+Perl interface by Florian Forster.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007 by Olivier Fredj E<lt>ofredjE<nbsp>atE<nbsp>proxad.netE<gt>
+
+Copyright (C) 2008 by Florian Forster
+E<lt>octoE<nbsp>atE<nbsp>verplant.orgE<gt>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
+# vim: set shiftwidth=2 softtabstop=2 tabstop=8 :
projects / liboping.git / commitdiff