From 256b1eb17c4de63a3aa795a7ac836348e9e3dfea Mon Sep 17 00:00:00 2001 From: waynieack Date: Fri, 10 Feb 2017 23:21:23 -0600 Subject: [PATCH] Added lib/site/IO/Interface --- lib/site/IO/Interface.pm | 303 ++++++++++++++++++++++++++++++++ lib/site/IO/Interface/Simple.pm | 287 ++++++++++++++++++++++++++++++ 2 files changed, 590 insertions(+) create mode 100644 lib/site/IO/Interface.pm create mode 100644 lib/site/IO/Interface/Simple.pm diff --git a/lib/site/IO/Interface.pm b/lib/site/IO/Interface.pm new file mode 100644 index 000000000..419aa004b --- /dev/null +++ b/lib/site/IO/Interface.pm @@ -0,0 +1,303 @@ +package IO::Interface; + +require 5.005; +use strict; +use Carp; +use vars qw(@EXPORT @EXPORT_OK @ISA %EXPORT_TAGS $VERSION $AUTOLOAD); + +use IO::Socket; + +require Exporter; +require DynaLoader; + +my @functions = qw(if_addr if_broadcast if_netmask if_dstaddr if_hwaddr if_flags if_list if_mtu if_metric + addr_to_interface if_index if_indextoname ); +my @flags = qw(IFF_ALLMULTI IFF_AUTOMEDIA IFF_BROADCAST + IFF_DEBUG IFF_LOOPBACK IFF_MASTER + IFF_MULTICAST IFF_NOARP IFF_NOTRAILERS + IFF_POINTOPOINT IFF_PORTSEL IFF_PROMISC + IFF_RUNNING IFF_SLAVE IFF_UP); +%EXPORT_TAGS = ( 'all' => [@functions,@flags], + 'functions' => \@functions, + 'flags' => \@flags, + ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@EXPORT = qw( ); + +@ISA = qw(Exporter DynaLoader); +$VERSION = '1.09'; + +sub AUTOLOAD { + # This AUTOLOAD is used to 'autoload' constants from the constant() + # XS function. If a constant is not found then control is passed + # to the AUTOLOAD in AutoLoader. + + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + croak "&constant not defined" if $constname eq 'constant'; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined IO::Interface macro $constname"; + } + } + { + no strict 'refs'; + *$AUTOLOAD = sub { $val }; # *$AUTOLOAD = sub() { $val }; + } + goto &$AUTOLOAD; +} + +bootstrap IO::Interface $VERSION; + +# copy routines into IO::Socket +{ + no strict 'refs'; + *{"IO\:\:Socket\:\:$_"} = \&$_ foreach @functions; +} + +# Preloaded methods go here. + +sub if_list { + my %hash = map {$_=>undef} &_if_list; + sort keys %hash; +} + +sub addr_to_interface { + my ($sock,$addr) = @_; + return "any" if $addr eq '0.0.0.0'; + my @interfaces = $sock->if_list; + foreach (@interfaces) { + my $if_addr = $sock->if_addr($_) or next; + return $_ if $if_addr eq $addr; + } + return; # couldn't find it +} + +# Autoload methods go after =cut, and are processed by the autosplit program. +1; +__END__ + +=head1 NAME + +IO::Interface - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + # ====================== + # the new, preferred API + # ====================== + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + + # =========== + # the old API + # =========== + + use IO::Socket; + use IO::Interface qw(:flags); + + my $s = IO::Socket::INET->new(Proto => 'udp'); + my @interfaces = $s->if_list; + + for my $if (@interfaces) { + print "interface = $if\n"; + my $flags = $s->if_flags($if); + print "addr = ",$s->if_addr($if),"\n", + "broadcast = ",$s->if_broadcast($if),"\n", + "netmask = ",$s->if_netmask($if),"\n", + "dstaddr = ",$s->if_dstaddr($if),"\n", + "hwaddr = ",$s->if_hwaddr($if),"\n"; + + print "is running\n" if $flags & IFF_RUNNING; + print "is broadcast\n" if $flags & IFF_BROADCAST; + print "is p-to-p\n" if $flags & IFF_POINTOPOINT; + print "is loopback\n" if $flags & IFF_LOOPBACK; + print "is promiscuous\n" if $flags & IFF_PROMISC; + print "is multicast\n" if $flags & IFF_MULTICAST; + print "is notrailers\n" if $flags & IFF_NOTRAILERS; + print "is noarp\n" if $flags & IFF_NOARP; + } + + my $interface = $s->addr_to_interface('127.0.0.1'); + + +=head1 DESCRIPTION + +IO::Interface adds methods to IO::Socket objects that allows them to +be used to retrieve and change information about the network +interfaces on your system. In addition to the object-oriented access +methods, you can use a function-oriented style. + +THIS API IS DEPRECATED. Please see L for the +preferred way to get and set interface configuration information. + +=head2 Creating a Socket to Access Interface Information + +You must create a socket before you can access interface +information. The socket does not have to be connected to a remote +site, or even used for communication. The simplest procedure is to +create a UDP protocol socket: + + my $s = IO::Socket::INET->new(Proto => 'udp'); + +The various IO::Interface functions will now be available as methods +on this socket. + +=head2 Methods + +=over 4 + +=item @iflist = $s->if_list + +The if_list() method will return a list of active interface names, for +example "eth0" or "tu0". If no interfaces are configured and running, +returns an empty list. + +=item $addr = $s->if_addr($ifname [,$newaddr]) + +if_addr() gets or sets the interface address. Call with the interface +name to retrieve the address (in dotted decimal format). Call with a +new address to set the interface. In the latter case, the routine +will return a true value if the operation was successful. + + my $oldaddr = $s->if_addr('eth0'); + $s->if_addr('eth0','192.168.8.10') || die "couldn't set address: $!"; + +Special case: the address of the pseudo-device "any" will return the +IP address "0.0.0.0", which corresponds to the INADDR_ANY constant. + +=item $broadcast = $s->if_broadcast($ifname [,$newbroadcast] + +Get or set the interface broadcast address. If the interface does not +have a broadcast address, returns undef. + +=item $mask = $s->if_netmask($ifname [,$newmask]) + +Get or set the interface netmask. + +=item $dstaddr = $s->if_dstaddr($ifname [,$newdest]) + +Get or set the destination address for point-to-point interfaces. + +=item $hwaddr = $s->if_hwaddr($ifname [,$newhwaddr]) + +Get or set the hardware address for the interface. Currently only +ethernet addresses in the form "00:60:2D:2D:51:70" are accepted. + +=item $flags = $s->if_flags($ifname [,$newflags]) + +Get or set the flags for the interface. The flags are a bitmask +formed from a series of constants. See L below. + +=item $ifname = $s->addr_to_interface($ifaddr) + +Given an interface address in dotted form, returns the name of the +interface associated with it. Special case: the INADDR_ANY address, +0.0.0.0 will return a pseudo-interface name of "any". + +=back + +=head2 EXPORT + +IO::Interface exports nothing by default. However, you can import the +following symbol groups into your namespace: + + :functions Function-oriented interface (see below) + :flags Flag constants (see below) + :all All of the above + +=head2 Function-Oriented Interface + +By importing the ":functions" set, you can access IO::Interface in a +function-oriented manner. This imports all the methods described +above into your namespace. Example: + + use IO::Socket; + use IO::Interface ':functions'; + + my $sock = IO::Socket::INET->new(Proto=>'udp'); + my @interfaces = if_list($sock); + print "address = ",if_addr($sock,$interfaces[0]); + +=head2 Exportable constants + +The ":flags" constant imports the following constants for use with the +flags returned by if_flags(): + + IFF_ALLMULTI + IFF_AUTOMEDIA + IFF_BROADCAST + IFF_DEBUG + IFF_LOOPBACK + IFF_MASTER + IFF_MULTICAST + IFF_NOARP + IFF_NOTRAILERS + IFF_POINTOPOINT + IFF_PORTSEL + IFF_PROMISC + IFF_RUNNING + IFF_SLAVE + IFF_UP + +This example determines whether interface 'tu0' supports multicasting: + + use IO::Socket; + use IO::Interface ':flags'; + my $sock = IO::Socket::INET->new(Proto=>'udp'); + print "can multicast!\n" if $sock->if_flags & IFF_MULTICAST. + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +perl(1), IO::Socket(3), IO::Multicast(3), L + +=cut diff --git a/lib/site/IO/Interface/Simple.pm b/lib/site/IO/Interface/Simple.pm new file mode 100644 index 000000000..def0b1ebf --- /dev/null +++ b/lib/site/IO/Interface/Simple.pm @@ -0,0 +1,287 @@ +package IO::Interface::Simple; +use strict; +use IO::Socket; +use IO::Interface; + +use overload '""' => \&as_string, + eq => '_eq_', + fallback => 1; + +# class variable +my $socket; + +# class methods +sub interfaces { + my $class = shift; + my $s = $class->sock; + return sort {($a->index||0) <=> ($b->index||0) } map {$class->new($_)} $s->if_list; +} + +sub new { + my $class = shift; + my $if_name = shift; + my $s = $class->sock; + return unless defined $s->if_mtu($if_name); + return bless {s => $s, + name => $if_name},ref $class || $class; +} + +sub new_from_address { + my $class = shift; + my $addr = shift; + my $s = $class->sock; + my $name = $s->addr_to_interface($addr) or return; + return $class->new($name); +} + +sub new_from_index { + my $class = shift; + my $index = shift; + my $s = $class->sock; + my $name = $s->if_indextoname($index) or return; + return $class->new($name); +} + +sub sock { + my $self = shift; + if (ref $self) { + return $self->{s} ||= $socket; + } else { + return $socket ||= IO::Socket::INET->new(Proto=>'udp'); + } +} + +sub _eq_ { + return shift->name eq shift; +} + +sub as_string { + shift->name; +} + +sub name { + shift->{name}; +} + +sub address { + my $self = shift; + $self->sock->if_addr($self->name,@_); +} + +sub broadcast { + my $self = shift; + $self->sock->if_broadcast($self->name,@_); +} + +sub netmask { + my $self = shift; + $self->sock->if_netmask($self->name,@_); +} + +sub dstaddr { + my $self = shift; + $self->sock->if_dstaddr($self->name,@_); +} + +sub hwaddr { + my $self = shift; + $self->sock->if_hwaddr($self->name,@_); +} + +sub flags { + my $self = shift; + $self->sock->if_flags($self->name,@_); +} + +sub mtu { + my $self = shift; + $self->sock->if_mtu($self->name,@_); +} + +sub metric { + my $self = shift; + $self->sock->if_metric($self->name,@_); +} + +sub index { + my $self = shift; + return $self->sock->if_index($self->name); +} + +sub is_running { shift->_gettestflag(IO::Interface::IFF_RUNNING(),@_) } +sub is_broadcast { shift->_gettestflag(IO::Interface::IFF_BROADCAST(),@_) } +sub is_pt2pt { shift->_gettestflag(IO::Interface::IFF_POINTOPOINT(),@_) } +sub is_loopback { shift->_gettestflag(IO::Interface::IFF_LOOPBACK(),@_) } +sub is_promiscuous { shift->_gettestflag(IO::Interface::IFF_PROMISC(),@_) } +sub is_multicast { shift->_gettestflag(IO::Interface::IFF_MULTICAST(),@_) } +sub is_notrailers { shift->_gettestflag(IO::Interface::IFF_NOTRAILERS(),@_) } +sub is_noarp { shift->_gettestflag(IO::Interface::IFF_NOARP(),@_) } + +sub _gettestflag { + my $self = shift; + my $bitmask = shift; + my $flags = $self->flags; + if (@_) { + $flags |= $bitmask; + $self->flags($flags); + } else { + return ($flags & $bitmask) != 0; + } +} + +1; + +=head1 NAME + +IO::Interface::Simple - Perl extension for access to network card configuration information + +=head1 SYNOPSIS + + use IO::Interface::Simple; + + my $if1 = IO::Interface::Simple->new('eth0'); + my $if2 = IO::Interface::Simple->new_from_address('127.0.0.1'); + my $if3 = IO::Interface::Simple->new_from_index(1); + + my @interfaces = IO::Interface::Simple->interfaces; + + for my $if (@interfaces) { + print "interface = $if\n"; + print "addr = ",$if->address,"\n", + "broadcast = ",$if->broadcast,"\n", + "netmask = ",$if->netmask,"\n", + "dstaddr = ",$if->dstaddr,"\n", + "hwaddr = ",$if->hwaddr,"\n", + "mtu = ",$if->mtu,"\n", + "metric = ",$if->metric,"\n", + "index = ",$if->index,"\n"; + + print "is running\n" if $if->is_running; + print "is broadcast\n" if $if->is_broadcast; + print "is p-to-p\n" if $if->is_pt2pt; + print "is loopback\n" if $if->is_loopback; + print "is promiscuous\n" if $if->is_promiscuous; + print "is multicast\n" if $if->is_multicast; + print "is notrailers\n" if $if->is_notrailers; + print "is noarp\n" if $if->is_noarp; + } + + +=head1 DESCRIPTION + +IO::Interface::Simple allows you to interrogate and change network +interfaces. It has overlapping functionality with Net::Interface, but +might compile and run on more platforms. + +=head2 Class Methods + +=over 4 + +=item $interface = IO::Interface::Simple->new('eth0') + +Given an interface name, new() creates an interface object. + +=item @iflist = IO::Interface::Simple->interfaces; + +Returns a list of active interface objects. + +=item $interface = IO::Interface::Simple->new_from_address('192.168.0.1') + +Returns the interface object corresponding to the given address. + +=item $interface = IO::Interface::Simple->new_from_index(2) + +Returns the interface object corresponding to the given numeric +index. This is only supported on BSD-ish platforms. + +=back + +=head2 Object Methods + +=over 4 + +=item $name = $interface->name + +Get the name of the interface. The interface object is also overloaded +so that if you use it in a string context it is the same as calling +name(). + +=item $index = $interface->index + +Get the index of the interface. This is only supported on BSD-like +platforms. + +=item $addr = $interface->address([$newaddr]) + +Get or set the interface's address. + + +=item $addr = $interface->broadcast([$newaddr]) + +Get or set the interface's broadcast address. + +=item $addr = $interface->netmask([$newmask]) + +Get or set the interface's netmask. + +=item $addr = $interface->hwaddr([$newaddr]) + +Get or set the interface's hardware address. + +=item $addr = $interface->mtu([$newmtu]) + +Get or set the interface's MTU. + +=item $addr = $interface->metric([$newmetric]) + +Get or set the interface's metric. + +=item $flags = $interface->flags([$newflags]) + +Get or set the interface's flags. These can be ANDed with the IFF +constants exported by IO::Interface or Net::Interface in order to +interrogate the state and capabilities of the interface. However, it +is probably more convenient to use the broken-out methods listed +below. + +=item $flag = $interface->is_running([$newflag]) + +=item $flag = $interface->is_broadcast([$newflag]) + +=item $flag = $interface->is_pt2pt([$newflag]) + +=item $flag = $interface->is_loopback([$newflag]) + +=item $flag = $interface->is_promiscuous([$newflag]) + +=item $flag = $interface->is_multicast([$newflag]) + +=item $flag = $interface->is_notrailers([$newflag]) + +=item $flag = $interface->is_noarp([$newflag]) + +Get or set the corresponding configuration parameters. Note that the +operating system may not let you set some of these. + +=back + +=head1 AUTHOR + +Lincoln D. Stein +Copyright 2001-2014, Lincoln D. Stein. + +This library is distributed under the Perl Artistic License +2.0. Please see LICENSE for more information. + +=head1 SUPPORT + +For feature requests, bug reports and code contributions, please use +the GitHub repository at +https://github.com/lstein/LibIO-Interface-Perl + +=head1 SEE ALSO + +L, L, L), L, L + +=cut +