@@ -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 <lincoln.stein@gmail.com>',
+ 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;
@@ -1,38 +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.
+
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 <tobez@tobez.org> and Jan L. Peterson <jlp@flipdog.com>
+ -BSD portability fixes from Anton Berezin <tobez@tobez.org> and Jan L. Peterson <jlp@flipdog.com>
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
@@ -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 E<lt>lstein@cshl.orgE<gt>
-
-This module is distributed under the same license as Perl itself.
-
-=head1 SEE ALSO
-
-L<perl>, L<IO::Socket>, L<IO::Multicast>), L<IO::Interface>, L<Net::Interface>
-
-=cut
-
@@ -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.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<IO::Interface::Simple> 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<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@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), L<IO::Interface::Simple>
-
-=cut
@@ -1,814 +0,0 @@
-#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>
-
-#ifdef HAVE_SOCKADDR_DL_STRUCT
-#include <net/if_dl.h>
-#endif
-
-#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
-
-#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
-
@@ -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.
+
@@ -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)
@@ -0,0 +1,49 @@
+{
+ "abstract" : "Access and modify network interface card configuration",
+ "author" : [
+ "Lincoln Stein <lincoln.stein@gmail.com>"
+ ],
+ "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"
+}
@@ -1,20 +1,27 @@
---- #YAML:1.0
-name: IO-Interface
-version: 1.06
-abstract: ~
-author: []
-license: unknown
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+---
+abstract: 'Access and modify network interface card configuration'
+author:
+ - 'Lincoln Stein <lincoln.stein@gmail.com>'
build_requires:
- ExtUtils::MakeMaker: 0
-requires: {}
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
+ 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'
@@ -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;
- },
-);
@@ -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 <lstein@cshl.org>
-
@@ -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 <lincoln.stein@gmail.com>
+
+License
+=======
+
+Copyright 2001-2014, Lincoln D. Stein.
+
+This library is distributed under the Perl Artistic License
+2.0. Please see LICENSE for more information.
+
+
+
+
@@ -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 <lincoln.stein@gmail.com>
+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<perl>, L<IO::Socket>, L<IO::Multicast>), L<IO::Interface>, L<Net::Interface>
+
+=cut
+
@@ -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<IO::Interface::Simple> 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<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 D. Stein <lincoln.stein@gmail.com>
+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<IO::Interface::Simple>
+
+=cut
@@ -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 <stdio.h>
+#include <string.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>
+
+#ifdef HAVE_SOCKADDR_DL_STRUCT
+#include <net/if_dl.h>
+#endif
+
+#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
+
+#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
+