From e195217e2f501521019316d609df7fed4c62131d Mon Sep 17 00:00:00 2001 From: Florian Forster Date: Sat, 26 Jan 2008 13:57:05 +0100 Subject: [PATCH] bindings/perl: Added an improved version of the Perl bindings created by Olivier Fredj. --- bindings/perl/Changes | 9 ++ bindings/perl/MANIFEST | 10 ++ bindings/perl/META.yml | 10 ++ bindings/perl/Makefile.PL | 15 ++ bindings/perl/Oping.xs | 149 ++++++++++++++++++ bindings/perl/README | 41 +++++ bindings/perl/lib/Net/Oping.pm | 278 +++++++++++++++++++++++++++++++++ bindings/perl/t/Oping.t | 17 ++ bindings/perl/typemap | 3 + 9 files changed, 532 insertions(+) create mode 100644 bindings/perl/Changes create mode 100644 bindings/perl/MANIFEST create mode 100644 bindings/perl/META.yml create mode 100644 bindings/perl/Makefile.PL create mode 100644 bindings/perl/Oping.xs create mode 100644 bindings/perl/README create mode 100644 bindings/perl/lib/Net/Oping.pm create mode 100644 bindings/perl/t/Oping.t create mode 100644 bindings/perl/typemap diff --git a/bindings/perl/Changes b/bindings/perl/Changes new file mode 100644 index 0000000..974a189 --- /dev/null +++ b/bindings/perl/Changes @@ -0,0 +1,9 @@ +Revision history for Perl extension Net::Oping. + +1.00 Sat Jan 26 13:52:11 2008 + - The module has been renamed from `Oping' to `Net::Oping'. + - The XS code has been simplyfied and a high-level interface has been + created in Perl. + +0.01 Wed Oct 24 01:32:19 2007 + - original version; created by h2xs 1.23. diff --git a/bindings/perl/MANIFEST b/bindings/perl/MANIFEST new file mode 100644 index 0000000..1c39f9b --- /dev/null +++ b/bindings/perl/MANIFEST @@ -0,0 +1,10 @@ +Changes +Makefile.PL +MANIFEST +Oping.xs +ppport.h +README +t/Oping.t +typemap +lib/Net/Oping.pm +META.yml Module meta-data (added by MakeMaker) diff --git a/bindings/perl/META.yml b/bindings/perl/META.yml new file mode 100644 index 0000000..2aede20 --- /dev/null +++ b/bindings/perl/META.yml @@ -0,0 +1,10 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: Net-Oping +version: 1.00 +version_from: lib/Net/Oping.pm +installdirs: site +requires: + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.30_01 diff --git a/bindings/perl/Makefile.PL b/bindings/perl/Makefile.PL new file mode 100644 index 0000000..4e375a5 --- /dev/null +++ b/bindings/perl/Makefile.PL @@ -0,0 +1,15 @@ +use 5.008007; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Net::Oping', + VERSION_FROM => 'lib/Net/Oping.pm', + PREREQ_PM => {}, + ($] >= 5.005 + ? (ABSTRACT_FROM => 'lib/Net/Oping.pm', + AUTHOR => 'Florian Forster ') + : ()), + LIBS => ['-loping', '-L/opt/oping/lib/ -loping'], + DEFINE => '', + INC => '-I/opt/oping/include/' +); diff --git a/bindings/perl/Oping.xs b/bindings/perl/Oping.xs new file mode 100644 index 0000000..0cebf3d --- /dev/null +++ b/bindings/perl/Oping.xs @@ -0,0 +1,149 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#include +#include +#include +#include +#include /* NI_MAXHOST */ +#include + +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 diff --git a/bindings/perl/README b/bindings/perl/README new file mode 100644 index 0000000..d0af548 --- /dev/null +++ b/bindings/perl/README @@ -0,0 +1,41 @@ +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 . + +COPYRIGHT AND LICENSE + + Copyright (C) 2007 by Olivier Fredj + + Copyright (C) 2008 by Florian Forster + + 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. diff --git a/bindings/perl/lib/Net/Oping.pm b/bindings/perl/lib/Net/Oping.pm new file mode 100644 index 0000000..d33c578 --- /dev/null +++ b/bindings/perl/lib/Net/Oping.pm @@ -0,0 +1,278 @@ +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. Its purpose it to send C packets (also known as "ping") to a host and measure the time +that elapses until the reception of an C 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 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 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-EB (); + +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>-EB (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>-EB (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>-EB (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 (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>-EB (I<$host>, [I<$host>, ...]); + +Same semantic as B 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>-EB () + +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, 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>-EB (); + +Returns the last error that occured. + +=cut + +sub get_error +{ + my $obj = shift; + return ($obj->{'err_msg'} || 'Success'); +} + +=back + +=head1 SEE ALSO + +L + +The C homepage may be found at L. +Information about its mailing list may be found at +L. + +=head1 AUTHOR + +First XSEport by Olivier Fredj, extended XS functionality and high-level +Perl interface by Florian Forster. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2007 by Olivier Fredj EofredjEatEproxad.netE + +Copyright (C) 2008 by Florian Forster +EoctoEatEverplant.orgE + +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 : diff --git a/bindings/perl/t/Oping.t b/bindings/perl/t/Oping.t new file mode 100644 index 0000000..63ecfc5 --- /dev/null +++ b/bindings/perl/t/Oping.t @@ -0,0 +1,17 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Oping.t' + +######################### + +# change 'tests => 2' to 'tests => last_test_to_print'; + +use Test::More tests => 2; +BEGIN { use_ok('Net::Oping') }; + +my $obj = Net::Oping->new (); +ok (defined ($obj), 'Constructor'); +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + diff --git a/bindings/perl/typemap b/bindings/perl/typemap new file mode 100644 index 0000000..3d90144 --- /dev/null +++ b/bindings/perl/typemap @@ -0,0 +1,3 @@ +TYPEMAP +pingobj_t * T_PTROBJ +pingobj_iter_t * T_PTROBJ -- 2.30.2