package NetAddr::IP::Util;
use strict;
use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS $Mode);
use AutoLoader qw(AUTOLOAD);
use NetAddr::IP::Util_IS;
use NetAddr::IP::InetBase qw(
:upper
:all
);
*NetAddr::IP::Util::upper = \&NetAddr::IP::InetBase::upper;
*NetAddr::IP::Util::lower = \&NetAddr::IP::InetBase::lower;
require DynaLoader;
require Exporter;
@ISA = qw(Exporter DynaLoader);
$VERSION = do { my @r = (q$Revision: 1.53 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
@EXPORT_OK = qw(
inet_aton
inet_ntoa
ipv6_aton
ipv6_ntoa
ipv6_n2x
ipv6_n2d
inet_any2n
hasbits
isIPv4
isNewIPv4
isAnyIPv4
inet_n2dx
inet_n2ad
inet_pton
inet_ntop
inet_4map6
shiftleft
addconst
add128
sub128
notcontiguous
bin2bcd
bcd2bin
mode
ipv4to6
mask4to6
ipanyto6
maskanyto6
ipv6to4
bin2bcdn
bcdn2txt
bcdn2bin
simple_pack
comp128
packzeros
AF_INET
AF_INET6
naip_gethostbyname
havegethostbyname2
);
%EXPORT_TAGS = (
all => [@EXPORT_OK],
inet => [qw(
inet_aton
inet_ntoa
ipv6_aton
ipv6_ntoa
ipv6_n2x
ipv6_n2d
inet_any2n
inet_n2dx
inet_n2ad
inet_pton
inet_ntop
inet_4map6
ipv4to6
mask4to6
ipanyto6
maskanyto6
ipv6to4
packzeros
naip_gethostbyname
)],
math => [qw(
shiftleft
hasbits
isIPv4
isNewIPv4
isAnyIPv4
addconst
add128
sub128
notcontiguous
bin2bcd
bcd2bin
)],
ipv4 => [qw(
inet_aton
inet_ntoa
)],
ipv6 => [qw(
ipv6_aton
ipv6_ntoa
ipv6_n2x
ipv6_n2d
inet_any2n
inet_n2dx
inet_n2ad
inet_pton
inet_ntop
inet_4map6
ipv4to6
mask4to6
ipanyto6
maskanyto6
ipv6to4
packzeros
naip_gethostbyname
)],
);
if (NetAddr::IP::Util_IS->not_pure) {
eval {
bootstrap NetAddr::IP::Util $VERSION;
};
}
if (NetAddr::IP::Util_IS->pure || $@) {
require NetAddr::IP::UtilPP;
import NetAddr::IP::UtilPP qw( :all );
$Mode = 'Pure Perl';
}
else {
$Mode = 'CC XS';
}
sub mode() { $Mode };
my $_newV4compat = pack('N4',0,0,0xffff,0);
sub inet_4map6 {
my $naddr = shift;
if (length($naddr) == 4) {
$naddr = ipv4to6($naddr);
}
elsif (length($naddr) == 16) {
;
return undef unless isAnyIPv4($naddr);
} else {
return undef;
}
$naddr |= $_newV4compat;
return $naddr;
}
sub DESTROY {};
my $havegethostbyname2 = 0;
my $mygethostbyname;
my $_Sock6ok = 1;
sub havegethostbyname2 {
return $_Sock6ok
? $havegethostbyname2
: 0;
}
sub import {
if (grep { $_ eq ':noSock6' } @_) {
$_Sock6ok = 0;
@_ = grep { $_ ne ':noSock6' } @_;
}
NetAddr::IP::Util->export_to_level(1,@_);
}
package NetAddr::IP::UtilPolluted;
use strict;
use Socket;
my $_v4zero = pack('L',0);
my $_zero = pack('L4',0,0,0,0);
sub _end_gethostbyname {
my @rv = @_;
my $tip = $rv[4];
unless ($tip && $tip ne $_v4zero && $tip ne $_zero) {
@rv = ();
}
elsif ($rv[3] && $rv[3] == 4) {
foreach (4..$#rv) {
$rv[$_] = NetAddr::IP::Util::inet_4map6(NetAddr::IP::Util::ipv4to6($rv[$_]));
}
$rv[3] = 16;
}
elsif ($rv[3] == 16) {
;
} else {
@rv = ();
}
return @rv;
}
unless ( eval { require Socket6 }) {
$mygethostbyname = sub {
my @tip = gethostbyname(NetAddr::IP::InetBase::fillIPv4($_[0]));
return &_end_gethostbyname(@tip);
};
} else {
import Socket6 qw( gethostbyname2 getipnodebyname );
my $try = eval { my @try = gethostbyname2('127.0.0.1',NetAddr::IP::Util::AF_INET()); $try[4] };
if (! $@ && $try && $try eq INADDR_LOOPBACK()) {
*_ghbn2 = \&Socket6::gethostbyname2;
$havegethostbyname2 = 1;
} else {
*_ghbn2 = sub { return () };
}
$mygethostbyname = sub {
my @tip;
unless ($_Sock6ok && (@tip = _ghbn2($_[0],NetAddr::IP::Util::AF_INET6())) && @tip > 1) {
@tip = gethostbyname(NetAddr::IP::InetBase::fillIPv4($_[0]));
}
return &_end_gethostbyname(@tip);
};
}
package NetAddr::IP::Util;
sub naip_gethostbyname {
undef local $^W;
my @rv = &$mygethostbyname($_[0]);
return wantarray
? @rv
: $rv[4];
}
1;
__END__
1;
|