r3629 - in /packages/libio-interface-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/t/ tags/
segre at users.alioth.debian.org
segre at users.alioth.debian.org
Sun Sep 3 02:21:09 UTC 2006
Author: segre
Date: Sun Sep 3 02:21:09 2006
New Revision: 3629
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3629
Log:
[svn-inject] Installing original source of libio-interface-perl
Added:
packages/libio-interface-perl/
packages/libio-interface-perl/branches/
packages/libio-interface-perl/branches/upstream/
packages/libio-interface-perl/branches/upstream/current/
packages/libio-interface-perl/branches/upstream/current/Changes
packages/libio-interface-perl/branches/upstream/current/Interface.pm
packages/libio-interface-perl/branches/upstream/current/Interface.xs
packages/libio-interface-perl/branches/upstream/current/MANIFEST
packages/libio-interface-perl/branches/upstream/current/META.yml
packages/libio-interface-perl/branches/upstream/current/Makefile.PL
packages/libio-interface-perl/branches/upstream/current/README
packages/libio-interface-perl/branches/upstream/current/t/
packages/libio-interface-perl/branches/upstream/current/t/basic.t
packages/libio-interface-perl/tags/
Added: packages/libio-interface-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Changes?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Changes (added)
+++ packages/libio-interface-perl/branches/upstream/current/Changes Sun Sep 3 02:21:09 2006
@@ -1,0 +1,20 @@
+Revision history for Perl extension IO::Interface.
+0.98 Sep 03 18:20:20 EST 2003
+ Fixed minor documentation error.
+
+0.97 May 14 16:50:46 EDT 2001
+ BSD portability fixes from Anton Berezin <tobez at tobez.org> and Jan L. Peterson <jlp at flipdog.com>
+
+0.96 May 7 10:44:48 EDT 2001
+ Documentation fixes
+
+0.94 July 17, 2000
+ Added the addr_to_interface function, and the pseudo device "any"
+ which corresponds to INADDR_ANY
+
+0.90 First release
+
+0.01 Thu May 4 08:28:45 2000
+ - original version; created by h2xs 1.20 with options
+ -n IO::Interface /usr/include/net/if.h
+
Added: packages/libio-interface-perl/branches/upstream/current/Interface.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Interface.pm?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Interface.pm (added)
+++ packages/libio-interface-perl/branches/upstream/current/Interface.pm Sun Sep 3 02:21:09 2006
@@ -1,0 +1,252 @@
+package IO::Interface;
+
+require 5.005;
+use strict;
+use Carp;
+use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD);
+
+require Exporter;
+require DynaLoader;
+use AutoLoader;
+
+my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list addr_to_interface);
+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, at flags],
+ 'functions' => \@functions,
+ 'flags' => \@flags,
+ );
+
+ at EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+ at EXPORT = qw( );
+
+ at ISA = qw(Exporter DynaLoader);
+$VERSION = '0.98';
+
+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) {
+ return $_ if $sock->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
+
+ 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.
+
+=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<Exportable constants> 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 E<lt>lstein at cshl.orgE<gt>
+
+This module is distributed under the same license as Perl itself.
+
+=head1 SEE ALSO
+
+perl(1), IO::Socket(3), IO::Multicast(3)
+
+=cut
Added: packages/libio-interface-perl/branches/upstream/current/Interface.xs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Interface.xs?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Interface.xs (added)
+++ packages/libio-interface-perl/branches/upstream/current/Interface.xs Sun Sep 3 02:21:09 2006
@@ -1,0 +1,626 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* socket definitions */
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/ioctl.h>
+
+/* location of IFF_* constants */
+#include <net/if.h>
+
+/* location of getifaddrs() definition */
+#ifdef USE_GETIFADDRS
+#include <ifaddrs.h>
+#endif
+
+#ifndef SIOCGIFCONF
+#include <sys/sockio.h>
+#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
+
+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,int 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;
+ int 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");
+ operation = SIOCSIFADDR;
+ } 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;
+ int 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");
+ operation = SIOCSIFBRDADDR;
+ } 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;
+ int 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");
+ operation = SIOCSIFNETMASK;
+ } 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;
+ int 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");
+ operation = SIOCSIFDSTADDR;
+ } 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;
+ int operation;
+ struct ifreq ifr;
+ char *newaddr,hwaddr[128];
+ CODE:
+ {
+#if !(defined(HAS_IOCTL) && defined(SIOCGIFHWADDR))
+ XSRETURN_UNDEF;
+#else
+ 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");
+ operation = SIOCSIFHWADDR;
+ } 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:
+ int operation,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));
+ operation = SIOCSIFFLAGS;
+ } else {
+ operation = SIOCGIFFLAGS;
+ }
+ if (!Ioctl(sock,operation,&ifr)) XSRETURN_UNDEF;
+ RETVAL = ifr.ifr_flags;
+ }
+ 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
Added: packages/libio-interface-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/MANIFEST?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libio-interface-perl/branches/upstream/current/MANIFEST Sun Sep 3 02:21:09 2006
@@ -1,0 +1,9 @@
+Changes
+README
+Interface.pm
+Interface.xs
+MANIFEST
+Makefile.PL
+t/basic.t
+
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libio-interface-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/META.yml?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/META.yml (added)
+++ packages/libio-interface-perl/branches/upstream/current/META.yml Sun Sep 3 02:21:09 2006
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: IO-Interface
+version: 0.98
+version_from: Interface.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libio-interface-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/Makefile.PL?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libio-interface-perl/branches/upstream/current/Makefile.PL Sun Sep 3 02:21:09 2006
@@ -1,0 +1,24 @@
+use ExtUtils::MakeMaker;
+use Config;
+
+my @libs = ();
+push @libs,'-lresolv' unless $Config{d_inetaton};
+
+WriteMakefile(
+ 'NAME' => 'IO::Interface',
+ 'VERSION_FROM' => 'Interface.pm', # finds $VERSION
+ 'LIBS' => ["@libs"], # e.g., '-lm'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+ CONFIGURE => sub {
+ my %attrs;
+ 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";
+ }
+ \%attrs;
+ },
+);
Added: packages/libio-interface-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/README?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/README (added)
+++ packages/libio-interface-perl/branches/upstream/current/README Sun Sep 3 02:21:09 2006
@@ -1,0 +1,11 @@
+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 <lstein at cshl.org>
+
Added: packages/libio-interface-perl/branches/upstream/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-interface-perl/branches/upstream/current/t/basic.t?rev=3629&op=file
==============================================================================
--- packages/libio-interface-perl/branches/upstream/current/t/basic.t (added)
+++ packages/libio-interface-perl/branches/upstream/current/t/basic.t Sun Sep 3 02:21:09 2006
@@ -1,0 +1,38 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use IO::Socket;
+use IO::Interface ':flags';
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+print defined(IFF_LOOPBACK) ? 'ok ':'not ok ',2,"\n";
+my $s = IO::Socket::INET->new(Proto => 'udp');
+
+my @if = $s->if_list;
+print @if ? 'ok ': 'not ok ',3,"\n";
+
+# find loopback interface
+my $loopback;
+foreach (@if) {
+ next unless $s->if_flags($_) & IFF_UP;
+ $loopback = $_ if $s->if_flags($_) & IFF_LOOPBACK;
+}
+
+print $loopback ? 'ok ':'not ok ',4,"\n";
+print $s->if_addr($loopback) eq '127.0.0.1' ? 'ok ': 'not ok ',5,"\n";
+
+
More information about the Pkg-perl-cvs-commits
mailing list