IO-Interface-1.06/0000755000175000017500000000000011612062357013226 5ustar lsteinlsteinIO-Interface-1.06/META.yml0000644000175000017500000000073111612062357014500 0ustar lsteinlstein--- #YAML:1.0 name: IO-Interface version: 1.06 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 IO-Interface-1.06/Makefile.PL0000644000175000017500000000243511022256416015200 0ustar lsteinlsteinuse 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; }, ); IO-Interface-1.06/Interface.xs0000644000175000017500000004232211022256416015501 0ustar lsteinlstein#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 = NULL; 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) { if (ifap == NULL) break; if (strncmp(name, ifap -> ifa_name, IFNAMSIZ) == 0) { family = ifap -> ifa_addr -> sa_family; if (family == AF_LINK) { sdl = (struct sockaddr_dl *) ifap->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; } } 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 IO-Interface-1.06/Interface/0000755000175000017500000000000011612062357015126 5ustar lsteinlsteinIO-Interface-1.06/Interface/Simple.pm0000644000175000017500000001471210555227276016732 0ustar lsteinlsteinpackage 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 IO-Interface-1.06/t/0000755000175000017500000000000011612062357013471 5ustar lsteinlsteinIO-Interface-1.06/t/basic.t0000644000175000017500000000217111612062177014740 0ustar lsteinlstein# 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; push @loopback,$_ if $s->if_flags($_) & IFF_LOOPBACK; } print @loopback ? 'ok ':'not ok ',4,"\n"; my @local = grep {$s->if_addr($_) eq '127.0.0.1'} @loopback; print @local ? 'ok ': 'not ok ',5,"\n"; IO-Interface-1.06/t/simple.t0000644000175000017500000000233210502123155015136 0ustar lsteinlstein# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use lib './blib/lib','./blib/arch'; use Test::More tests=>11; BEGIN { use_ok('IO::Interface::Simple') } ok(!IO::Interface::Simple->new('foo23'),"returns undef for invalid interface name"); ok(!IO::Interface::Simple->new_from_address('18'),"returns undef for invalid address"); ok(!IO::Interface::Simple->new_from_index(-1),"returns undef for invalid index"); my @if = IO::Interface::Simple->interfaces; ok(@if>0, 'fetch interface list'); # find loopback interface my $loopback; foreach (@if) { next unless $_->is_running; $loopback ||= $_ if $_->is_loopback; } ok($loopback,"loopback device"); ok($loopback->address eq '127.0.0.1','loopback address'); ok($loopback->netmask eq '255.0.0.0','loopback netmask'); SKIP: { my $index = $loopback->index; skip ('index not implemented on this platform',3) unless defined $index; ok(defined $index,'loopback index'); my $if = IO::Interface::Simple->new_from_index($index); ok($if eq $loopback,"new_from_index()"); $if = IO::Interface::Simple->new_from_address('127.0.0.1'); ok($if eq $loopback,"new_from_address()"); } IO-Interface-1.06/Changes0000644000175000017500000000227011612062270014514 0ustar lsteinlsteinRevision history for Perl extension IO::Interface. 1.06 Thu Jul 21 13:40:49 EDT 2011 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. 1.04 Wed Dec 26 13:38:53 EST 2007 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. 1.02 Thu Sep 14 08:54:04 EDT 2006 More documentation fixes. 1.01 Wed Sep 13 20:52:32 EDT 2006 Documentation fix. 1.00 Wed Sep 13 17:01:46 EDT 2006 Introduced IO::Interface::Simple. Added index methods. Compiles on CygWin. 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 and Jan L. Peterson 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 IO-Interface-1.06/README0000644000175000017500000000066610031135107014102 0ustar lsteinlsteinIO::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 IO-Interface-1.06/MANIFEST0000644000175000017500000000026610502250164014353 0ustar lsteinlsteinChanges README Interface.pm Interface.xs Interface/Simple.pm MANIFEST Makefile.PL t/basic.t t/simple.t META.yml Module meta-data (added by MakeMaker) IO-Interface-1.06/Interface.pm0000644000175000017500000002053211612062307015461 0ustar lsteinlsteinpackage 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.06'; 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