r73425 - in /branches/upstream/libparanoid-perl/current: CHANGELOG META.yml Makefile.PL lib/Paranoid.pm lib/Paranoid/Input.pm lib/Paranoid/Network.pm t/13_network.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Apr 24 17:21:19 UTC 2011
Author: gregoa
Date: Sun Apr 24 17:21:03 2011
New Revision: 73425
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=73425
Log:
[svn-upgrade] new version libparanoid-perl (0.29)
Modified:
branches/upstream/libparanoid-perl/current/CHANGELOG
branches/upstream/libparanoid-perl/current/META.yml
branches/upstream/libparanoid-perl/current/Makefile.PL
branches/upstream/libparanoid-perl/current/lib/Paranoid.pm
branches/upstream/libparanoid-perl/current/lib/Paranoid/Input.pm
branches/upstream/libparanoid-perl/current/lib/Paranoid/Network.pm
branches/upstream/libparanoid-perl/current/t/13_network.t
Modified: branches/upstream/libparanoid-perl/current/CHANGELOG
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/CHANGELOG?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/CHANGELOG (original)
+++ branches/upstream/libparanoid-perl/current/CHANGELOG Sun Apr 24 17:21:03 2011
@@ -1,4 +1,21 @@
CHANGELOG
+
+v0.29 (2011/04/15)
+==================
+--Perl-5.6 compatibility fix: Socket in 5.6 doesn't export AF/PF_INET6,
+ so using Socket6's exclusively
+--Perl-5.8 compatibility fix: Perl's parser chokes on the use of 'bare
+ word' imports (i.e., AF_INET), so calling them as subs.
+--Optimizing regexes with code-based interpolations of constants
+--Misc code adjustments
+
+v0.28 (2011/04/12)
+==================
+--Updated ipInNetwork in Paranoid::Network to support IPv6 networks &
+ addresses
+--Added new function extractIPs to Paranoid::Network which can extract IPv4/
+ IPv6 addresses from arbitrary text
+--Minor tweaks to some regexes in Paranoid::Input
v0.27 (2010/06/03)
==================
Modified: branches/upstream/libparanoid-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/META.yml?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/META.yml (original)
+++ branches/upstream/libparanoid-perl/current/META.yml Sun Apr 24 17:21:03 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Paranoid
-version: 0.27
+version: 0.29
abstract: General function library for safer, more secure programming
author:
- Arthur Corliss <corliss at digitalmages.com>
@@ -8,15 +8,13 @@
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
-requires:
- BerkeleyDB: 0.32
- Carp: 0
- Errno: 0
- Fcntl: 0
- File::Glob: 0
- Net::SMTP: 0
- POSIX: 0
- Unix::Syslog: 1.1
+requires:
+ Carp: 0
+ Errno: 0
+ Fcntl: 0
+ File::Glob: 0
+ POSIX: 0
+
no_index:
directory:
- t
@@ -25,3 +23,8 @@
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
+recommends:
+ Unix::Syslog: 1.1
+ Net::SMTP: 0
+ BerkeleyDB: 0.32
+ Socket6: 0.23
Modified: branches/upstream/libparanoid-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/Makefile.PL?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/Makefile.PL (original)
+++ branches/upstream/libparanoid-perl/current/Makefile.PL Sun Apr 24 17:21:03 2011
@@ -17,6 +17,33 @@
These modules will still be installed, they just won't be usable until those
dependencies are resolved.
+The following modules have optional dependencies:
+
+ Module Dependencies
+ ===========================================================
+ Paranoid::Network Socket6
+
+You only need this installed if you wish to work with IPv6 networks in
+addition to IPv4.
+
+__EOF__
+
+# Required modules
+my %reqMods = (
+ 'Carp' => 0,
+ 'Errno' => 0,
+ 'Fcntl' => 0,
+ 'File::Glob' => 0,
+ 'POSIX' => 0,
+ );
+
+my $required = << "__EOF__";
+
+ Carp: $reqMods{'Carp'}
+ Errno: $reqMods{'Errno'}
+ Fcntl: $reqMods{'Fcntl'}
+ File::Glob: $reqMods{'File::Glob'}
+ POSIX: $reqMods{'POSIX'}
__EOF__
my %optMods;
@@ -31,6 +58,17 @@
if ( eval 'require BerkeleyDB; 1;' ) {
$optMods{'BerkeleyDB'} = 0.32;
}
+if ( eval 'require Socket; require Socket6; 1;' ) {
+ $optMods{'Socket6'} = 0.23;
+}
+
+my $recommended = << "__EOF__";
+
+ Unix::Syslog: $optMods{'Unix::Syslog'}
+ Net::SMTP: $optMods{'Net::SMTP'}
+ BerkeleyDB: $optMods{'BerkeleyDB'}
+ Socket6: $optMods{'Socket6'}
+__EOF__
# Create the makefile
WriteMakefile(
@@ -38,16 +76,11 @@
ABSTRACT => 'General function library for safer, more secure programming',
AUTHOR => 'Arthur Corliss <corliss at digitalmages.com>',
VERSION_FROM => 'lib/Paranoid.pm',
- PREREQ_PM => {
- 'Carp' => 0,
- 'Errno' => 0,
- 'Fcntl' => 0,
- 'File::Glob' => 0,
- 'POSIX' => 0,
- %optMods
- },
+ PREREQ_PM => { %reqMods, %optMods },
($ExtUtils::MakeMaker::VERSION ge '6.30_00' ? (
- LICENSE => 'perl',) : ()),
+ LICENSE => 'perl',
+ META_ADD => { 'recommends' => $recommended ,
+ 'requires' => $required }) : ()),
);
exit 0;
Modified: branches/upstream/libparanoid-perl/current/lib/Paranoid.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/lib/Paranoid.pm?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/lib/Paranoid.pm (original)
+++ branches/upstream/libparanoid-perl/current/lib/Paranoid.pm Sun Apr 24 17:21:03 2011
@@ -2,7 +2,7 @@
#
# (c) 2005, Arthur Corliss <corliss at digitalmages.com>
#
-# $Id: Paranoid.pm,v 0.27 2010/06/03 19:05:21 acorliss Exp $
+# $Id: Paranoid.pm,v 0.29 2011/04/15 22:05:29 acorliss Exp $
#
# This software is licensed under the same terms as Perl, itself.
# Please see http://dev.perl.org/licenses/ for more information.
@@ -24,7 +24,7 @@
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
-($VERSION) = ( q$Revision: 0.27 $ =~ /(\d+(?:\.(\d+))+)/sm );
+($VERSION) = ( q$Revision: 0.29 $ =~ /(\d+(?:\.(\d+))+)/sm );
@EXPORT = qw(psecureEnv);
@EXPORT_OK = qw(psecureEnv);
@@ -98,7 +98,7 @@
=head1 VERSION
-$Id: Paranoid.pm,v 0.27 2010/06/03 19:05:21 acorliss Exp $
+$Id: Paranoid.pm,v 0.29 2011/04/15 22:05:29 acorliss Exp $
=head1 SYNOPSIS
Modified: branches/upstream/libparanoid-perl/current/lib/Paranoid/Input.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/lib/Paranoid/Input.pm?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/lib/Paranoid/Input.pm (original)
+++ branches/upstream/libparanoid-perl/current/lib/Paranoid/Input.pm Sun Apr 24 17:21:03 2011
@@ -2,7 +2,7 @@
#
# (c) 2005, Arthur Corliss <corliss at digitalmages.com>
#
-# $Id: Input.pm,v 0.19 2010/05/05 23:30:33 acorliss Exp $
+# $Id: Input.pm,v 0.20 2011/04/13 22:01:43 acorliss Exp $
#
# This software is licensed under the same terms as Perl, itself.
# Please see http://dev.perl.org/licenses/ for more information.
@@ -28,7 +28,7 @@
use Paranoid::Debug qw(:all);
use Carp;
-($VERSION) = ( q$Revision: 0.19 $ =~ /(\d+(?:\.(\d+))+)/sm );
+($VERSION) = ( q$Revision: 0.20 $ =~ /(\d+(?:\.(\d+))+)/sm );
@EXPORT = qw(FSZLIMIT LNSZLIMIT slurp sip tail closeFile
detaint stringMatch);
@@ -535,7 +535,7 @@
filename => qr#[/ \w\-\.:,@\+]+\[?#sm,
fileglob => qr#[/ \w\-\.:,@\+\*\?\{\}\[\]]+\[?#sm,
hostname => qr/(?:[a-zA-Z0-9][a-zA-Z0-9\-]*\.)*[a-zA-Z0-9]+/sm,
- ipaddr => qr/(?:\d+\.){3}\d+/sm,
+ ipaddr => qr/(?:\d{1,3}\.){3}\d{1,3}/sm,
netaddr => qr#^(?:\d+\.){3}\d+(?:/(?:\d+|(?:\d+\.){3}\d+))?$#sm,
login => qr/[a-zA-Z][\w\.\-]*/sm,
nometa => qr/[^\%\`\$\!\@]+/sm,
@@ -680,7 +680,7 @@
=head1 VERSION
-$Id: Input.pm,v 0.19 2010/05/05 23:30:33 acorliss Exp $
+$Id: Input.pm,v 0.20 2011/04/13 22:01:43 acorliss Exp $
=head1 SYNOPSIS
Modified: branches/upstream/libparanoid-perl/current/lib/Paranoid/Network.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/lib/Paranoid/Network.pm?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/lib/Paranoid/Network.pm (original)
+++ branches/upstream/libparanoid-perl/current/lib/Paranoid/Network.pm Sun Apr 24 17:21:03 2011
@@ -2,7 +2,7 @@
#
# (c) 2005, Arthur Corliss <corliss at digitalmages.com>
#
-# $Id: Network.pm,v 0.61 2009/03/05 00:07:00 acorliss Exp $
+# $Id: Network.pm,v 0.64 2011/04/15 22:05:13 acorliss Exp $
#
# This software is licensed under the same terms as Perl, itself.
# Please see http://dev.perl.org/licenses/ for more information.
@@ -24,14 +24,27 @@
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Paranoid::Debug qw(:all);
+use Paranoid::Module;
use Socket;
use Carp;
-($VERSION) = ( q$Revision: 0.61 $ =~ /(\d+(?:\.(\d+))+)/sm );
-
- at EXPORT = qw(ipInNetwork hostInDomain);
- at EXPORT_OK = qw(ipInNetwork hostInDomain);
-%EXPORT_TAGS = ( all => [qw(ipInNetwork hostInDomain)], );
+($VERSION) = ( q$Revision: 0.64 $ =~ /(\d+(?:\.(\d+))+)/sm );
+
+ at EXPORT = qw(ipInNetwork hostInDomain extractIPs);
+ at EXPORT_OK = qw(ipInNetwork hostInDomain extractIPs);
+%EXPORT_TAGS = ( all => [qw(ipInNetwork hostInDomain extractIPs)], );
+
+use constant CHUNK => 32;
+use constant IPV6CHUNKS => 4;
+use constant MAXIPV4CIDR => 32;
+use constant MAXIPV6CIDR => 128;
+use constant MASK => 0xffffffff;
+use constant IP4REGEX => qr/(?:\d{1,3}\.){3}\d{1,3}/sm;
+use constant IP6REGEX => qr/
+ :(?::[abcdef\d]{1,4}){1,7} |
+ [abcdef\d]{1,4}(?:::?[abcdef\d]{1,4}){1,7} |
+ (?:[abcdef\d]{1,4}:){1,7}:
+ /smix;
#####################################################################
#
@@ -49,56 +62,176 @@
my $ip = shift;
my @networks = @_;
my $rv = 0;
- my ( $bip, $bnet, $bmask );
+ my $oip = $ip;
+ my ( $bip, $bnet, $bmask, $family, @tmp, $irv );
+ my ( $inet_pton, $af_inet6 );
# Validate arguments
- croak 'Mandatory first argument must be a defined IP address'
- unless defined $ip && $ip =~ m#^(?:(?:\d+\.){3})?\d+$#sm;
-
- pdebug( "entering w/($ip)(@networks)", PDLEVEL1 );
+ if ( defined $ip ) {
+
+ # Test for an IPv4 address
+ if ( $ip =~ m/^@{[ IP4REGEX ]}$/smo and defined inet_aton($ip) ) {
+ $family = AF_INET();
+ } else {
+
+ # If Socket6 is present we'll check for an IPv6 address
+ if ( loadModule('Socket6') ) {
+
+ $inet_pton = \&Socket6::inet_pton;
+ $af_inet6 = \&Socket6::AF_INET6;
+ if ( defined &$inet_pton( &$af_inet6(), $ip ) ) {
+
+ # Convert IPv6-encoded IPv4 addresses to pure IPv4
+ if ( $ip =~ m/^::ffff:(@{[ IP4REGEX ]})$/smio ) {
+ $ip = $1;
+ $family = AF_INET();
+ } else {
+ $family = &$af_inet6();
+ }
+ } else {
+ croak 'Mandatory first argument must be a '
+ . 'defined IPv4/IPv6 address';
+ }
+ } else {
+ croak 'Mandatory first argument must be a valid IPv4 address';
+ }
+ }
+ } else {
+ croak 'Mandatory first argument must be a defined IP address';
+ }
+
+ pdebug( "entering w/($oip)(@networks)", PDLEVEL1 );
pIn();
# Filter out non-IP data from @networks
@networks = grep {
- defined $_
- && m#^(?:\d+\.){3}\d+(?:/(?:\d+|(?:\d+\.){3}\d+))?$#sm
+ if ( defined $_
+ && m#^([\d\.]+|[abcdef\d:]+)(?:/(?:\d+|@{[ IP4REGEX ]}))?$#smio )
+ {
+ defined(
+ $family == AF_INET()
+ ? inet_aton($1)
+ : &$inet_pton( &$af_inet6(), $1 ) );
+ }
} @networks;
# Start the comparisons
if (@networks) {
- # Convert IP to binary if necessary
- $bip = unpack 'N', inet_aton($ip);
+ pdebug( "networks to compare: @{[ join ', ', @networks ]}",
+ PDLEVEL2 );
+
+ # Convert IP to binary
+ $bip =
+ $family == AF_INET()
+ ? [ unpack 'N', inet_aton($ip) ]
+ : [ unpack 'NNNN', &$inet_pton( &$af_inet6(), $ip ) ];
# Compare against all networks
foreach (@networks) {
- # Get the netmask
- if (m#^(?:\d+\.){3}\d+$#sm) {
-
- # No netmask means all ones
- $bmask = 0xffffffff;
-
- } elsif (m#^(?:\d+\.){3}\d+/((?:\d+\.){3}\d+)$#sm) {
-
- # in IP notation
- $bmask = unpack 'N', inet_aton($1);
+ if ( $_ =~ m#^([^/]+)(?:/(.+))?$#sm ) {
+ ( $bnet, $bmask ) = ( $1, $2 );
+ }
+
+ # See if it's a network address
+ if ( defined $bmask and length $bmask ) {
+
+ # Get the netmask
+ if ( $family == AF_INET() ) {
+
+ # Convert IPv4/CIDR notation to a binary number
+ $bmask =
+ ( $bmask =~ m/^\d+$/sm and $bmask <= MAXIPV4CIDR )
+ ? [ MASK - ( ( 2**( CHUNK - $bmask ) ) - 1 ) ]
+ : ( $bmask =~ m/^@{[ IP4REGEX ]}$/smo
+ and defined inet_aton($ip) )
+ ? [ unpack 'N', inet_aton($bmask) ]
+ : undef;
+
+ } else {
+
+ # Convert IPv6 CIDR notation to a binary number
+ if ( $bmask =~ m/^\d+$/sm and $bmask <= MAXIPV6CIDR ) {
+
+ # Add the mask in 32-bit chunks
+ @tmp = ();
+ while ( $bmask >= CHUNK ) {
+ push @tmp, MASK;
+ $bmask -= CHUNK;
+ }
+
+ # Push the final segment if there's a remainder
+ if ($bmask) {
+ push @tmp,
+ MASK - ( ( 2**( CHUNK - $bmask ) ) - 1 );
+ }
+
+ # Add zero'd chunks to fill it out
+ while ( @tmp < IPV6CHUNKS ) {
+ push @tmp, 0x0;
+ }
+
+ # Finally, save the chunks
+ $bmask = [@tmp];
+
+ } else {
+ $bmask = undef;
+ }
+ }
+
+ # Skip if the netmask was invalid
+ next unless defined $bmask;
+
+ # Convert network address to binary
+ $bnet =
+ $family == AF_INET()
+ ? [ unpack 'N', inet_aton($bnet) ]
+ : [ unpack 'NNNN', &$inet_pton( &$af_inet6(), $bnet ) ];
+
+ # Start comparing our chunks
+ $irv = 1;
+ @tmp = @$bip;
+ while (@tmp) {
+ unless ( ( $tmp[0] & $$bmask[0] ) ==
+ ( $$bnet[0] & $$bmask[0] ) ) {
+ $irv = 0;
+ last;
+ }
+ shift @tmp;
+ shift @$bnet;
+ shift @$bmask;
+ }
+ if ($irv) {
+ pdebug( "matched against $_", PDLEVEL2 );
+ $rv = 1;
+ last;
+ }
} else {
- # in integer form
- m#^(?:\d+\.){3}\d+/(\d+)$#sm;
- $bmask = 0xffffffff - ( ( 2**( 32 - $1 ) ) - 1 );
- }
-
- # Convert network to binary
- m#^((?:\d+\.){3}\d+)#sm;
- $bnet = unpack 'N', inet_aton($1);
-
- # Compare ip/mask to net/mask
- if ( ( $bip & $bmask ) == ( $bnet & $bmask ) ) {
- $rv = 1;
- last;
+ # Not a network address, so let's see if it's an exact match
+ $bnet =
+ $family == AF_INET()
+ ? [ unpack 'N', inet_aton($_) ]
+ : [ unpack 'NNNN', &$inet_pton( &$af_inet6(), $_ ) ];
+
+ # Do the comparison
+ $irv = 1;
+ @tmp = @$bip;
+ while (@tmp) {
+ unless ( $tmp[0] == $$bnet[0] ) {
+ $irv = 0;
+ last;
+ }
+ shift @tmp;
+ shift @$bnet;
+ }
+ if ($irv) {
+ pdebug( "matched against $_", PDLEVEL2 );
+ $rv = 1;
+ last;
+ }
}
}
}
@@ -146,6 +279,53 @@
return $rv;
}
+sub extractIPs (@) {
+
+ # Purpose: Extracts IPv4/IPv6 addresses from arbitrary text.
+ # Returns: List containing extracted IP addresses
+ # Usage: @ips = extractIP($string1, $string2);
+
+ my @strings = grep {defined} @_;
+ my ( $string, @ips, $ip, @tmp, @rv );
+
+ pdebug( "entering w/(@strings)", PDLEVEL1 );
+ pIn();
+
+ foreach $string (@strings) {
+
+ # Look for IPv4 addresses
+ @ips = ( $string =~ /(@{[ IP4REGEX ]})/smog );
+
+ # Validate them by filtering through inet_aton
+ foreach $ip (@ips) {
+ push @rv, $ip if defined inet_aton($ip);
+ }
+
+ # If we have Socket6 installed we'll look for IPv6 addresses
+ if ( loadModule('Socket6') ) {
+ @ips = ( $string =~ m/(@{[ IP6REGEX ]})/smogix );
+
+ # Filter out addresses with more than one ::
+ @ips = grep { scalar(m/(::)/smg) <= 1 } @ips;
+
+ # Validate remaining addresses with inet_pton
+ foreach $ip (@ips) {
+ push @rv, $ip
+ if
+ defined &Socket6::inet_pton( &Socket6::AF_INET6(), $ip );
+ }
+ }
+ }
+
+ # Filter out IPv4 encoded as IPv6
+ @rv = grep !/^::ffff:@{[ IP4REGEX ]}$/smo, @rv;
+
+ pOut();
+ pdebug( "leaving w/rv: @rv)", PDLEVEL1 );
+
+ return @rv;
+}
+
1;
__END__
@@ -156,7 +336,7 @@
=head1 VERSION
-$Id: Network.pm,v 0.61 2009/03/05 00:07:00 acorliss Exp $
+$Id: Network.pm,v 0.64 2011/04/15 22:05:13 acorliss Exp $
=head1 SYNOPSIS
@@ -168,6 +348,8 @@
=head1 DESCRIPTION
This modules contains functions that may be useful for network operations.
+This module requires an optional module (B<Socket6>) if you want IPv6 support
+in B<ipInNetwork>.
=head1 SUBROUTINES/METHODS
@@ -184,6 +366,38 @@
192.168.0.0/24
172.16.12.0/255.255.240.0);
+IPv6 is support if the B<Socket6> module is installed. This routine will
+select the appropriate address family based on the IP you're testing and
+filter out the opposing address family in the list.
+
+B<NOTE:> IPv4 addresses encoded as IPv6 addresses, e.g.:
+
+ ::ffff:192.168.0.5
+
+are supported, however an IP address submitted in this format as the IP to
+test for will be converted to a pure IPv4 address and compared only against
+the IPv4 networks. This is meant as a convenience to the developer supporting
+dual-stack systems to avoid having to list IPv4 networks in the array twice
+like so:
+
+ ::ffff:192.168.0.0/120, 192.168.0.0/24
+
+Just list IPv4 as IPv4, IPv6 as IPv6, and this routine will convert
+IPv6-encoded IPv4 addresses automatically. This would make the following test
+return a true value:
+
+ ipInNetwork( '::ffff:192.168.0.5', '192.168.0.0/24' );
+
+but
+
+ ipInNetwork( '::ffff:192.168.0.5', '::ffff:192.168.0.0/120' );
+
+return a false value. This may seem counter intuitive, but it simplifies
+things in (my alternate) reality.
+
+Please note that this automatic conversion only applies to the B<IP> argument,
+not to any member of the network array.
+
=head2 hostInDomain
$rv = hostInDomain($host, @domains);
@@ -193,6 +407,27 @@
domains should have the preceding '.' (i.e., 'foo.com' rather than
'.foo.com').
+=head2 extractIPs
+
+ @ips = extractIP($string1, $string2);
+
+This function extracts IP addresses from arbitrary text. If you have
+B<Socket6> installed it will extract IPv6 addresses as well as IPv4 addresses.
+This extracts only IP addresses, not network addresses in CIDR or dotted octet
+notation. In the case of the latter the netmask will be extracted as an
+additional address.
+
+B<NOTE:> in the interest of performance this function does only rough regex
+extraction of IP-looking candidates, then runs them through B<inet_aton> (for
+IPv4) and B<inet_pton> (for IPv6) to see if they successfully convert. Even
+with the overhead of B<Paranoid> (with debugging and I<loadModule> calls for
+Socket6 and what-not) it seems that this is an order of a magnitude faster
+than doing a pure regex extraction & validation of IPv6 addresses.
+
+B<NOTE:> Like the B<ipInNetwork> function we filter out IPv4 addresses encoded
+as IPv6 addresses since that address is already returned as a pure IPv4
+address.
+
=head1 DEPENDENCIES
=over
Modified: branches/upstream/libparanoid-perl/current/t/13_network.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparanoid-perl/current/t/13_network.t?rev=73425&op=diff
==============================================================================
--- branches/upstream/libparanoid-perl/current/t/13_network.t (original)
+++ branches/upstream/libparanoid-perl/current/t/13_network.t Sun Apr 24 17:21:03 2011
@@ -1,15 +1,46 @@
#!/usr/bin/perl -T
# 13_network.t
-use Test::More tests => 11;
+use Test::More tests => 26;
use Paranoid;
use Paranoid::Network;
+use Paranoid::Module;
+use Paranoid::Debug;
use Socket;
+
+#PDEBUG = 20;
use strict;
use warnings;
psecureEnv();
+
+my $ifconfig = << '__EOF__';
+lo Link encap:Local Loopback
+ inet addr:127.0.0.1 Mask:255.0.0.0
+ inet6 addr: ::1/128 Scope:Host
+ UP LOOPBACK RUNNING MTU:16436 Metric:1
+ RX packets:199412 errors:0 dropped:0 overruns:0 frame:0
+ TX packets:199412 errors:0 dropped:0 overruns:0 carrier:0
+ collisions:0 txqueuelen:0
+ RX bytes:90311250 (86.1 MiB) TX bytes:90311250 (86.1 MiB)
+
+__EOF__
+
+my $iproute = << '__EOF__';
+1: lo: <LOOPBACK,UP,LOWER_UP> mtu 16436 qdisc noqueue state UNKNOWN
+ link/loopback 00:00:00:00:00:00 brd 00:00:00:00:00:00
+ inet 127.0.0.1/8 brd 127.255.255.255 scope host lo
+ inet6 ::1/128 scope host
+ valid_lft forever preferred_lft forever
+2: eth0: <BROADCAST,MULTICAST> mtu 1500 qdisc pfifo_fast state DOWN qlen 1000
+ link/ether 00:d0:f9:6a:cd:d0 brd ff:ff:ff:ff:ff:ff
+3: wlan0: <BROADCAST,MULTICAST,UP,LOWER_UP> mtu 1500 qdisc pfifo_fast state UP qlen 1000
+ link/ether 00:12:a8:ff:0e:a1 brd ff:ff:ff:ff:ff:ff
+ inet 192.168.2.156/24 brd 192.168.2.255 scope global wlan0
+ inet6 fe80::212:a8ff:feff:0ea1/64 scope link
+ valid_lft forever preferred_lft forever
+__EOF__
ok( ipInNetwork( '127.0.0.1', '127.0.0.0/8' ), 'ipInNetwork 1' );
ok( ipInNetwork( '127.0.0.1', '127.0.0.0/255.0.0.0' ), 'ipInNetwork 2' );
@@ -25,8 +56,43 @@
ok( !hostInDomain( 'localhost', 'local?#$host' ), 'hostInDomain 4' );
ok( hostInDomain(
'foo-77.bar99.net', 'dist-22.mgmt.bar-bar.com', 'bar99.net'
- ),
+ ),
'hostInDomain 5'
- );
+ );
+ok( scalar( grep !/:/, extractIPs($ifconfig) == 3 ), 'extractIPs 1' );
+ok( scalar( grep !/:/, extractIPs($iproute) == 6 ), 'extractIPs 2' );
+ok( scalar( grep !/:/, extractIPs( $ifconfig, $iproute ) == 9 ),
+ 'extractIPs 3' );
+
+SKIP: {
+ skip( 'Missing Socket6 module -- skipping IPv6 tests', 12 )
+ unless loadModule('Socket6');
+
+ ok( ipInNetwork( '::1', '::1' ), 'ipInNetwork 7' );
+ ok( !ipInNetwork( '::1', '127.0.0.1/8' ), 'ipInNetwork 8' );
+ ok( ipInNetwork( '::ffff:192.168.0.5', '192.168.0.0/24' ),
+ 'ipInNetwork 9' );
+ ok( !ipInNetwork( '::ffff:192.168.0.5', '::ffff:192.168.0.0/104' ),
+ 'ipInNetwork 9' );
+ ok( ipInNetwork( 'fe80::212:e9dd:fed9:a1f9', 'fe80::/64' ),
+ 'ipInNetwork 10' );
+ ok( !ipInNetwork( 'fe80::212:e9dd:fed9:a1f9', 'fe81::/64' ),
+ 'ipInNetwork 11' );
+ ok( ipInNetwork( 'fe80::212:e9dd:fed9:a1f9', 'fe80::/60' ),
+ 'ipInNetwork 12' );
+ ok( ipInNetwork( 'fe80::ffff:212:e9dd:fed9:a1f9', 'fe80:0:0:ffff::/60' ),
+ 'ipInNetwork 13'
+ );
+ ok( ipInNetwork(
+ '::1', 'fe80:0:0:ffff::/60',
+ '::ffff:192.168.0.0/104', '192.168.0.0/24',
+ '::1'
+ ),
+ 'ipInNetwork 14'
+ );
+ ok( scalar extractIPs($ifconfig) == 3, 'extractIPs 4' );
+ ok( scalar extractIPs($iproute) == 6, 'extractIPs 5' );
+ ok( scalar extractIPs( $ifconfig, $iproute ) == 9, 'extractIPs 6' );
+}
# end 13_network.t
More information about the Pkg-perl-cvs-commits
mailing list