diff --git a/IP.pm b/IP.pm index eab2564..6b291ab 100644 --- a/IP.pm +++ b/IP.pm @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -# $Id: IP.pm,v 1.5 2002/10/31 21:32:20 lem Exp $ +# $Id: IP.pm,v 1.6 2002/12/10 17:14:02 lem Exp $ package NetAddr::IP; @@ -8,7 +8,7 @@ =head1 NAME -NetAddr::IP - Manages IPv4 addresses and subnets +NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets =head1 SYNOPSIS @@ -45,7 +45,7 @@ use strict; use warnings; -our $VERSION = '3.14'; +our $VERSION = '3.14_1'; ############################################# # These are the overload methods, placed here @@ -317,6 +317,19 @@ vec($vec, 3, 8); } +sub _to_ipv6 ($) { + my $vec = shift; + my $r = ''; + + foreach (0..3) { + $r .= ':' . sprintf("%02x%02x:%02x%02x", + vec($vec, 4*$_, 8), vec($vec, 4*$_ + 1, 8), + vec($vec, 4*$_ + 2, 8), vec($vec, 4*$_ + 3, 8)); + } + $r =~ s/^://; + return $r; +} + sub do_prefix ($$$) { my $mask = shift; my $faddr = shift; @@ -351,7 +364,32 @@ my $bmask = ''; - if ($mask eq 'default' or $mask eq 'any') { + if ($bits == 128) { + if (grep($mask eq $_ , qw(unspecified loopback))) { + for (0..3) { + vec($bmask, $_, 32) = 0xFFFFFFFF; + } + } + elsif ($mask =~ /^(\d+)$/ && $1 <= 128) { + foreach (0..3) { + if ($mask >= 32*($_ + 1)) { + vec($bmask, $_, 32) = 0xFFFFFFFF; + } + elsif ($mask > 32*$_) { + vec($bmask, $_, 32) = 0xFFFFFFFF; + vec($bmask, $_, 32) <<= (32*($_ + 1) - $mask); + } + else { + vec($bmask, $_, 32) = 0x0; + } + } + } + else { + $bmask = undef; + } + return $bmask; + } + elsif ($mask eq 'default' or $mask eq 'any') { vec($bmask, 0, $bits) = 0x0; } elsif ($mask eq 'broadcast' or $mask eq 'host') { @@ -591,6 +629,69 @@ return { addr => $addr, mask => $mask, bits => 32 }; } +sub expand_v6 ($) { + my $pat = shift; + + if (length($pat) < 4) { + $pat = ('0' x (4 - length($pat))) . $pat; + } + return $pat; +} + +sub _v6_part ($$$) { + my $addr = shift; + my $four = shift; + my $n = shift; + + my($a, $b); + + return undef unless length($four) == 4; + $four =~ /^(.{2})(.{2})/; + ($a, $b) = ($1, $2); + + vec($addr, 2*$n, 8) = hex($a); + vec($addr, 2*$n + 1, 8) = hex($b); + + return $addr; +} + +sub _v6 ($$$) { + my $ip = lc shift; + my $mask = shift; + my $present = shift; + + my $addr = ''; + my $colons; + my $expanded; + my @ip; + + if ($ip eq 'unspecified') { + $ip = '::'; + } + elsif ($ip eq 'loopback') { + $ip = '::1'; + } + elsif ($ip =~ /:::/ || $ip =~ /::.*::/) { + return undef; + } + return undef unless $ip =~ /^[\da-f\:]+$/i; + + $colons = ($ip =~ tr/:/:/); + return undef unless $colons >= 2 && $colons <= 7; + $expanded = ':0' x (9 - $colons); + $ip =~ s/::/$expanded/; + $ip = '0' . $ip if $ip =~ /^:/; + # .:.:.:.:.:.:.:. + @ip = split(/:/, $ip); + grep($_ = expand_v6($_), @ip);; + for (0..$#ip) { + $addr = _v6_part($addr, $ip[$_], $_); + return undef unless defined $addr; + } + + return { addr => $addr, mask => $mask, bits => 128 }; +} + sub new4 ($$;$) { new($_[0], $_[1], $_[2]); } @@ -603,7 +704,7 @@ =over -=item C<-Enew([$addr, [ $mask ]])> +=item C<-Enew([$addr, [ $mask|IPv6 ]])> This method creates a new IPv4 address with the supplied address in C<$addr> and an optional netmask C<$mask>, which can be omitted to get @@ -622,6 +723,9 @@ If called with no arguments, 'default' is assumed. +IPv6 addresses according to RFC 1884 are also supported, except IPv4 +compatible IPv6 addresses. + =cut sub new ($$;$) { @@ -629,9 +733,11 @@ my $class = ref($type) || $type || "NetAddr::IP"; my $ip = lc $_[1]; my $hasmask = 1; + my $bits; my $mask; $ip = 'default' unless defined $ip; + $bits = $ip =~ /:/ ? 128 : 32; if (@_ == 2) { if ($ip =~ m!^(.+)/(.+)$!) { @@ -645,20 +751,32 @@ } if (defined $_[2]) { - $mask = _parse_mask $_[2], 32; + if ($_[2] =~ /^ipv6$/i) { + if (grep { $ip eq $_ } (qw(unspecified loopback))) { + $bits = 128; + $mask = _parse_mask $ip, $bits; + } + else { + return undef; + } + } + else { + $mask = _parse_mask $_[2], $bits; + } return undef unless defined $mask; } elsif (defined $mask) { - $mask = _parse_mask $mask, 32; + $mask = _parse_mask $mask, $bits; return undef unless defined $mask; } else { $hasmask = 0; - $mask = _parse_mask 32, 32; + $mask = _parse_mask $bits, $bits; return undef unless defined $mask; } - my $self = _v4($ip, $mask, $hasmask); + my $self = $bits == 32 ? _v4($ip, $mask, $hasmask) + : _v6($ip, $mask, $hasmask); return undef unless $self; @@ -729,7 +847,26 @@ sub addr ($) { my $self = shift; - _to_quad $self->{addr}; + $self->{bits} == 32 ? _to_quad $self->{addr} + : _to_ipv6 $self->{addr}; +} + +sub _compact ($) { + my $addr = shift; + + $addr =~ s/(^|:)0{1,3}/${1}/g; + # Not optimized for the biggest :0 sequence to collapse + $addr =~ s/((^|:)0)+/:/; + # unspecified :-( + $addr .= ':' if $addr eq ':'; + + return $addr; +} + +sub compact_addr ($) { + my $self = shift; + $self->{bits} == 32 ? _to_quad $self->{addr} + : _compact _to_ipv6 $self->{addr}; } =pod @@ -742,7 +879,8 @@ sub mask ($) { my $self = shift; - _to_quad $self->{mask}; + $self->{bits} == 32 ? _to_quad $self->{mask} + : _to_ipv6 $self->{mask}; } =pod @@ -896,6 +1034,7 @@ sub wildcard ($) { my $self = shift; + return undef if $self->{bits} > 32; return wantarray() ? ($self->addr, _to_quad ~$self->{mask}) : _to_quad ~$self->{mask}; @@ -1223,7 +1362,7 @@ =head1 HISTORY -$Id: IP.pm,v 1.5 2002/10/31 21:32:20 lem Exp $ +$Id: IP.pm,v 1.6 2002/12/10 17:14:02 lem Exp $ =over @@ -1689,11 +1828,35 @@ =back +=item 3.14_1 + +This is an interim release just to incorporate the v6 patches +contributed. No extensive testing has been done with this support +yet. More tests are needed. + +=over + +=item * + +Preliminary support for IPv6 contributed by Kadlecsik Jozsi +Ekadlec at sunserv.kfki.huE. Thanks a lot! + +=item * + +IP.pm and other files are enconded in ISO-8859-1 (Latin1) so that I +can spell my name properly. + +=item * + +Tested under Perl 5.8.0, no surprises found. + +=back + =back =head1 AUTHOR -Luis E. Munoz +Luis E. Mu�oz =head1 WARRANTY @@ -1702,7 +1865,7 @@ =head1 LICENSE -This software is (c) Luis E. Munoz. It can be used under the terms of +This software is (c) Luis E. Mu�oz. It can be used under the terms of the perl artistic license provided that proper credit for the work of the author is preserved in the form of this copyright notice and license for this module. diff --git a/MANIFEST b/MANIFEST index 5234d43..efdefbe 100644 --- a/MANIFEST +++ b/MANIFEST @@ -18,6 +18,7 @@ t/masklen.t t/v4-base.t t/v4-cidr.t +t/v6-base.t t/over-arr.t t/v4-range.t t/v4-badnm.t diff --git a/Makefile.PL b/Makefile.PL index 1b47bff..529e3c6 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -2,7 +2,7 @@ # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. -# $Id: Makefile.PL,v 1.2 2002/10/31 04:30:22 lem Exp $ +# $Id: Makefile.PL,v 1.3 2002/12/10 17:14:02 lem Exp $ WriteMakefile( 'NAME' => 'NetAddr::IP', @@ -10,4 +10,7 @@ 'PREREQ_PM' => { Test::More => 0, }, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'IP.pm', + AUTHOR => 'Luis E. Mu�oz ') : ()), ); diff --git a/README b/README index 1681899..62df416 100644 --- a/README +++ b/README @@ -1,4 +1,7 @@ -NetAddr::IP - Manages IPv4 (your traditional IP) addresses and subnets +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +NetAddr::IP - Manages IP addresses and subnets * * * * THIS MODULE REQUIRES PERL 5.6.0 OR NEWER. * * * * @@ -45,6 +48,10 @@ ...which is quite useful for generating config files and the such. This works even for huge ranges of IP addresses. +As of version 3.14_1, it is able to handle some representations of v6 +subnets thanks to Kadlecsik Jozsi. Note that this support is still +preliminary and has not been widely tested. + This module is entirely written in Perl, so you do not need access to a compiler to use it. It has been extensively tested in a variety of platforms. An extensive test suite is provided with the module to @@ -109,9 +116,41 @@ Report your bugs to me (luismunoz@cpan.org). -This software is (c) Luis E. Munoz. It can be used under the terms of +SECURITY CONSIDERATIONS + +I have no control on the machanisms involved in the storage or +transport of this distribution. This means that I cannot guarantee +that the distribution you have in your hands is indeed, the same +distribution I packed and uploaded. + +Starting with v3.14_1, along the distribution file, you should have a +file with the extension ".asc". This contains a GPG "detached +signature" that makes it impossible for anybody to alter this +distribution. If security is of any concern to you, by all means +verify the signature of this file and contact the author if any +discrepancy is detected. + +You can find more information about this at the following URL + + http://mipagina.cantv.net/lem/gpg/ + +This information includes the correct keys, fingerprints, etc.Note +that this README file should also be signed. + +LICENSE AND WARRANTY + +This software is (c) Luis E. Mu�oz. It can be used under the terms of the perl artistic license provided that proper credit for the work of the author is preserved in the form of this copyright notice and license for this module. -$Id: README,v 1.2 2002/10/31 04:30:22 lem Exp $ +No warranty of any kind is expressed or implied. This code might make +your computer go up in a puff of black smoke. +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.0.6 (Darwin) +Comment: For info see http://www.gnupg.org + +iD8DBQE99iAmQyDWGRI/hhARAsPlAJ9VFVFGSUHjxDUvXm2x9x20YfhuYQCeJu5A +F5c3pam/zZQiVf7ZaUVs3fc= +=VNNB +-----END PGP SIGNATURE----- diff --git a/TODO b/TODO index 7e25b7e..ca7bf32 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,8 @@ -$Id: TODO,v 1.2 2002/10/31 21:32:21 lem Exp $ +$Id: TODO,v 1.3 2002/12/10 17:14:02 lem Exp $ -o Definitely, support for IPv6 addresses. +o More tests for IPv6 functionality. This should be thoroughly tested. + +o Extend the formats accepted for v6 addresses. o Add support for other notations (when found). diff --git a/t/v6-base.t b/t/v6-base.t new file mode 100644 index 0000000..2a95bfe --- /dev/null +++ b/t/v6-base.t @@ -0,0 +1,28 @@ +# This -*- perl -*- code excercises the basic v6 functionality + +# $Id: v6-base.t,v 1.2 2002/12/10 16:55:52 lem Exp $ + +BEGIN { our @addr = qw(:: ::1 f34::123/40 ); }; + +use NetAddr::IP; +use Test::More tests => 2 * @addr + 4; + +my($a, $ip, $test); + +for $a (@addr) { + $ip = new NetAddr::IP $a; + $a =~ s,/\d+,,; + isa_ok($ip, 'NetAddr::IP'); + is($ip->compact_addr, $a); +} + +$test = new NetAddr::IP f34::1; +isa_ok($test, 'NetAddr::IP'); +ok($ip->network->contains($test), "->contains"); + +$test = new NetAddr::IP f35::1/40; +isa_ok($test, 'NetAddr::IP'); +ok(!$ip->network->contains($test), "!->contains"); + + +