From 4a980be355585c0342b788113d979898fa051b92 Mon Sep 17 00:00:00 2001 From: Salvatore Bonaccorso Date: Tue, 21 Jul 2015 19:32:46 +0200 Subject: Imported Upstream version 1.09 --- Build.PL | 26 ++ Changes | 35 +- Interface.pm | 296 ---------------- Interface.xs | 817 -------------------------------------------- Interface/Simple.pm | 279 --------------- LICENSE | 202 +++++++++++ MANIFEST | 14 +- META.json | 49 +++ META.yml | 43 ++- Makefile.PL | 52 --- README | 11 - README.md | 32 ++ lib/IO/Interface.pm | 303 +++++++++++++++++ lib/IO/Interface.xs | 825 +++++++++++++++++++++++++++++++++++++++++++++ lib/IO/Interface/Simple.pm | 287 ++++++++++++++++ 15 files changed, 1778 insertions(+), 1493 deletions(-) create mode 100644 Build.PL delete mode 100644 Interface.pm delete mode 100644 Interface.xs delete mode 100644 Interface/Simple.pm create mode 100644 LICENSE create mode 100644 META.json delete mode 100644 Makefile.PL delete mode 100644 README create mode 100644 README.md create mode 100644 lib/IO/Interface.pm create mode 100644 lib/IO/Interface.xs create mode 100644 lib/IO/Interface/Simple.pm diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..8f93f76 --- /dev/null +++ b/Build.PL @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use strict; +use Module::Build; + +my $build = Module::Build->new( + module_name => 'IO::Interface', + dist_version_from => 'lib/IO/Interface.pm', + dist_author => 'Lincoln Stein ', + dist_abstract => 'Access and modify network interface card configuration', + license => 'perl', + build_requires => { + 'ExtUtils::CBuilder' => 0, + }, + requires => { + 'perl' => '5.005', + }, + ); + +$build->create_build_script(); + +# get rid of annoying warning from ExtUtils::ParseXS +my $sub = 's/\$\^W\s*=\s*1/\$^W = 0/'; +system "perl -pi -e '$sub' Build"; + +exit 0; diff --git a/Changes b/Changes index d2b411d..4952898 100644 --- a/Changes +++ b/Changes @@ -1,41 +1,48 @@ Revision history for Perl extension IO::Interface. +1.09 Tue Dec 9 11:22:56 EST 2014 + -Converted to use Module::Build + +1.08 Mon Dec 8 10:38:42 EST 2014 + -First Git version + -Apply segfault patches for OpenBSD from Mikolaj Kucharski. + 1.07 Sun Jun 8 21:29:58 EDT 2014 - Apply patch from Miolaj Kucharski to fix segfault on OpenBSD. + -Apply patch from Miolaj Kucharski to fix segfault on OpenBSD. 1.06 Thu Jul 21 13:40:49 EDT 2011 - Address test 5 failure on systems with aliases on loopback. + -Address test 5 failure on systems with aliases on loopback. 1.05 Fri Jun 6 11:53:21 EDT 2008 - Fix from Mitsuru Yoshida to compile on FreeBSD. + -Fix from Mitsuru Yoshida to compile on FreeBSD. 1.04 Wed Dec 26 13:38:53 EST 2007 - Fix from John Lightsey to avoid dmesg warnings on BSD systems. + -Fix from John Lightsey to avoid dmesg warnings on BSD systems. 1.03 Mon Jan 22 16:38:24 EST 2007 - Fix to compile cleanly on solaris systems. + -Fix to compile cleanly on solaris systems. 1.02 Thu Sep 14 08:54:04 EDT 2006 - More documentation fixes. + -More documentation fixes. 1.01 Wed Sep 13 20:52:32 EDT 2006 - Documentation fix. + -Documentation fix. 1.00 Wed Sep 13 17:01:46 EDT 2006 - Introduced IO::Interface::Simple. - Added index methods. - Compiles on CygWin. + -Introduced IO::Interface::Simple. + -Added index methods. + -Compiles on CygWin. 0.98 Sep 03 18:20:20 EST 2003 - Fixed minor documentation error. + -Fixed minor documentation error. 0.97 May 14 16:50:46 EDT 2001 - BSD portability fixes from Anton Berezin and Jan L. Peterson + -BSD portability fixes from Anton Berezin and Jan L. Peterson 0.96 May 7 10:44:48 EDT 2001 - Documentation fixes + -Documentation fixes 0.94 July 17, 2000 - Added the addr_to_interface function, and the pseudo device "any" + -Added the addr_to_interface function, and the pseudo device "any" which corresponds to INADDR_ANY 0.90 First release diff --git a/Interface.pm b/Interface.pm deleted file mode 100644 index 72a8646..0000000 --- a/Interface.pm +++ /dev/null @@ -1,296 +0,0 @@ -package IO::Interface; - -require 5.005; -use strict; -use Carp; -use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD); - -use IO::Socket; - -require Exporter; -require DynaLoader; -use AutoLoader; - -my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric - addr_to_interface if_index if_indextoname ); -my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST - IFF_DEBUG IFF_LOOPBACK IFF_MASTER - IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS - IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC - IFF_RUNNING IFF_SLAVE IFF_UP); -%EXPORT_TAGS = ( 'all' => [@functions,@flags], - 'functions' => \@functions, - 'flags' => \@flags, - ); - -@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -@EXPORT = qw( ); - -@ISA = qw(Exporter DynaLoader); -$VERSION = '1.07'; - -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. If a constant is not found then control is passed - # to the AUTOLOAD in AutoLoader. - - my $constname; - ($constname = $AUTOLOAD) =~ s/.*:://; - croak "&constant not defined" if $constname eq 'constant'; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/ || $!{EINVAL}) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - croak "Your vendor has not defined IO::Interface macro $constname"; - } - } - { - no strict 'refs'; - *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val }; - } - goto &$AUTOLOAD; -} - -bootstrap IO::Interface $VERSION; - -# copy routines into IO::Socket -{ - no strict 'refs'; - *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions; -} - -# Preloaded methods go here. - -sub if_list { - my %hash = map {$_=>undef} &_if_list; - sort keys %hash; -} - -sub addr_to_interface { - my ($sock,$addr) = @_; - return "any" if $addr eq '0.0.0.0'; - my @interfaces = $sock->if_list; - foreach (@interfaces) { - my $if_addr = $sock->if_addr($_) or next; - return $_ if $if_addr eq $addr; - } - return; # couldn't find it -} - -# Autoload methods go after =cut, and are processed by the autosplit program. -1; -__END__ - -=head1 NAME - -IO::Interface - Perl extension for access to network card configuration information - -=head1 SYNOPSIS - - # ====================== - # the new, preferred API - # ====================== - - use IO::Interface::Simple; - - my $if1 = IO::Interface::Simple->new('eth0'); - my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); - my $if3 = IO::Interface::Simple->new_from_index(1); - - my @interfaces = IO::Interface::Simple->interfaces; - - for my $if (@interfaces) { - print "interface = $if\n"; - print "addr = ",$if->address,"\n", - "broadcast = ",$if->broadcast,"\n", - "netmask = ",$if->netmask,"\n", - "dstaddr = ",$if->dstaddr,"\n", - "hwaddr = ",$if->hwaddr,"\n", - "mtu = ",$if->mtu,"\n", - "metric = ",$if->metric,"\n", - "index = ",$if->index,"\n"; - - print "is running\n" if $if->is_running; - print "is broadcast\n" if $if->is_broadcast; - print "is p-to-p\n" if $if->is_pt2pt; - print "is loopback\n" if $if->is_loopback; - print "is promiscuous\n" if $if->is_promiscuous; - print "is multicast\n" if $if->is_multicast; - print "is notrailers\n" if $if->is_notrailers; - print "is noarp\n" if $if->is_noarp; - } - - - # =========== - # the old API - # =========== - - use IO::Socket; - use IO::Interface qw(:flags); - - my $s = IO::Socket::INET->new(Proto => 'udp'); - my @interfaces = $s->if_list; - - for my $if (@interfaces) { - print "interface = $if\n"; - my $flags = $s->if_flags($if); - print "addr = ",$s->if_addr($if),"\n", - "broadcast = ",$s->if_broadcast($if),"\n", - "netmask = ",$s->if_netmask($if),"\n", - "dstaddr = ",$s->if_dstaddr($if),"\n", - "hwaddr = ",$s->if_hwaddr($if),"\n"; - - print "is running\n" if $flags & IFF_RUNNING; - print "is broadcast\n" if $flags & IFF_BROADCAST; - print "is p-to-p\n" if $flags & IFF_POINTOPOINT; - print "is loopback\n" if $flags & IFF_LOOPBACK; - print "is promiscuous\n" if $flags & IFF_PROMISC; - print "is multicast\n" if $flags & IFF_MULTICAST; - print "is notrailers\n" if $flags & IFF_NOTRAILERS; - print "is noarp\n" if $flags & IFF_NOARP; - } - - my $interface = $s->addr_to_interface('127.0.0.1'); - - -=head1 DESCRIPTION - -IO::Interface adds methods to IO::Socket objects that allows them to -be used to retrieve and change information about the network -interfaces on your system. In addition to the object-oriented access -methods, you can use a function-oriented style. - -THIS API IS DEPRECATED. Please see L for the -preferred way to get and set interface configuration information. - -=head2 Creating a Socket to Access Interface Information - -You must create a socket before you can access interface -information. The socket does not have to be connected to a remote -site, or even used for communication. The simplest procedure is to -create a UDP protocol socket: - - my $s = IO::Socket::INET->new(Proto => 'udp'); - -The various IO::Interface functions will now be available as methods -on this socket. - -=head2 Methods - -=over 4 - -=item @iflist = $s->if_list - -The if_list() method will return a list of active interface names, for -example "eth0" or "tu0". If no interfaces are configured and running, -returns an empty list. - -=item $addr = $s->if_addr($ifname [,$newaddr]) - -if_addr() gets or sets the interface address. Call with the interface -name to retrieve the address (in dotted decimal format). Call with a -new address to set the interface. In the latter case, the routine -will return a true value if the operation was successful. - - my $oldaddr = $s->if_addr('eth0'); - $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!"; - -Special case: the address of the pseudo-device "any" will return the -IP address "0.0.0.0", which corresponds to the INADDR_ANY constant. - -=item $broadcast = $s->if_broadcast($ifname [,$newbroadcast] - -Get or set the interface broadcast address. If the interface does not -have a broadcast address, returns undef. - -=item $mask = $s->if_netmask($ifname [,$newmask]) - -Get or set the interface netmask. - -=item $dstaddr = $s->if_dstaddr($ifname [,$newdest]) - -Get or set the destination address for point-to-point interfaces. - -=item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr]) - -Get or set the hardware address for the interface. Currently only -ethernet addresses in the form "00:60:2D:2D:51:70" are accepted. - -=item $flags = $s->if_flags($ifname [,$newflags]) - -Get or set the flags for the interface. The flags are a bitmask -formed from a series of constants. See L below. - -=item $ifname = $s->addr_to_interface($ifaddr) - -Given an interface address in dotted form, returns the name of the -interface associated with it. Special case: the INADDR_ANY address, -0.0.0.0 will return a pseudo-interface name of "any". - -=back - -=head2 EXPORT - -IO::Interface exports nothing by default. However, you can import the -following symbol groups into your namespace: - - :functions Function-oriented interface (see below) - :flags Flag constants (see below) - :all All of the above - -=head2 Function-Oriented Interface - -By importing the ":functions" set, you can access IO::Interface in a -function-oriented manner. This imports all the methods described -above into your namespace. Example: - - use IO::Socket; - use IO::Interface ':functions'; - - my $sock = IO::Socket::INET->new(Proto=>'udp'); - my @interfaces = if_list($sock); - print "address = ",if_addr($sock,$interfaces[0]); - -=head2 Exportable constants - -The ":flags" constant imports the following constants for use with the -flags returned by if_flags(): - - IFF_ALLMULTI - IFF_AUTOMEDIA - IFF_BROADCAST - IFF_DEBUG - IFF_LOOPBACK - IFF_MASTER - IFF_MULTICAST - IFF_NOARP - IFF_NOTRAILERS - IFF_POINTOPOINT - IFF_PORTSEL - IFF_PROMISC - IFF_RUNNING - IFF_SLAVE - IFF_UP - -This example determines whether interface 'tu0' supports multicasting: - - use IO::Socket; - use IO::Interface ':flags'; - my $sock = IO::Socket::INET->new(Proto=>'udp'); - print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST. - -=head1 AUTHOR - -Lincoln Stein Elstein@cshl.orgE - -This module is distributed under the same license as Perl itself. - -=head1 SEE ALSO - -perl(1), IO::Socket(3), IO::Multicast(3), L - -=cut diff --git a/Interface.xs b/Interface.xs deleted file mode 100644 index 479cdef..0000000 --- a/Interface.xs +++ /dev/null @@ -1,817 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* socket definitions */ -#include -#include -#include - -/* location of IFF_* constants */ -#include - -/* location of getifaddrs() definition */ -#ifdef USE_GETIFADDRS -#include - -#ifdef HAVE_SOCKADDR_DL_STRUCT -#include -#endif - -#endif - -#ifndef SIOCGIFCONF -#include -#endif - -#ifdef OSIOCGIFCONF -#define MY_SIOCGIFCONF OSIOCGIFCONF -#else -#define MY_SIOCGIFCONF SIOCGIFCONF -#endif - -#ifdef PerlIO -typedef PerlIO * InputStream; -#else -#define PERLIO_IS_STDIO 1 -typedef FILE * InputStream; -#define PerlIO_fileno(f) fileno(f) -#endif - -#if !defined(__USE_BSD) - #if defined(__linux__) - typedef int IOCTL_CMD_T; - #define __USE_BSD - #elif defined(__APPLE__) - typedef unsigned long IOCTL_CMD_T; - #define __USE_BSD - #else - typedef int IOCTL_CMD_T; - #endif -#else - typedef unsigned long IOCTL_CMD_T; -#endif - -/* HP-UX, Solaris */ -#if !defined(ifr_mtu) && defined(ifr_metric) -#define ifr_mtu ifr_metric -#endif - -static double -constant_IFF_N(char *name, int len, int arg) -{ - errno = 0; - if (5 + 1 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[5 + 1]) { - case 'A': - if (strEQ(name + 5, "OARP")) { /* IFF_N removed */ -#ifdef IFF_NOARP - return IFF_NOARP; -#else - goto not_there; -#endif - } - case 'T': - if (strEQ(name + 5, "OTRAILERS")) { /* IFF_N removed */ -#ifdef IFF_NOTRAILERS - return IFF_NOTRAILERS; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_IFF_PO(char *name, int len, int arg) -{ - errno = 0; - switch (name[6 + 0]) { - case 'I': - if (strEQ(name + 6, "INTOPOINT")) { /* IFF_PO removed */ -#ifdef IFF_POINTOPOINT - return IFF_POINTOPOINT; -#else - goto not_there; -#endif - } - case 'R': - if (strEQ(name + 6, "RTSEL")) { /* IFF_PO removed */ -#ifdef IFF_PORTSEL - return IFF_PORTSEL; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_IFF_P(char *name, int len, int arg) -{ - errno = 0; - switch (name[5 + 0]) { - case 'O': - return constant_IFF_PO(name, len, arg); - case 'R': - if (strEQ(name + 5, "ROMISC")) { /* IFF_P removed */ -#ifdef IFF_PROMISC - return IFF_PROMISC; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_IFF_A(char *name, int len, int arg) -{ - errno = 0; - switch (name[5 + 0]) { - case 'L': - if (strEQ(name + 5, "LLMULTI")) { /* IFF_A removed */ -#ifdef IFF_ALLMULTI - return IFF_ALLMULTI; -#else - goto not_there; -#endif - } - case 'U': - if (strEQ(name + 5, "UTOMEDIA")) { /* IFF_A removed */ -#ifdef IFF_AUTOMEDIA - return IFF_AUTOMEDIA; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_IFF_M(char *name, int len, int arg) -{ - errno = 0; - switch (name[5 + 0]) { - case 'A': - if (strEQ(name + 5, "ASTER")) { /* IFF_M removed */ -#ifdef IFF_MASTER - return IFF_MASTER; -#else - goto not_there; -#endif - } - case 'U': - if (strEQ(name + 5, "ULTICAST")) { /* IFF_M removed */ -#ifdef IFF_MULTICAST - return IFF_MULTICAST; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_IFF(char *name, int len, int arg) -{ - errno = 0; - if (3 + 1 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[3 + 1]) { - case 'A': - if (!strnEQ(name + 3,"_", 1)) - break; - return constant_IFF_A(name, len, arg); - case 'B': - if (strEQ(name + 3, "_BROADCAST")) { /* IFF removed */ -#ifdef IFF_BROADCAST - return IFF_BROADCAST; -#else - goto not_there; -#endif - } - case 'D': - if (strEQ(name + 3, "_DEBUG")) { /* IFF removed */ -#ifdef IFF_DEBUG - return IFF_DEBUG; -#else - goto not_there; -#endif - } - case 'L': - if (strEQ(name + 3, "_LOOPBACK")) { /* IFF removed */ -#ifdef IFF_LOOPBACK - return IFF_LOOPBACK; -#else - goto not_there; -#endif - } - case 'M': - if (!strnEQ(name + 3,"_", 1)) - break; - return constant_IFF_M(name, len, arg); - case 'N': - if (!strnEQ(name + 3,"_", 1)) - break; - return constant_IFF_N(name, len, arg); - case 'P': - if (!strnEQ(name + 3,"_", 1)) - break; - return constant_IFF_P(name, len, arg); - case 'R': - if (strEQ(name + 3, "_RUNNING")) { /* IFF removed */ -#ifdef IFF_RUNNING - return IFF_RUNNING; -#else - goto not_there; -#endif - } - case 'S': - if (strEQ(name + 3, "_SLAVE")) { /* IFF removed */ -#ifdef IFF_SLAVE - return IFF_SLAVE; -#else - goto not_there; -#endif - } - case 'U': - if (strEQ(name + 3, "_UP")) { /* IFF removed */ -#ifdef IFF_UP - return IFF_UP; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_I(char *name, int len, int arg) -{ - errno = 0; - if (1 + 1 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[1 + 1]) { - case 'F': - if (!strnEQ(name + 1,"F", 1)) - break; - return constant_IFF(name, len, arg); - case 'H': - if (strEQ(name + 1, "FHWADDRLEN")) { /* I removed */ -#ifdef IFHWADDRLEN - return IFHWADDRLEN; -#else - goto not_there; -#endif - } - case 'N': - if (strEQ(name + 1, "FNAMSIZ")) { /* I removed */ -#ifdef IFNAMSIZ - return IFNAMSIZ; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant(char *name, int len, int arg) -{ - errno = 0; - switch (name[0 + 0]) { - case 'I': - return constant_I(name, len, arg); - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -int Ioctl (InputStream sock, IOCTL_CMD_T operation,void* result) { - int fd = PerlIO_fileno(sock); - return ioctl(fd,operation,result) == 0; -} - -#ifdef IFHWADDRLEN -char* parse_hwaddr (char *string, struct sockaddr* hwaddr) { - int len,i,consumed; - unsigned int converted; - char* s; - s = string; - len = strlen(s); - for (i = 0; i < IFHWADDRLEN && len > 0; i++) { - if (sscanf(s,"%x%n",&converted,&consumed) <= 0) - break; - hwaddr->sa_data[i] = converted; - s += consumed + 1; - len -= consumed + 1; - } - if (i != IFHWADDRLEN) - return NULL; - else - return string; -} - -/* No checking for string buffer length. Caller must ensure at least - 3*4 + 3 + 1 = 16 bytes long */ -char* format_hwaddr (char *string, struct sockaddr* hwaddr) { - int i,len; - char *s; - s = string; - s[0] = '\0'; - for (i = 0; i < IFHWADDRLEN; i++) { - if (i < IFHWADDRLEN-1) - len = sprintf(s,"%02x:",(unsigned char)hwaddr->sa_data[i]); - else - len = sprintf(s,"%02x",(unsigned char)hwaddr->sa_data[i]); - s += len; - } - return string; -} -#endif - -MODULE = IO::Interface PACKAGE = IO::Interface - -double -constant(sv,arg) - PREINIT: - STRLEN len; - PROTOTYPE: $;$ - INPUT: - SV * sv - char * s = SvPV(sv, len); - int arg - CODE: - RETVAL = constant(s,len,arg); - OUTPUT: - RETVAL - -char* -if_addr(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - STRLEN len; - IOCTL_CMD_T operation; - struct ifreq ifr; - char* newaddr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFADDR)) - XSRETURN_UNDEF; -#else - if (strncmp(name,"any",3) == 0) { - RETVAL = "0.0.0.0"; - } else { - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - ifr.ifr_addr.sa_family = AF_INET; - if (items > 2) { - newaddr = SvPV(ST(2),len); - if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) - croak("Invalid inet address"); -#if defined(SIOCSIFADDR) - operation = SIOCSIFADDR; -#else - croak("Cannot set interface address on this platform"); -#endif - } else { - operation = SIOCGIFADDR; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); - RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); - } -#endif - } - OUTPUT: - RETVAL - -char* -if_broadcast(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - STRLEN len; - IOCTL_CMD_T operation; - struct ifreq ifr; - char* newaddr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFBRDADDR)) - XSRETURN_UNDEF; -#else - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - ifr.ifr_addr.sa_family = AF_INET; - if (items > 2) { - newaddr = SvPV(ST(2),len); - if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) - croak("Invalid inet address"); -#if defined(SIOCSIFBRDADDR) - operation = SIOCSIFBRDADDR; -#else - croak("Cannot set broadcast address on this platform"); -#endif - } else { - operation = SIOCGIFBRDADDR; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); - RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); -#endif - } - OUTPUT: - RETVAL - -char* -if_netmask(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - STRLEN len; - IOCTL_CMD_T operation; - struct ifreq ifr; - char* newaddr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFNETMASK)) - XSRETURN_UNDEF; -#else - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - ifr.ifr_addr.sa_family = AF_INET; - if (items > 2) { - newaddr = SvPV(ST(2),len); - if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) - croak("Invalid inet address"); -#if defined(SIOCSIFNETMASK) - operation = SIOCSIFNETMASK; -#else - croak("Cannot set netmask on this platform"); -#endif - } else { - operation = SIOCGIFNETMASK; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); - RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); -#endif - } - OUTPUT: - RETVAL - -char* -if_dstaddr(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - STRLEN len; - IOCTL_CMD_T operation; - struct ifreq ifr; - char* newaddr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFDSTADDR)) - XSRETURN_UNDEF; -#else - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - ifr.ifr_addr.sa_family = AF_INET; - if (items > 2) { - newaddr = SvPV(ST(2),len); - if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) - croak("Invalid inet address"); -#if defined(SIOCSIFDSTADDR) - operation = SIOCSIFDSTADDR; -#else - croak("Cannot set destination address on this platform"); -#endif - } else { - operation = SIOCGIFDSTADDR; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); - RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); -#endif - } - OUTPUT: - RETVAL - -char* -if_hwaddr(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - STRLEN len; - IOCTL_CMD_T operation; - struct ifreq ifr; -#if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT)) - struct ifaddrs *ifap, *ifa; - struct sockaddr_dl* sdl; - sa_family_t family; - char *sdlname, *haddr, *s; - int hlen = 0; - int i; -#endif - char *newaddr,hwaddr[128]; - CODE: - { -#if !((defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) || defined(USE_GETIFADDRS)) - XSRETURN_UNDEF; -#endif -#if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT)) - getifaddrs(&ifap); - - while(1) { - for (ifa = ifap; ifa; ifa = ifa->ifa_next) { - if (strncmp(name, ifa->ifa_name, IFNAMSIZ) == 0) { - family = ifa->ifa_addr->sa_family; - if (family == AF_LINK) { - sdl = (struct sockaddr_dl *) ifa->ifa_addr; - haddr = sdl->sdl_data + sdl->sdl_nlen; - hlen = sdl->sdl_alen; - break; - } - } - ifap = ifap -> ifa_next; - } - freeifaddrs(ifap); - - s = hwaddr; - s[0] = '\0'; - if (ifap != NULL) { - for (i = 0; i < hlen; i++) { - if (i < hlen - 1) - len = sprintf(s,"%02x:",(unsigned char)haddr[i]); - else - len = sprintf(s,"%02x",(unsigned char)haddr[i]); - s += len; - } - } - - freeifaddrs(ifap); - - RETVAL = hwaddr; -#elif (defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - ifr.ifr_hwaddr.sa_family = AF_UNSPEC; - if (items > 2) { - newaddr = SvPV(ST(2),len); - if (parse_hwaddr(newaddr,&ifr.ifr_hwaddr) == NULL) - croak("Invalid hardware address"); -#if defined(SIOCSIFHWADDR) - operation = SIOCSIFHWADDR; -#else - croak("Cannot set hw address on this platform"); -#endif - } else { - operation = SIOCGIFHWADDR; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - RETVAL = format_hwaddr(hwaddr,&ifr.ifr_hwaddr); -#endif - } - OUTPUT: - RETVAL - - -int -if_flags(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - IOCTL_CMD_T operation; - int flags; - struct ifreq ifr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) - XSRETURN_UNDEF; -#endif - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - if (items > 2) { - ifr.ifr_flags = SvIV(ST(2)); -#if defined(SIOCSIFFLAGS) - operation = SIOCSIFFLAGS; -#else - croak("Cannot set flags on this platform."); -#endif - } else { - operation = SIOCGIFFLAGS; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - RETVAL = ifr.ifr_flags; - } - OUTPUT: - RETVAL - -int -if_mtu(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - IOCTL_CMD_T operation; - int flags; - struct ifreq ifr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) - XSRETURN_UNDEF; -#endif - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - if (items > 2) { - ifr.ifr_flags = SvIV(ST(2)); -#if defined(SIOCSIFMTU) - operation = SIOCSIFMTU; -#else - croak("Cannot set MTU on this platform."); -#endif - } else { - operation = SIOCGIFMTU; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - RETVAL = ifr.ifr_mtu; - } - OUTPUT: - RETVAL - -int -if_metric(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - PREINIT: - IOCTL_CMD_T operation; - int flags; - struct ifreq ifr; - CODE: - { -#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) - XSRETURN_UNDEF; -#endif - bzero((void*)&ifr,sizeof(struct ifreq)); - strncpy(ifr.ifr_name,name,IFNAMSIZ-1); - if (items > 2) { - ifr.ifr_flags = SvIV(ST(2)); -#if defined(SIOCSIFMETRIC) - operation = SIOCSIFMETRIC; -#else - croak("Cannot set metric on this platform."); -#endif - } else { - operation = SIOCGIFMETRIC; - } - if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; - RETVAL = ifr.ifr_metric; - } - OUTPUT: - RETVAL - -int -if_index(sock, name, ...) - InputStream sock - char* name - PROTOTYPE: $$;$ - CODE: - { -#ifdef __USE_BSD - RETVAL = if_nametoindex(name); -#else - XSRETURN_UNDEF; -#endif - } - OUTPUT: - RETVAL - -char* -if_indextoname(sock, index, ...) - InputStream sock - int index - PROTOTYPE: $$;$ - PREINIT: - char name[IFNAMSIZ]; - CODE: - { -#ifdef __USE_BSD - RETVAL = if_indextoname(index,name); -#else - XSRETURN_UNDEF; -#endif - } - OUTPUT: - RETVAL - -void -_if_list(sock) - InputStream sock - PROTOTYPE: $ - PREINIT: -#ifdef USE_GETIFADDRS - struct ifaddrs *ifa_start; - struct ifaddrs *ifa; -#else - struct ifconf ifc; - struct ifreq *ifr; - int lastlen,len; - char *buf,*ptr; -#endif - PPCODE: -#ifdef USE_GETIFADDRS - if (getifaddrs(&ifa_start) < 0) - XSRETURN_EMPTY; - - for (ifa = ifa_start ; ifa ; ifa = ifa->ifa_next) - XPUSHs(sv_2mortal(newSVpv(ifa->ifa_name,0))); - - freeifaddrs(ifa_start); -#else - lastlen = 0; - len = 10 * sizeof(struct ifreq); /* initial buffer size guess */ - for ( ; ; ) { - if ( (buf = safemalloc(len)) == NULL) - croak("Couldn't malloc buffer for ioctl: %s",strerror(errno)); - ifc.ifc_len = len; - ifc.ifc_buf = buf; - if (ioctl(PerlIO_fileno(sock),MY_SIOCGIFCONF,&ifc) < 0) { - if (errno != EINVAL || lastlen != 0) - XSRETURN_EMPTY; - } else { - if (ifc.ifc_len == lastlen) break; /* success, len has not changed */ - lastlen = ifc.ifc_len; - } - len += 10 * sizeof(struct ifreq); /* increment */ - safefree(buf); - } - - for (ptr = buf ; ptr < buf + ifc.ifc_len ; ptr += sizeof(struct ifreq)) { - ifr = (struct ifreq*) ptr; - XPUSHs(sv_2mortal(newSVpv(ifr->ifr_name,0))); - } - safefree(buf); -#endif - diff --git a/Interface/Simple.pm b/Interface/Simple.pm deleted file mode 100644 index 189a26f..0000000 --- a/Interface/Simple.pm +++ /dev/null @@ -1,279 +0,0 @@ -package IO::Interface::Simple; -use strict; -use IO::Socket; -use IO::Interface; - -use overload '""' => \&as_string, - eq => '_eq_', - fallback => 1; - -# class variable -my $socket; - -# class methods -sub interfaces { - my $class = shift; - my $s = $class->sock; - return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list; -} - -sub new { - my $class = shift; - my $if_name = shift; - my $s = $class->sock; - return unless defined $s->if_mtu($if_name); - return bless {s => $s, - name => $if_name},ref $class || $class; -} - -sub new_from_address { - my $class = shift; - my $addr = shift; - my $s = $class->sock; - my $name = $s->addr_to_interface($addr) or return; - return $class->new($name); -} - -sub new_from_index { - my $class = shift; - my $index = shift; - my $s = $class->sock; - my $name = $s->if_indextoname($index) or return; - return $class->new($name); -} - -sub sock { - my $self = shift; - if (ref $self) { - return $self->{s} ||= $socket; - } else { - return $socket ||= IO::Socket::INET->new(Proto=>'udp'); - } -} - -sub _eq_ { - return shift->name eq shift; -} - -sub as_string { - shift->name; -} - -sub name { - shift->{name}; -} - -sub address { - my $self = shift; - $self->sock->if_addr($self->name,@_); -} - -sub broadcast { - my $self = shift; - $self->sock->if_broadcast($self->name,@_); -} - -sub netmask { - my $self = shift; - $self->sock->if_netmask($self->name,@_); -} - -sub dstaddr { - my $self = shift; - $self->sock->if_dstaddr($self->name,@_); -} - -sub hwaddr { - my $self = shift; - $self->sock->if_hwaddr($self->name,@_); -} - -sub flags { - my $self = shift; - $self->sock->if_flags($self->name,@_); -} - -sub mtu { - my $self = shift; - $self->sock->if_mtu($self->name,@_); -} - -sub metric { - my $self = shift; - $self->sock->if_metric($self->name,@_); -} - -sub index { - my $self = shift; - return $self->sock->if_index($self->name); -} - -sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) } -sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) } -sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) } -sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) } -sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) } -sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) } -sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) } -sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) } - -sub _gettestflag { - my $self = shift; - my $bitmask = shift; - my $flags = $self->flags; - if (@_) { - $flags |= $bitmask; - $self->flags($flags); - } else { - return ($flags & $bitmask) != 0; - } -} - -1; - -=head1 NAME - -IO::Interface::Simple - Perl extension for access to network card configuration information - -=head1 SYNOPSIS - - use IO::Interface::Simple; - - my $if1 = IO::Interface::Simple->new('eth0'); - my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); - my $if3 = IO::Interface::Simple->new_from_index(1); - - my @interfaces = IO::Interface::Simple->interfaces; - - for my $if (@interfaces) { - print "interface = $if\n"; - print "addr = ",$if->address,"\n", - "broadcast = ",$if->broadcast,"\n", - "netmask = ",$if->netmask,"\n", - "dstaddr = ",$if->dstaddr,"\n", - "hwaddr = ",$if->hwaddr,"\n", - "mtu = ",$if->mtu,"\n", - "metric = ",$if->metric,"\n", - "index = ",$if->index,"\n"; - - print "is running\n" if $if->is_running; - print "is broadcast\n" if $if->is_broadcast; - print "is p-to-p\n" if $if->is_pt2pt; - print "is loopback\n" if $if->is_loopback; - print "is promiscuous\n" if $if->is_promiscuous; - print "is multicast\n" if $if->is_multicast; - print "is notrailers\n" if $if->is_notrailers; - print "is noarp\n" if $if->is_noarp; - } - - -=head1 DESCRIPTION - -IO::Interface::Simple allows you to interrogate and change network -interfaces. It has overlapping functionality with Net::Interface, but -might compile and run on more platforms. - -=head2 Class Methods - -=over 4 - -=item $interface = IO::Interface::Simple->new('eth0') - -Given an interface name, new() creates an interface object. - -=item @iflist = IO::Interface::Simple->interfaces; - -Returns a list of active interface objects. - -=item $interface = IO::Interface::Simple->new_from_address('192.168.0.1') - -Returns the interface object corresponding to the given address. - -=item $interface = IO::Interface::Simple->new_from_index(2) - -Returns the interface object corresponding to the given numeric -index. This is only supported on BSD-ish platforms. - -=back - -=head2 Object Methods - -=over 4 - -=item $name = $interface->name - -Get the name of the interface. The interface object is also overloaded -so that if you use it in a string context it is the same as calling -name(). - -=item $index = $interface->index - -Get the index of the interface. This is only supported on BSD-like -platforms. - -=item $addr = $interface->address([$newaddr]) - -Get or set the interface's address. - - -=item $addr = $interface->broadcast([$newaddr]) - -Get or set the interface's broadcast address. - -=item $addr = $interface->netmask([$newmask]) - -Get or set the interface's netmask. - -=item $addr = $interface->hwaddr([$newaddr]) - -Get or set the interface's hardware address. - -=item $addr = $interface->mtu([$newmtu]) - -Get or set the interface's MTU. - -=item $addr = $interface->metric([$newmetric]) - -Get or set the interface's metric. - -=item $flags = $interface->flags([$newflags]) - -Get or set the interface's flags. These can be ANDed with the IFF -constants exported by IO::Interface or Net::Interface in order to -interrogate the state and capabilities of the interface. However, it -is probably more convenient to use the broken-out methods listed -below. - -=item $flag = $interface->is_running([$newflag]) - -=item $flag = $interface->is_broadcast([$newflag]) - -=item $flag = $interface->is_pt2pt([$newflag]) - -=item $flag = $interface->is_loopback([$newflag]) - -=item $flag = $interface->is_promiscuous([$newflag]) - -=item $flag = $interface->is_multicast([$newflag]) - -=item $flag = $interface->is_notrailers([$newflag]) - -=item $flag = $interface->is_noarp([$newflag]) - -Get or set the corresponding configuration parameters. Note that the -operating system may not let you set some of these. - -=back - -=head1 AUTHOR - -Lincoln Stein Elstein@cshl.orgE - -This module is distributed under the same license as Perl itself. - -=head1 SEE ALSO - -L, L, L), L, L - -=cut - diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..10d46d2 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ +The Artistic License 2.0 + + Copyright (c) 2014 Lincoln Stein + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +Preamble + +This license establishes the terms under which a given free software +Package may be copied, modified, distributed, and/or redistributed. +The intent is that the Copyright Holder maintains some artistic +control over the development of that Package while still keeping the +Package available as open source and free software. + +You are always permitted to make arrangements wholly outside of this +license directly with the Copyright Holder of a given Package. If the +terms of this license do not permit the full use that you propose to +make of the Package, you should contact the Copyright Holder and seek +a different licensing arrangement. + +Definitions + + "Copyright Holder" means the individual(s) or organization(s) + named in the copyright notice for the entire Package. + + "Contributor" means any party that has contributed code or other + material to the Package, in accordance with the Copyright Holder's + procedures. + + "You" and "your" means any person who would like to copy, + distribute, or modify the Package. + + "Package" means the collection of files distributed by the + Copyright Holder, and derivatives of that collection and/or of + those files. A given Package may consist of either the Standard + Version, or a Modified Version. + + "Distribute" means providing a copy of the Package or making it + accessible to anyone else, or in the case of a company or + organization, to others outside of your company or organization. + + "Distributor Fee" means any fee that you charge for Distributing + this Package or providing support for this Package to another + party. It does not mean licensing fees. + + "Standard Version" refers to the Package if it has not been + modified, or has been modified only in ways explicitly requested + by the Copyright Holder. + + "Modified Version" means the Package, if it has been changed, and + such changes were not explicitly requested by the Copyright + Holder. + + "Original License" means this Artistic License as Distributed with + the Standard Version of the Package, in its current version or as + it may be modified by The Perl Foundation in the future. + + "Source" form means the source code, documentation source, and + configuration files for the Package. + + "Compiled" form means the compiled bytecode, object code, binary, + or any other form resulting from mechanical transformation or + translation of the Source form. + + +Permission for Use and Modification Without Distribution + +(1) You are permitted to use the Standard Version and create and use +Modified Versions for any purpose without restriction, provided that +you do not Distribute the Modified Version. + + +Permissions for Redistribution of the Standard Version + +(2) You may Distribute verbatim copies of the Source form of the +Standard Version of this Package in any medium without restriction, +either gratis or for a Distributor Fee, provided that you duplicate +all of the original copyright notices and associated disclaimers. At +your discretion, such verbatim copies may or may not include a +Compiled form of the Package. + +(3) You may apply any bug fixes, portability changes, and other +modifications made available from the Copyright Holder. The resulting +Package will still be considered the Standard Version, and as such +will be subject to the Original License. + + +Distribution of Modified Versions of the Package as Source + +(4) You may Distribute your Modified Version as Source (either gratis +or for a Distributor Fee, and with or without a Compiled form of the +Modified Version) provided that you clearly document how it differs +from the Standard Version, including, but not limited to, documenting +any non-standard features, executables, or modules, and provided that +you do at least ONE of the following: + + (a) make the Modified Version available to the Copyright Holder + of the Standard Version, under the Original License, so that the + Copyright Holder may include your modifications in the Standard + Version. + + (b) ensure that installation of your Modified Version does not + prevent the user installing or running the Standard Version. In + addition, the Modified Version must bear a name that is different + from the name of the Standard Version. + + (c) allow anyone who receives a copy of the Modified Version to + make the Source form of the Modified Version available to others + under + + (i) the Original License or + + (ii) a license that permits the licensee to freely copy, + modify and redistribute the Modified Version using the same + licensing terms that apply to the copy that the licensee + received, and requires that the Source form of the Modified + Version, and of any works derived from it, be made freely + available in that license fees are prohibited but Distributor + Fees are allowed. + + +Distribution of Compiled Forms of the Standard Version +or Modified Versions without the Source + +(5) You may Distribute Compiled forms of the Standard Version without +the Source, provided that you include complete instructions on how to +get the Source of the Standard Version. Such instructions must be +valid at the time of your distribution. If these instructions, at any +time while you are carrying out such distribution, become invalid, you +must provide new instructions on demand or cease further distribution. +If you provide valid instructions or cease distribution within thirty +days after you become aware that the instructions are invalid, then +you do not forfeit any of your rights under this license. + +(6) You may Distribute a Modified Version in Compiled form without +the Source, provided that you comply with Section 4 with respect to +the Source of the Modified Version. + + +Aggregating or Linking the Package + +(7) You may aggregate the Package (either the Standard Version or +Modified Version) with other packages and Distribute the resulting +aggregation provided that you do not charge a licensing fee for the +Package. Distributor Fees are permitted, and licensing fees for other +components in the aggregation are permitted. The terms of this license +apply to the use and Distribution of the Standard or Modified Versions +as included in the aggregation. + +(8) You are permitted to link Modified and Standard Versions with +other works, to embed the Package in a larger work of your own, or to +build stand-alone binary or bytecode versions of applications that +include the Package, and Distribute the result without restriction, +provided the result does not expose a direct interface to the Package. + + +Items That are Not Considered Part of a Modified Version + +(9) Works (including, but not limited to, modules and scripts) that +merely extend or make use of the Package, do not, by themselves, cause +the Package to be a Modified Version. In addition, such works are not +considered parts of the Package itself, and are not subject to the +terms of this license. + + +General Provisions + +(10) Any use, modification, and distribution of the Standard or +Modified Versions is governed by this Artistic License. By using, +modifying or distributing the Package, you accept this license. Do not +use, modify, or distribute the Package, if you do not accept this +license. + +(11) If your Modified Version has been derived from a Modified +Version made by someone other than you, you are nevertheless required +to ensure that your Modified Version complies with the requirements of +this license. + +(12) This license does not grant you the right to use any trademark, +service mark, tradename, or logo of the Copyright Holder. + +(13) This license includes the non-exclusive, worldwide, +free-of-charge patent license to make, have made, use, offer to sell, +sell, import and otherwise transfer the Package with respect to any +patent claims licensable by the Copyright Holder that are necessarily +infringed by the Package. If you institute patent litigation +(including a cross-claim or counterclaim) against any party alleging +that the Package constitutes direct or contributory patent +infringement, then this Artistic License to you shall terminate on the +date that such litigation is filed. + +(14) Disclaimer of Warranty: +THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS +IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED +WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR +NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL +LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL +BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/MANIFEST b/MANIFEST index f4e0dc7..e8d2d0d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,10 +1,12 @@ +Build.PL Changes -README -Interface.pm -Interface.xs -Interface/Simple.pm +lib/IO/Interface.pm +lib/IO/Interface.xs +lib/IO/Interface/Simple.pm +LICENSE MANIFEST -Makefile.PL +META.json +META.yml Module meta-data (added by MakeMaker) +README.md t/basic.t t/simple.t -META.yml Module meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..1dee62e --- /dev/null +++ b/META.json @@ -0,0 +1,49 @@ +{ + "abstract" : "Access and modify network interface card configuration", + "author" : [ + "Lincoln Stein " + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.4205", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "IO-Interface", + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::CBuilder" : "0" + } + }, + "configure" : { + "requires" : { + "Module::Build" : "0.42" + } + }, + "runtime" : { + "requires" : { + "perl" : "5.005" + } + } + }, + "provides" : { + "IO::Interface" : { + "file" : "lib/IO/Interface.pm", + "version" : "1.09" + }, + "IO::Interface::Simple" : { + "file" : "lib/IO/Interface/Simple.pm" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ] + }, + "version" : "1.09" +} diff --git a/META.yml b/META.yml index 99045c2..539bf96 100644 --- a/META.yml +++ b/META.yml @@ -1,20 +1,27 @@ ---- #YAML:1.0 -name: IO-Interface -version: 1.07 -abstract: ~ -author: [] -license: unknown -distribution_type: module -configure_requires: - ExtUtils::MakeMaker: 0 +--- +abstract: 'Access and modify network interface card configuration' +author: + - 'Lincoln Stein ' build_requires: - ExtUtils::MakeMaker: 0 -requires: {} -no_index: - directory: - - t - - inc -generated_by: ExtUtils::MakeMaker version 6.57_05 + ExtUtils::CBuilder: '0' +configure_requires: + Module::Build: '0.42' +dynamic_config: 1 +generated_by: 'Module::Build version 0.4205, CPAN::Meta::Converter version 2.120351' +license: perl meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: IO-Interface +provides: + IO::Interface: + file: lib/IO/Interface.pm + version: '1.09' + IO::Interface::Simple: + file: lib/IO/Interface/Simple.pm + version: 0 +requires: + perl: '5.005' +resources: + license: http://dev.perl.org/licenses/ +version: '1.09' diff --git a/Makefile.PL b/Makefile.PL deleted file mode 100644 index 55b79f0..0000000 --- a/Makefile.PL +++ /dev/null @@ -1,52 +0,0 @@ -use ExtUtils::MakeMaker; -use Config; - -my @libs = (); -push @libs,'-lresolv' unless $Config{d_inetaton}; - -my $guess_cfg = { - 'freebsd' => { - 'defs' => '-D__USE_BSD', - }, - 'netbsd' => { - 'defs' => '-D__USE_BSD', - }, - 'openbsd' => { - 'defs' => '-D__USE_BSD', - } -}; - -my $guess = $guess_cfg->{$^O}; -unless (ref $guess eq 'HASH') { - $guess = {'defs' => ''}; -} - -WriteMakefile( - 'NAME' => 'IO::Interface', - 'VERSION_FROM' => 'Interface.pm', # finds $VERSION - 'LIBS' => ["@libs"], # e.g., '-lm' - 'INC' => '', # e.g., '-I/usr/include/other' - PMLIBDIRS => ['Interface'], - CONFIGURE => sub { - my %attrs; - $attrs{DEFINE} = $guess->{'defs'}; - - print "Checking for getifaddrs()..."; - eval { require 'ifaddrs.ph' }; - if ($@ && !-r "/usr/include/ifaddrs.h") { - print " Nope, will not use it.\n"; - } else { - $attrs{DEFINE} .= ' -DUSE_GETIFADDRS'; - print " Okay, I will use it.\n"; - } - print "Checking for sockaddr_dl..."; - if (!-r "/usr/include/net/if_dl.h") { - print " Nope, will not use it.\n"; - } else { - $attrs{DEFINE} .= ' -DHAVE_SOCKADDR_DL_STRUCT'; - print " Okay, I will use it.\n"; - } - - \%attrs; - }, -); diff --git a/README b/README deleted file mode 100644 index ded1098..0000000 --- a/README +++ /dev/null @@ -1,11 +0,0 @@ -IO::Interface adds object-methods to IO::Socket objects to allow them -to get and set operational characteristics of network interface cards, -such as IP addresses, net masks, and so forth. It is useful for -identifying runtime characteristics of cards, such as broadcast -addresses, and finding interfaces that satisfy certain criteria, such -as the ability to multicast. - -See the POD for more information. - -Lincoln Stein - diff --git a/README.md b/README.md new file mode 100644 index 0000000..9587106 --- /dev/null +++ b/README.md @@ -0,0 +1,32 @@ +LibIO-Interface-Perl +==================== + +Perl interface to Unix network interface API + +IO::Interface adds object methods to IO::Socket objects to allow them +to get and set operational characteristics of network interface +cards, such as IP addresses, net masks, and so forth. It is useful +for identifying runtime characteristics of cards, such as broadcast +addresses, and finding interfaces that satisfy certain criteria, +such Perl interface to Unix network interface API as the ability to +multicast. + +For support, please use the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +Author +====== + +Lincoln D. Stein + +License +======= + +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + + + + diff --git a/lib/IO/Interface.pm b/lib/IO/Interface.pm new file mode 100644 index 0000000..419aa00 --- /dev/null +++ b/lib/IO/Interface.pm @@ -0,0 +1,303 @@ +package IO::Interface; + +require 5.005; +use strict; +use Carp; +use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD); + +use IO::Socket; + +require Exporter; +require DynaLoader; + +my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric + addr_to_interface if_index if_indextoname ); +my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST + IFF_DEBUG IFF_LOOPBACK IFF_MASTER + IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS + IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC + IFF_RUNNING IFF_SLAVE IFF_UP); +%EXPORT_TAGS = ( 'all' => [@functions,@flags], + 'functions' => \@functions, + 'flags' => \@flags, + ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@EXPORT = qw( ); + +@ISA = qw(Exporter DynaLoader); +$VERSION = '1.09'; + +sub AUTOLOAD { + # This AUTOLOAD is used to 'autoload' constants from the constant() + # XS function. If a constant is not found then control is passed + # to the AUTOLOAD in AutoLoader. + + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + croak "&constant not defined" if $constname eq 'constant'; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined IO::Interface macro $constname"; + } + } + { + no strict 'refs'; + *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val }; + } + goto &$AUTOLOAD; +} + +bootstrap IO::Interface $VERSION; + +# copy routines into IO::Socket +{ + no strict 'refs'; + *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions; +} + +# Preloaded methods go here. + +sub if_list { + my %hash = map {$_=>undef} &_if_list; + sort keys %hash; +} + +sub addr_to_interface { + my ($sock,$addr) = @_; + return "any" if $addr eq '0.0.0.0'; + my @interfaces = $sock->if_list; + foreach (@interfaces) { + my $if_addr = $sock->if_addr($_) or next; + return $_ if $if_addr eq $addr; + } + return; # couldn't find it +} + +# Autoload methods go after =cut, and are processed by the autosplit program. +1; +__END__ + +=head1 NAME + +IO::Interface - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + # ====================== + # the new, preferred API + # ====================== + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + + # =========== + # the old API + # =========== + + use IO::Socket; + use IO::Interface qw(:flags); + + my $s = IO::Socket::INET->new(Proto => 'udp'); + my @interfaces = $s->if_list; + + for my $if (@interfaces) { + print "interface = $if\n"; + my $flags = $s->if_flags($if); + print "addr = ",$s->if_addr($if),"\n", + "broadcast = ",$s->if_broadcast($if),"\n", + "netmask = ",$s->if_netmask($if),"\n", + "dstaddr = ",$s->if_dstaddr($if),"\n", + "hwaddr = ",$s->if_hwaddr($if),"\n"; + + print "is running\n" if $flags & IFF_RUNNING; + print "is broadcast\n" if $flags & IFF_BROADCAST; + print "is p-to-p\n" if $flags & IFF_POINTOPOINT; + print "is loopback\n" if $flags & IFF_LOOPBACK; + print "is promiscuous\n" if $flags & IFF_PROMISC; + print "is multicast\n" if $flags & IFF_MULTICAST; + print "is notrailers\n" if $flags & IFF_NOTRAILERS; + print "is noarp\n" if $flags & IFF_NOARP; + } + + my $interface = $s->addr_to_interface('127.0.0.1'); + + +=head1 DESCRIPTION + +IO::Interface adds methods to IO::Socket objects that allows them to +be used to retrieve and change information about the network +interfaces on your system. In addition to the object-oriented access +methods, you can use a function-oriented style. + +THIS API IS DEPRECATED. Please see L for the +preferred way to get and set interface configuration information. + +=head2 Creating a Socket to Access Interface Information + +You must create a socket before you can access interface +information. The socket does not have to be connected to a remote +site, or even used for communication. The simplest procedure is to +create a UDP protocol socket: + + my $s = IO::Socket::INET->new(Proto => 'udp'); + +The various IO::Interface functions will now be available as methods +on this socket. + +=head2 Methods + +=over 4 + +=item @iflist = $s->if_list + +The if_list() method will return a list of active interface names, for +example "eth0" or "tu0". If no interfaces are configured and running, +returns an empty list. + +=item $addr = $s->if_addr($ifname [,$newaddr]) + +if_addr() gets or sets the interface address. Call with the interface +name to retrieve the address (in dotted decimal format). Call with a +new address to set the interface. In the latter case, the routine +will return a true value if the operation was successful. + + my $oldaddr = $s->if_addr('eth0'); + $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!"; + +Special case: the address of the pseudo-device "any" will return the +IP address "0.0.0.0", which corresponds to the INADDR_ANY constant. + +=item $broadcast = $s->if_broadcast($ifname [,$newbroadcast] + +Get or set the interface broadcast address. If the interface does not +have a broadcast address, returns undef. + +=item $mask = $s->if_netmask($ifname [,$newmask]) + +Get or set the interface netmask. + +=item $dstaddr = $s->if_dstaddr($ifname [,$newdest]) + +Get or set the destination address for point-to-point interfaces. + +=item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr]) + +Get or set the hardware address for the interface. Currently only +ethernet addresses in the form "00:60:2D:2D:51:70" are accepted. + +=item $flags = $s->if_flags($ifname [,$newflags]) + +Get or set the flags for the interface. The flags are a bitmask +formed from a series of constants. See L below. + +=item $ifname = $s->addr_to_interface($ifaddr) + +Given an interface address in dotted form, returns the name of the +interface associated with it. Special case: the INADDR_ANY address, +0.0.0.0 will return a pseudo-interface name of "any". + +=back + +=head2 EXPORT + +IO::Interface exports nothing by default. However, you can import the +following symbol groups into your namespace: + + :functions Function-oriented interface (see below) + :flags Flag constants (see below) + :all All of the above + +=head2 Function-Oriented Interface + +By importing the ":functions" set, you can access IO::Interface in a +function-oriented manner. This imports all the methods described +above into your namespace. Example: + + use IO::Socket; + use IO::Interface ':functions'; + + my $sock = IO::Socket::INET->new(Proto=>'udp'); + my @interfaces = if_list($sock); + print "address = ",if_addr($sock,$interfaces[0]); + +=head2 Exportable constants + +The ":flags" constant imports the following constants for use with the +flags returned by if_flags(): + + IFF_ALLMULTI + IFF_AUTOMEDIA + IFF_BROADCAST + IFF_DEBUG + IFF_LOOPBACK + IFF_MASTER + IFF_MULTICAST + IFF_NOARP + IFF_NOTRAILERS + IFF_POINTOPOINT + IFF_PORTSEL + IFF_PROMISC + IFF_RUNNING + IFF_SLAVE + IFF_UP + +This example determines whether interface 'tu0' supports multicasting: + + use IO::Socket; + use IO::Interface ':flags'; + my $sock = IO::Socket::INET->new(Proto=>'udp'); + print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST. + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +perl(1), IO::Socket(3), IO::Multicast(3), L + +=cut diff --git a/lib/IO/Interface.xs b/lib/IO/Interface.xs new file mode 100644 index 0000000..9d500d9 --- /dev/null +++ b/lib/IO/Interface.xs @@ -0,0 +1,825 @@ +/* Interface.xs: part of LibIO-Interface-Perl */ +/* Copyright 2014 Lincoln D. Stein */ +/* Licensed under Perl Artistic License 2.0 */ +/* Please see LICENSE and README.md for more information. */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#include + +/* socket definitions */ +#include +#include +#include + +/* location of IFF_* constants */ +#include + +/* location of getifaddrs() definition */ +#ifdef USE_GETIFADDRS +#include + +#ifdef HAVE_SOCKADDR_DL_STRUCT +#include +#endif + +#endif + +#ifndef SIOCGIFCONF +#include +#endif + +#ifdef OSIOCGIFCONF +#define MY_SIOCGIFCONF OSIOCGIFCONF +#else +#define MY_SIOCGIFCONF SIOCGIFCONF +#endif + +#ifdef PerlIO +typedef PerlIO * InputStream; +#else +#define PERLIO_IS_STDIO 1 +typedef FILE * InputStream; +#define PerlIO_fileno(f) fileno(f) +#endif + +#if !defined(__USE_BSD) + #if defined(__linux__) + typedef int IOCTL_CMD_T; + #define __USE_BSD + #elif defined(__APPLE__) + typedef unsigned long IOCTL_CMD_T; + #define __USE_BSD + #else + typedef int IOCTL_CMD_T; + #endif +#else + typedef unsigned long IOCTL_CMD_T; +#endif + +/* HP-UX, Solaris */ +#if !defined(ifr_mtu) && defined(ifr_metric) +#define ifr_mtu ifr_metric +#endif + +static double +constant_IFF_N(char *name, int len, int arg) +{ + errno = 0; + if (5 + 1 >= len ) { + errno = EINVAL; + return 0; + } + switch (name[5 + 1]) { + case 'A': + if (strEQ(name + 5, "OARP")) { /* IFF_N removed */ +#ifdef IFF_NOARP + return IFF_NOARP; +#else + goto not_there; +#endif + } + case 'T': + if (strEQ(name + 5, "OTRAILERS")) { /* IFF_N removed */ +#ifdef IFF_NOTRAILERS + return IFF_NOTRAILERS; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_IFF_PO(char *name, int len, int arg) +{ + errno = 0; + switch (name[6 + 0]) { + case 'I': + if (strEQ(name + 6, "INTOPOINT")) { /* IFF_PO removed */ +#ifdef IFF_POINTOPOINT + return IFF_POINTOPOINT; +#else + goto not_there; +#endif + } + case 'R': + if (strEQ(name + 6, "RTSEL")) { /* IFF_PO removed */ +#ifdef IFF_PORTSEL + return IFF_PORTSEL; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_IFF_P(char *name, int len, int arg) +{ + errno = 0; + switch (name[5 + 0]) { + case 'O': + return constant_IFF_PO(name, len, arg); + case 'R': + if (strEQ(name + 5, "ROMISC")) { /* IFF_P removed */ +#ifdef IFF_PROMISC + return IFF_PROMISC; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_IFF_A(char *name, int len, int arg) +{ + errno = 0; + switch (name[5 + 0]) { + case 'L': + if (strEQ(name + 5, "LLMULTI")) { /* IFF_A removed */ +#ifdef IFF_ALLMULTI + return IFF_ALLMULTI; +#else + goto not_there; +#endif + } + case 'U': + if (strEQ(name + 5, "UTOMEDIA")) { /* IFF_A removed */ +#ifdef IFF_AUTOMEDIA + return IFF_AUTOMEDIA; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_IFF_M(char *name, int len, int arg) +{ + errno = 0; + switch (name[5 + 0]) { + case 'A': + if (strEQ(name + 5, "ASTER")) { /* IFF_M removed */ +#ifdef IFF_MASTER + return IFF_MASTER; +#else + goto not_there; +#endif + } + case 'U': + if (strEQ(name + 5, "ULTICAST")) { /* IFF_M removed */ +#ifdef IFF_MULTICAST + return IFF_MULTICAST; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_IFF(char *name, int len, int arg) +{ + errno = 0; + if (3 + 1 >= len ) { + errno = EINVAL; + return 0; + } + switch (name[3 + 1]) { + case 'A': + if (!strnEQ(name + 3,"_", 1)) + break; + return constant_IFF_A(name, len, arg); + case 'B': + if (strEQ(name + 3, "_BROADCAST")) { /* IFF removed */ +#ifdef IFF_BROADCAST + return IFF_BROADCAST; +#else + goto not_there; +#endif + } + case 'D': + if (strEQ(name + 3, "_DEBUG")) { /* IFF removed */ +#ifdef IFF_DEBUG + return IFF_DEBUG; +#else + goto not_there; +#endif + } + case 'L': + if (strEQ(name + 3, "_LOOPBACK")) { /* IFF removed */ +#ifdef IFF_LOOPBACK + return IFF_LOOPBACK; +#else + goto not_there; +#endif + } + case 'M': + if (!strnEQ(name + 3,"_", 1)) + break; + return constant_IFF_M(name, len, arg); + case 'N': + if (!strnEQ(name + 3,"_", 1)) + break; + return constant_IFF_N(name, len, arg); + case 'P': + if (!strnEQ(name + 3,"_", 1)) + break; + return constant_IFF_P(name, len, arg); + case 'R': + if (strEQ(name + 3, "_RUNNING")) { /* IFF removed */ +#ifdef IFF_RUNNING + return IFF_RUNNING; +#else + goto not_there; +#endif + } + case 'S': + if (strEQ(name + 3, "_SLAVE")) { /* IFF removed */ +#ifdef IFF_SLAVE + return IFF_SLAVE; +#else + goto not_there; +#endif + } + case 'U': + if (strEQ(name + 3, "_UP")) { /* IFF removed */ +#ifdef IFF_UP + return IFF_UP; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant_I(char *name, int len, int arg) +{ + errno = 0; + if (1 + 1 >= len ) { + errno = EINVAL; + return 0; + } + switch (name[1 + 1]) { + case 'F': + if (!strnEQ(name + 1,"F", 1)) + break; + return constant_IFF(name, len, arg); + case 'H': + if (strEQ(name + 1, "FHWADDRLEN")) { /* I removed */ +#ifdef IFHWADDRLEN + return IFHWADDRLEN; +#else + goto not_there; +#endif + } + case 'N': + if (strEQ(name + 1, "FNAMSIZ")) { /* I removed */ +#ifdef IFNAMSIZ + return IFNAMSIZ; +#else + goto not_there; +#endif + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +static double +constant(char *name, int len, int arg) +{ + errno = 0; + switch (name[0 + 0]) { + case 'I': + return constant_I(name, len, arg); + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +int Ioctl (InputStream sock, IOCTL_CMD_T operation,void* result) { + int fd = PerlIO_fileno(sock); + return ioctl(fd,operation,result) == 0; +} + +#ifdef IFHWADDRLEN +char* parse_hwaddr (char *string, struct sockaddr* hwaddr) { + int len,i,consumed; + unsigned int converted; + char* s; + s = string; + len = strlen(s); + for (i = 0; i < IFHWADDRLEN && len > 0; i++) { + if (sscanf(s,"%x%n",&converted,&consumed) <= 0) + break; + hwaddr->sa_data[i] = converted; + s += consumed + 1; + len -= consumed + 1; + } + if (i != IFHWADDRLEN) + return NULL; + else + return string; +} + +/* No checking for string buffer length. Caller must ensure at least + 3*4 + 3 + 1 = 16 bytes long */ +char* format_hwaddr (char *string, struct sockaddr* hwaddr) { + int i,len; + char *s; + s = string; + s[0] = '\0'; + for (i = 0; i < IFHWADDRLEN; i++) { + if (i < IFHWADDRLEN-1) + len = sprintf(s,"%02x:",(unsigned char)hwaddr->sa_data[i]); + else + len = sprintf(s,"%02x",(unsigned char)hwaddr->sa_data[i]); + s += len; + } + return string; +} +#endif + +MODULE = IO::Interface PACKAGE = IO::Interface + +double +constant(sv,arg) + PREINIT: + STRLEN len; + PROTOTYPE: $;$ + INPUT: + SV * sv + char * s = SvPV(sv, len); + int arg + CODE: + RETVAL = constant(s,len,arg); + OUTPUT: + RETVAL + +char* +if_addr(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + STRLEN len; + IOCTL_CMD_T operation; + struct ifreq ifr; + char* newaddr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFADDR)) + XSRETURN_UNDEF; +#else + if (strncmp(name,"any",3) == 0) { + RETVAL = "0.0.0.0"; + } else { + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + ifr.ifr_addr.sa_family = AF_INET; + if (items > 2) { + newaddr = SvPV(ST(2),len); + if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) + croak("Invalid inet address"); +#if defined(SIOCSIFADDR) + operation = SIOCSIFADDR; +#else + croak("Cannot set interface address on this platform"); +#endif + } else { + operation = SIOCGIFADDR; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); + RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); + } +#endif + } + OUTPUT: + RETVAL + +char* +if_broadcast(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + STRLEN len; + IOCTL_CMD_T operation; + struct ifreq ifr; + char* newaddr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFBRDADDR)) + XSRETURN_UNDEF; +#else + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + ifr.ifr_addr.sa_family = AF_INET; + if (items > 2) { + newaddr = SvPV(ST(2),len); + if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) + croak("Invalid inet address"); +#if defined(SIOCSIFBRDADDR) + operation = SIOCSIFBRDADDR; +#else + croak("Cannot set broadcast address on this platform"); +#endif + } else { + operation = SIOCGIFBRDADDR; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); + RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); +#endif + } + OUTPUT: + RETVAL + +char* +if_netmask(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + STRLEN len; + IOCTL_CMD_T operation; + struct ifreq ifr; + char* newaddr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFNETMASK)) + XSRETURN_UNDEF; +#else + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + ifr.ifr_addr.sa_family = AF_INET; + if (items > 2) { + newaddr = SvPV(ST(2),len); + if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) + croak("Invalid inet address"); +#if defined(SIOCSIFNETMASK) + operation = SIOCSIFNETMASK; +#else + croak("Cannot set netmask on this platform"); +#endif + } else { + operation = SIOCGIFNETMASK; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; +#if defined(__NetBSD__) || defined(__OpenBSD__) + ifr.ifr_addr.sa_family = AF_INET; +#endif + if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); + RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); +#endif + } + OUTPUT: + RETVAL + +char* +if_dstaddr(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + STRLEN len; + IOCTL_CMD_T operation; + struct ifreq ifr; + char* newaddr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFDSTADDR)) + XSRETURN_UNDEF; +#else + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + ifr.ifr_addr.sa_family = AF_INET; + if (items > 2) { + newaddr = SvPV(ST(2),len); + if ( inet_aton(newaddr,&((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr) == 0 ) + croak("Invalid inet address"); +#if defined(SIOCSIFDSTADDR) + operation = SIOCSIFDSTADDR; +#else + croak("Cannot set destination address on this platform"); +#endif + } else { + operation = SIOCGIFDSTADDR; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + if (ifr.ifr_addr.sa_family != AF_INET) croak ("Address is not in the AF_INET family.\n"); + RETVAL = inet_ntoa(((struct sockaddr_in*) &ifr.ifr_addr)->sin_addr); +#endif + } + OUTPUT: + RETVAL + +char* +if_hwaddr(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + STRLEN len; + IOCTL_CMD_T operation; + struct ifreq ifr; +#if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT)) + struct ifaddrs *ifap, *ifa; + struct sockaddr_dl* sdl; + sa_family_t family; + char *sdlname, *haddr, *s; + int hlen = 0; + int i; +#endif + char *newaddr,hwaddr[128]; + CODE: + { +#if !((defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) || defined(USE_GETIFADDRS)) + XSRETURN_UNDEF; +#endif +#if (defined(USE_GETIFADDRS) && defined(HAVE_SOCKADDR_DL_STRUCT)) + getifaddrs(&ifap); + + for (ifa = ifap; ifa; ifa = ifa->ifa_next) { + if (strncmp(name, ifa->ifa_name, IFNAMSIZ) == 0) { + family = ifa->ifa_addr->sa_family; + if (family == AF_LINK) { + sdl = (struct sockaddr_dl *) ifa->ifa_addr; + haddr = sdl->sdl_data + sdl->sdl_nlen; + hlen = sdl->sdl_alen; + break; + } + } + } + + s = hwaddr; + s[0] = '\0'; + if (ifap != NULL) { + for (i = 0; i < hlen; i++) { + if (i < hlen - 1) + len = sprintf(s,"%02x:",(unsigned char)haddr[i]); + else + len = sprintf(s,"%02x",(unsigned char)haddr[i]); + s += len; + } + } + + freeifaddrs(ifap); + + RETVAL = hwaddr; +#elif (defined(HAS_IOCTL) && defined(SIOCGIFHWADDR)) + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + ifr.ifr_hwaddr.sa_family = AF_UNSPEC; + if (items > 2) { + newaddr = SvPV(ST(2),len); + if (parse_hwaddr(newaddr,&ifr.ifr_hwaddr) == NULL) + croak("Invalid hardware address"); +#if defined(SIOCSIFHWADDR) + operation = SIOCSIFHWADDR; +#else + croak("Cannot set hw address on this platform"); +#endif + } else { + operation = SIOCGIFHWADDR; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + RETVAL = format_hwaddr(hwaddr,&ifr.ifr_hwaddr); +#endif + } + OUTPUT: + RETVAL + + +int +if_flags(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + IOCTL_CMD_T operation; + int flags; + struct ifreq ifr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) + XSRETURN_UNDEF; +#endif + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + if (items > 2) { + ifr.ifr_flags = SvIV(ST(2)); +#if defined(SIOCSIFFLAGS) + operation = SIOCSIFFLAGS; +#else + croak("Cannot set flags on this platform."); +#endif + } else { + operation = SIOCGIFFLAGS; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + RETVAL = ifr.ifr_flags; + } + OUTPUT: + RETVAL + +int +if_mtu(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + IOCTL_CMD_T operation; + int flags; + struct ifreq ifr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) + XSRETURN_UNDEF; +#endif + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + if (items > 2) { + ifr.ifr_flags = SvIV(ST(2)); +#if defined(SIOCSIFMTU) + operation = SIOCSIFMTU; +#else + croak("Cannot set MTU on this platform."); +#endif + } else { + operation = SIOCGIFMTU; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + RETVAL = ifr.ifr_mtu; + } + OUTPUT: + RETVAL + +int +if_metric(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + PREINIT: + IOCTL_CMD_T operation; + int flags; + struct ifreq ifr; + CODE: + { +#if !(defined(HAS_IOCTL) && defined(SIOCGIFFLAGS)) + XSRETURN_UNDEF; +#endif + bzero((void*)&ifr,sizeof(struct ifreq)); + strncpy(ifr.ifr_name,name,IFNAMSIZ-1); + if (items > 2) { + ifr.ifr_flags = SvIV(ST(2)); +#if defined(SIOCSIFMETRIC) + operation = SIOCSIFMETRIC; +#else + croak("Cannot set metric on this platform."); +#endif + } else { + operation = SIOCGIFMETRIC; + } + if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF; + RETVAL = ifr.ifr_metric; + } + OUTPUT: + RETVAL + +int +if_index(sock, name, ...) + InputStream sock + char* name + PROTOTYPE: $$;$ + CODE: + { +#ifdef __USE_BSD + RETVAL = if_nametoindex(name); +#else + XSRETURN_UNDEF; +#endif + } + OUTPUT: + RETVAL + +char* +if_indextoname(sock, index, ...) + InputStream sock + int index + PROTOTYPE: $$;$ + PREINIT: + char name[IFNAMSIZ]; + CODE: + { +#ifdef __USE_BSD + RETVAL = if_indextoname(index,name); +#else + XSRETURN_UNDEF; +#endif + } + OUTPUT: + RETVAL + +void +_if_list(sock) + InputStream sock + PROTOTYPE: $ + PREINIT: +#ifdef USE_GETIFADDRS + struct ifaddrs *ifa_start; + struct ifaddrs *ifa; +#else + struct ifconf ifc; + struct ifreq *ifr; + int lastlen,len; + char *buf,*ptr; +#endif + PPCODE: +#ifdef USE_GETIFADDRS + if (getifaddrs(&ifa_start) < 0) + XSRETURN_EMPTY; + + for (ifa = ifa_start ; ifa ; ifa = ifa->ifa_next) + XPUSHs(sv_2mortal(newSVpv(ifa->ifa_name,0))); + + freeifaddrs(ifa_start); +#else + lastlen = 0; + len = 10 * sizeof(struct ifreq); /* initial buffer size guess */ + for ( ; ; ) { + if ( (buf = safemalloc(len)) == NULL) + croak("Couldn't malloc buffer for ioctl: %s",strerror(errno)); + ifc.ifc_len = len; + ifc.ifc_buf = buf; + if (ioctl(PerlIO_fileno(sock),MY_SIOCGIFCONF,&ifc) < 0) { + if (errno != EINVAL || lastlen != 0) + XSRETURN_EMPTY; + } else { + if (ifc.ifc_len == lastlen) break; /* success, len has not changed */ + lastlen = ifc.ifc_len; + } + len += 10 * sizeof(struct ifreq); /* increment */ + safefree(buf); + } + + for (ptr = buf ; ptr < buf + ifc.ifc_len ; ptr += sizeof(struct ifreq)) { + ifr = (struct ifreq*) ptr; + XPUSHs(sv_2mortal(newSVpv(ifr->ifr_name,0))); + } + safefree(buf); +#endif + diff --git a/lib/IO/Interface/Simple.pm b/lib/IO/Interface/Simple.pm new file mode 100644 index 0000000..def0b1e --- /dev/null +++ b/lib/IO/Interface/Simple.pm @@ -0,0 +1,287 @@ +package IO::Interface::Simple; +use strict; +use IO::Socket; +use IO::Interface; + +use overload '""' => \&as_string, + eq => '_eq_', + fallback => 1; + +# class variable +my $socket; + +# class methods +sub interfaces { + my $class = shift; + my $s = $class->sock; + return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list; +} + +sub new { + my $class = shift; + my $if_name = shift; + my $s = $class->sock; + return unless defined $s->if_mtu($if_name); + return bless {s => $s, + name => $if_name},ref $class || $class; +} + +sub new_from_address { + my $class = shift; + my $addr = shift; + my $s = $class->sock; + my $name = $s->addr_to_interface($addr) or return; + return $class->new($name); +} + +sub new_from_index { + my $class = shift; + my $index = shift; + my $s = $class->sock; + my $name = $s->if_indextoname($index) or return; + return $class->new($name); +} + +sub sock { + my $self = shift; + if (ref $self) { + return $self->{s} ||= $socket; + } else { + return $socket ||= IO::Socket::INET->new(Proto=>'udp'); + } +} + +sub _eq_ { + return shift->name eq shift; +} + +sub as_string { + shift->name; +} + +sub name { + shift->{name}; +} + +sub address { + my $self = shift; + $self->sock->if_addr($self->name,@_); +} + +sub broadcast { + my $self = shift; + $self->sock->if_broadcast($self->name,@_); +} + +sub netmask { + my $self = shift; + $self->sock->if_netmask($self->name,@_); +} + +sub dstaddr { + my $self = shift; + $self->sock->if_dstaddr($self->name,@_); +} + +sub hwaddr { + my $self = shift; + $self->sock->if_hwaddr($self->name,@_); +} + +sub flags { + my $self = shift; + $self->sock->if_flags($self->name,@_); +} + +sub mtu { + my $self = shift; + $self->sock->if_mtu($self->name,@_); +} + +sub metric { + my $self = shift; + $self->sock->if_metric($self->name,@_); +} + +sub index { + my $self = shift; + return $self->sock->if_index($self->name); +} + +sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) } +sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) } +sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) } +sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) } +sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) } +sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) } +sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) } +sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) } + +sub _gettestflag { + my $self = shift; + my $bitmask = shift; + my $flags = $self->flags; + if (@_) { + $flags |= $bitmask; + $self->flags($flags); + } else { + return ($flags & $bitmask) != 0; + } +} + +1; + +=head1 NAME + +IO::Interface::Simple - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + +=head1 DESCRIPTION + +IO::Interface::Simple allows you to interrogate and change network +interfaces. It has overlapping functionality with Net::Interface, but +might compile and run on more platforms. + +=head2 Class Methods + +=over 4 + +=item $interface = IO::Interface::Simple->new('eth0') + +Given an interface name, new() creates an interface object. + +=item @iflist = IO::Interface::Simple->interfaces; + +Returns a list of active interface objects. + +=item $interface = IO::Interface::Simple->new_from_address('192.168.0.1') + +Returns the interface object corresponding to the given address. + +=item $interface = IO::Interface::Simple->new_from_index(2) + +Returns the interface object corresponding to the given numeric +index. This is only supported on BSD-ish platforms. + +=back + +=head2 Object Methods + +=over 4 + +=item $name = $interface->name + +Get the name of the interface. The interface object is also overloaded +so that if you use it in a string context it is the same as calling +name(). + +=item $index = $interface->index + +Get the index of the interface. This is only supported on BSD-like +platforms. + +=item $addr = $interface->address([$newaddr]) + +Get or set the interface's address. + + +=item $addr = $interface->broadcast([$newaddr]) + +Get or set the interface's broadcast address. + +=item $addr = $interface->netmask([$newmask]) + +Get or set the interface's netmask. + +=item $addr = $interface->hwaddr([$newaddr]) + +Get or set the interface's hardware address. + +=item $addr = $interface->mtu([$newmtu]) + +Get or set the interface's MTU. + +=item $addr = $interface->metric([$newmetric]) + +Get or set the interface's metric. + +=item $flags = $interface->flags([$newflags]) + +Get or set the interface's flags. These can be ANDed with the IFF +constants exported by IO::Interface or Net::Interface in order to +interrogate the state and capabilities of the interface. However, it +is probably more convenient to use the broken-out methods listed +below. + +=item $flag = $interface->is_running([$newflag]) + +=item $flag = $interface->is_broadcast([$newflag]) + +=item $flag = $interface->is_pt2pt([$newflag]) + +=item $flag = $interface->is_loopback([$newflag]) + +=item $flag = $interface->is_promiscuous([$newflag]) + +=item $flag = $interface->is_multicast([$newflag]) + +=item $flag = $interface->is_notrailers([$newflag]) + +=item $flag = $interface->is_noarp([$newflag]) + +Get or set the corresponding configuration parameters. Note that the +operating system may not let you set some of these. + +=back + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +L, L, L), L, L + +=cut + -- cgit v1.2.3