Newer
Older
NetAddr-IP / Lite / Util / Util.pm
@Michael Robinton Michael Robinton on 21 Oct 2014 21 KB Import of MIKER/NetAddr-IP-4.069 from CPAN.
  1. #!/usr/bin/perl
  2. package NetAddr::IP::Util;
  3.  
  4. use strict;
  5. #use diagnostics;
  6. #use lib qw(blib/lib);
  7.  
  8. use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS $Mode);
  9. use AutoLoader qw(AUTOLOAD);
  10. use NetAddr::IP::Util_IS;
  11. use NetAddr::IP::InetBase qw(
  12. :upper
  13. :all
  14. );
  15.  
  16. *NetAddr::IP::Util::upper = \&NetAddr::IP::InetBase::upper;
  17. *NetAddr::IP::Util::lower = \&NetAddr::IP::InetBase::lower;
  18.  
  19. require DynaLoader;
  20. require Exporter;
  21.  
  22. @ISA = qw(Exporter DynaLoader);
  23.  
  24. $VERSION = do { my @r = (q$Revision: 1.50 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  25.  
  26. @EXPORT_OK = qw(
  27. inet_aton
  28. inet_ntoa
  29. ipv6_aton
  30. ipv6_ntoa
  31. ipv6_n2x
  32. ipv6_n2d
  33. inet_any2n
  34. hasbits
  35. isIPv4
  36. isNewIPv4
  37. isAnyIPv4
  38. inet_n2dx
  39. inet_n2ad
  40. inet_pton
  41. inet_ntop
  42. inet_4map6
  43. shiftleft
  44. addconst
  45. add128
  46. sub128
  47. notcontiguous
  48. bin2bcd
  49. bcd2bin
  50. mode
  51. ipv4to6
  52. mask4to6
  53. ipanyto6
  54. maskanyto6
  55. ipv6to4
  56. bin2bcdn
  57. bcdn2txt
  58. bcdn2bin
  59. simple_pack
  60. comp128
  61. packzeros
  62. AF_INET
  63. AF_INET6
  64. naip_gethostbyname
  65. havegethostbyname2
  66. );
  67.  
  68. %EXPORT_TAGS = (
  69. all => [@EXPORT_OK],
  70. inet => [qw(
  71. inet_aton
  72. inet_ntoa
  73. ipv6_aton
  74. ipv6_ntoa
  75. ipv6_n2x
  76. ipv6_n2d
  77. inet_any2n
  78. inet_n2dx
  79. inet_n2ad
  80. inet_pton
  81. inet_ntop
  82. inet_4map6
  83. ipv4to6
  84. mask4to6
  85. ipanyto6
  86. maskanyto6
  87. ipv6to4
  88. packzeros
  89. naip_gethostbyname
  90. )],
  91. math => [qw(
  92. shiftleft
  93. hasbits
  94. isIPv4
  95. isNewIPv4
  96. isAnyIPv4
  97. addconst
  98. add128
  99. sub128
  100. notcontiguous
  101. bin2bcd
  102. bcd2bin
  103. )],
  104. ipv4 => [qw(
  105. inet_aton
  106. inet_ntoa
  107. )],
  108. ipv6 => [qw(
  109. ipv6_aton
  110. ipv6_ntoa
  111. ipv6_n2x
  112. ipv6_n2d
  113. inet_any2n
  114. inet_n2dx
  115. inet_n2ad
  116. inet_pton
  117. inet_ntop
  118. inet_4map6
  119. ipv4to6
  120. mask4to6
  121. ipanyto6
  122. maskanyto6
  123. ipv6to4
  124. packzeros
  125. naip_gethostbyname
  126. )],
  127. );
  128.  
  129. if (NetAddr::IP::Util_IS->not_pure) {
  130. eval { ## attempt to load 'C' version of utilities
  131. bootstrap NetAddr::IP::Util $VERSION;
  132. };
  133. }
  134. if (NetAddr::IP::Util_IS->pure || $@) { ## load the pure perl version if 'C' lib missing
  135. require NetAddr::IP::UtilPP;
  136. import NetAddr::IP::UtilPP qw( :all );
  137. # require Socket;
  138. # import Socket qw(inet_ntoa);
  139. # *yinet_aton = \&Socket::inet_aton;
  140. $Mode = 'Pure Perl';
  141. }
  142. else {
  143. $Mode = 'CC XS';
  144. }
  145.  
  146. # if Socket lib is broken in some way, check for overange values
  147. #
  148. #my $overange = yinet_aton('256.1') ? 1:0;
  149. #my $overange = gethostbyname('256.1') ? 1:0;
  150.  
  151. sub mode() { $Mode };
  152.  
  153. my $_newV4compat = pack('N4',0,0,0xffff,0);
  154.  
  155. sub inet_4map6 {
  156. my $naddr = shift;
  157. if (length($naddr) == 4) {
  158. $naddr = ipv4to6($naddr);
  159. }
  160. elsif (length($naddr) == 16) {
  161. ; # is OK
  162. return undef unless isAnyIPv4($naddr);
  163. } else {
  164. return undef;
  165. }
  166. $naddr |= $_newV4compat;
  167. return $naddr;
  168. }
  169.  
  170. sub DESTROY {};
  171.  
  172. my $havegethostbyname2 = 0;
  173.  
  174. my $mygethostbyname;
  175.  
  176. my $_Sock6ok = 1; # for testing gethostbyname
  177.  
  178. sub havegethostbyname2 {
  179. return $_Sock6ok
  180. ? $havegethostbyname2
  181. : 0;
  182. }
  183.  
  184. sub import {
  185. if (grep { $_ eq ':noSock6' } @_) {
  186. $_Sock6ok = 0;
  187. @_ = grep { $_ ne ':noSock6' } @_;
  188. }
  189. NetAddr::IP::Util->export_to_level(1,@_);
  190. }
  191.  
  192. package NetAddr::IP::UtilPolluted;
  193.  
  194. # Socket pollutes the name space with all of its symbols. Since
  195. # we don't want them all, confine them to this name space.
  196.  
  197. use strict;
  198. use Socket;
  199.  
  200. my $_v4zero = pack('L',0);
  201. my $_zero = pack('L4',0,0,0,0);
  202.  
  203. # invoke replacement subroutine for Perl's "gethostbyname"
  204. # if Socket6 is available.
  205. #
  206. # NOTE: in certain BSD implementations, Perl's gethostbyname is broken
  207. # we will use our own InetBase::inet_aton instead
  208.  
  209. sub _end_gethostbyname {
  210. # my ($name,$aliases,$addrtype,$length,@addrs) = @_;
  211. my @rv = @_;
  212. # first ip address = rv[4]
  213. my $tip = $rv[4];
  214. unless ($tip && $tip ne $_v4zero && $tip ne $_zero) {
  215. @rv = ();
  216. }
  217. # length = rv[3]
  218. elsif ($rv[3] && $rv[3] == 4) {
  219. foreach (4..$#rv) {
  220. $rv[$_] = NetAddr::IP::Util::inet_4map6(NetAddr::IP::Util::ipv4to6($rv[$_]));
  221. }
  222. $rv[3] = 16; # unconditionally set length to 16
  223. }
  224. elsif ($rv[3] == 16) {
  225. ; # is ok
  226. } else {
  227. @rv = ();
  228. }
  229. return @rv;
  230. }
  231.  
  232. unless ( eval { require Socket6 }) {
  233. $mygethostbyname = sub {
  234. # SEE NOTE above about broken BSD
  235. my @tip = gethostbyname(NetAddr::IP::InetBase::fillIPv4($_[0]));
  236. return &_end_gethostbyname(@tip);
  237. };
  238. } else {
  239. import Socket6 qw( gethostbyname2 getipnodebyname );
  240. my $try = eval { my @try = gethostbyname2('127.0.0.1',NetAddr::IP::Util::AF_INET()); $try[4] };
  241. if (! $@ && $try && $try eq INADDR_LOOPBACK()) {
  242. *_ghbn2 = \&Socket6::gethostbyname2;
  243. $havegethostbyname2 = 1;
  244. } else {
  245. *_ghbn2 = sub { return () }; # use failure branch below
  246. }
  247.  
  248. $mygethostbyname = sub {
  249. my @tip;
  250. unless ($_Sock6ok && (@tip = _ghbn2($_[0],NetAddr::IP::Util::AF_INET6())) && @tip > 1) {
  251. # SEE NOTE above about broken BSD
  252. @tip = gethostbyname(NetAddr::IP::InetBase::fillIPv4($_[0]));
  253. }
  254. return &_end_gethostbyname(@tip);
  255. };
  256. }
  257.  
  258. package NetAddr::IP::Util;
  259.  
  260. sub naip_gethostbyname {
  261. # turn off complaint from Socket6 about missing numeric argument
  262. undef local $^W;
  263. my @rv = &$mygethostbyname($_[0]);
  264. return wantarray
  265. ? @rv
  266. : $rv[4];
  267. }
  268.  
  269. 1;
  270.  
  271. __END__
  272.  
  273. =head1 NAME
  274.  
  275. NetAddr::IP::Util -- IPv4/6 and 128 bit number utilities
  276.  
  277. =head1 SYNOPSIS
  278.  
  279. use NetAddr::IP::Util qw(
  280. inet_aton
  281. inet_ntoa
  282. ipv6_aton
  283. ipv6_ntoa
  284. ipv6_n2x
  285. ipv6_n2d
  286. inet_any2n
  287. hasbits
  288. isIPv4
  289. isNewIPv4
  290. isAnyIPv4
  291. inet_n2dx
  292. inet_n2ad
  293. inet_pton
  294. inet_ntop
  295. inet_4map6
  296. ipv4to6
  297. mask4to6
  298. ipanyto6
  299. maskanyto6
  300. ipv6to4
  301. packzeros
  302. shiftleft
  303. addconst
  304. add128
  305. sub128
  306. notcontiguous
  307. bin2bcd
  308. bcd2bin
  309. mode
  310. AF_INET
  311. AF_INET6
  312. naip_gethostbyname
  313. );
  314.  
  315. use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math)
  316.  
  317. :inet => inet_aton, inet_ntoa, ipv6_aton
  318. ipv6_ntoa, ipv6_n2x, ipv6_n2d,
  319. inet_any2n, inet_n2dx, inet_n2ad,
  320. inet_pton, inet_ntop, inet_4map6,
  321. ipv4to6, mask4to6, ipanyto6, packzeros
  322. maskanyto6, ipv6to4, naip_gethostbyname
  323.  
  324. :ipv4 => inet_aton, inet_ntoa
  325.  
  326. :ipv6 => ipv6_aton, ipv6_ntoa, ipv6_n2x,
  327. ipv6_n2d, inet_any2n, inet_n2dx,
  328. inet_n2ad, inet_pton, inet_ntop,
  329. inet_4map6, ipv4to6, mask4to6,
  330. ipanyto6, maskanyto6, ipv6to4,
  331. packzeros, naip_gethostbyname
  332.  
  333. :math => hasbits, isIPv4, isNewIPv4, isAnyIPv4,
  334. addconst, add128, sub128, notcontiguous,
  335. bin2bcd, bcd2bin, shiftleft
  336.  
  337. $dotquad = inet_ntoa($netaddr);
  338. $netaddr = inet_aton($dotquad);
  339. $ipv6naddr = ipv6_aton($ipv6_text);
  340. $ipv6_text = ipvt_ntoa($ipv6naddr);
  341. $hex_text = ipv6_n2x($ipv6naddr);
  342. $dec_text = ipv6_n2d($ipv6naddr);
  343. $hex_text = packzeros($hex_text);
  344. $ipv6naddr = inet_any2n($dotquad or $ipv6_text);
  345. $ipv6naddr = inet_4map6($netaddr or $ipv6naddr);
  346. $rv = hasbits($bits128);
  347. $rv = isIPv4($bits128);
  348. $rv = isNewIPv4($bits128);
  349. $rv = isAnyIPv4($bits128);
  350. $dotquad or $hex_text = inet_n2dx($ipv6naddr);
  351. $dotquad or $dec_text = inet_n2ad($ipv6naddr);
  352. $netaddr = inet_pton($AF_family,$hex_text);
  353. $hex_text = inet_ntop($AF_family,$netaddr);
  354. $ipv6naddr = ipv4to6($netaddr);
  355. $ipv6naddr = mask4to6($netaddr);
  356. $ipv6naddr = ipanyto6($netaddr);
  357. $ipv6naddr = maskanyto6($netaddr);
  358. $netaddr = ipv6to4($pv6naddr);
  359. $bitsX2 = shiftleft($bits128,$n);
  360. $carry = addconst($ipv6naddr,$signed_32con);
  361. ($carry,$ipv6naddr)=addconst($ipv6naddr,$signed_32con);
  362. $carry = add128($ipv6naddr1,$ipv6naddr2);
  363. ($carry,$ipv6naddr)=add128($ipv6naddr1,$ipv6naddr2);
  364. $carry = sub128($ipv6naddr1,$ipv6naddr2);
  365. ($carry,$ipv6naddr)=sub128($ipv6naddr1,$ipv6naddr2);
  366. ($spurious,$cidr) = notcontiguous($mask128);
  367. $bcdtext = bin2bcd($bits128);
  368. $bits128 = bcd2bin($bcdtxt);
  369. $modetext = mode;
  370. ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME);
  371. $trueif = havegethostbyname2();
  372.  
  373. NetAddr::IP::Util::lower();
  374. NetAddr::IP::Util::upper();
  375.  
  376. =head1 INSTALLATION
  377.  
  378. Un-tar the distribution in an appropriate directory and type:
  379.  
  380. perl Makefile.PL
  381. make
  382. make test
  383. make install
  384.  
  385. B<NetAddr::IP::Util> installs by default with its primary functions compiled
  386. using Perl's XS extensions to build a 'C' library. If you do not have a 'C'
  387. complier available or would like the slower Pure Perl version for some other
  388. reason, then type:
  389.  
  390. perl Makefile.PL -noxs
  391. make
  392. make test
  393. make install
  394.  
  395. =head1 DESCRIPTION
  396.  
  397. B<NetAddr::IP::Util> provides a suite of tools for manipulating and
  398. converting IPv4 and IPv6 addresses into 128 bit string context and back to
  399. text. The strings can be manipulated with Perl's logical operators:
  400.  
  401. and &
  402. or |
  403. xor ^
  404. ~ compliment
  405.  
  406. in the same manner as 'vec' strings.
  407.  
  408. The IPv6 functions support all rfc1884 formats.
  409.  
  410. i.e. x:x:x:x:x:x:x:x:x
  411. x:x:x:x:x:x:x:d.d.d.d
  412. ::x:x:x
  413. ::x:d.d.d.d
  414. and so on...
  415.  
  416. =over 4
  417.  
  418. =item * $dotquad = inet_ntoa($netaddr);
  419.  
  420. Convert a packed IPv4 network address to a dot-quad IP address.
  421.  
  422. input: packed network address
  423. returns: IP address i.e. 10.4.12.123
  424.  
  425. =item * $netaddr = inet_aton($dotquad);
  426.  
  427. Convert a dot-quad IP address into an IPv4 packed network address.
  428.  
  429. input: IP address i.e. 192.5.16.32
  430. returns: packed network address
  431.  
  432. =item * $ipv6addr = ipv6_aton($ipv6_text);
  433.  
  434. Takes an IPv6 address of the form described in rfc1884
  435. and returns a 128 bit binary RDATA string.
  436.  
  437. input: ipv6 text
  438. returns: 128 bit RDATA string
  439.  
  440. =item * $ipv6_text = ipv6_ntoa($ipv6naddr);
  441.  
  442. Convert a 128 bit binary IPv6 address to compressed rfc 1884
  443. text representation.
  444.  
  445. input: 128 bit RDATA string
  446. returns: ipv6 text
  447.  
  448. =item * $hex_text = ipv6_n2x($ipv6addr);
  449.  
  450. Takes an IPv6 RDATA string and returns an 8 segment IPv6 hex address
  451.  
  452. input: 128 bit RDATA string
  453. returns: x:x:x:x:x:x:x:x
  454.  
  455. =item * $dec_text = ipv6_n2d($ipv6addr);
  456.  
  457. Takes an IPv6 RDATA string and returns a mixed hex - decimal IPv6 address
  458. with the 6 uppermost chunks in hex and the lower 32 bits in dot-quad
  459. representation.
  460.  
  461. input: 128 bit RDATA string
  462. returns: x:x:x:x:x:x:d.d.d.d
  463.  
  464. =item * $ipv6naddr = inet_any2n($dotquad or $ipv6_text);
  465.  
  466. This function converts a text IPv4 or IPv6 address in text format in any
  467. standard notation into a 128 bit IPv6 string address. It prefixes any
  468. dot-quad address (if found) with '::' and passes it to B<ipv6_aton>.
  469.  
  470. input: dot-quad or rfc1844 address
  471. returns: 128 bit IPv6 string
  472.  
  473. =item * $rv = hasbits($bits128);
  474.  
  475. This function returns true if there are one's present in the 128 bit string
  476. and false if all the bits are zero.
  477.  
  478. i.e. if (hasbits($bits128)) {
  479. &do_something;
  480. }
  481.  
  482. or if (hasbits($bits128 & $mask128) {
  483. &do_something;
  484. }
  485.  
  486. This allows the implementation of logical functions of the form of:
  487.  
  488. if ($bits128 & $mask128) {
  489. ...
  490.  
  491. input: 128 bit IPv6 string
  492. returns: true if any bits are present
  493.  
  494. =item * $ipv6naddr = inet_4map6($netaddr or $ipv6naddr
  495.  
  496. This function returns an ipV6 network address with the first 80 bits
  497. set to zero and the next 16 bits set to one, while the last 32 bits
  498. are filled with the ipV4 address.
  499.  
  500. input: ipV4 netaddr
  501. or ipV6 netaddr
  502. returns: ipV6 netaddr
  503.  
  504. returns: undef on error
  505.  
  506. An ipV6 network address must be in one of the two compatible ipV4
  507. mapped address spaces. i.e.
  508.  
  509. ::ffff::d.d.d.d or ::d.d.d.d
  510.  
  511. =item * $rv = isIPv4($bits128);
  512.  
  513. This function returns true if there are no on bits present in the IPv6
  514. portion of the 128 bit string and false otherwise.
  515.  
  516. i.e. the address must be of the form - ::d.d.d.d
  517.  
  518. Note: this is an old and deprecated ipV4 compatible ipV6 address
  519. =item * $rv = isNewIPv4($bits128);
  520.  
  521. This function return true if the IPv6 128 bit string is of the form
  522.  
  523. ::ffff::d.d.d.d
  524.  
  525. =item * $rv = isAnyIPv4($bits128);
  526.  
  527. This function return true if the IPv6 bit string is of the form
  528.  
  529. ::d.d.d.d or ::ffff::d.d.d.d
  530.  
  531. =item * $dotquad or $hex_text = inet_n2dx($ipv6naddr);
  532.  
  533. This function B<does the right thing> and returns the text for either a
  534. dot-quad IPv4 or a hex notation IPv6 address.
  535.  
  536. input: 128 bit IPv6 string
  537. returns: ddd.ddd.ddd.ddd
  538. or x:x:x:x:x:x:x:x
  539.  
  540. =item * $dotquad or $dec_text = inet_n2ad($ipv6naddr);
  541.  
  542. This function B<does the right thing> and returns the text for either a
  543. dot-quad IPv4 or a hex::decimal notation IPv6 address.
  544.  
  545. input: 128 bit IPv6 string
  546. returns: ddd.ddd.ddd.ddd
  547. or x:x:x:x:x:x:ddd.ddd.ddd.dd
  548.  
  549. =item * $netaddr = inet_pton($AF_family,$hex_text);
  550.  
  551. This function takes an IP address in IPv4 or IPv6 text format and converts it into
  552. binary format. The type of IP address conversion is controlled by the FAMILY
  553. argument.
  554.  
  555. =item * $hex_text = inet_ntop($AF_family,$netaddr);
  556.  
  557. This function takes and IP address in binary format and converts it into
  558. text format. The type of IP address conversion is controlled by the FAMILY
  559. argument.
  560.  
  561. NOTE: inet_ntop ALWAYS returns lowercase characters.
  562.  
  563. =item * $hex_text = packzeros($hex_text);
  564.  
  565. This function optimizes and rfc 1884 IPv6 hex address to reduce the number of
  566. long strings of zero bits as specified in rfc 1884, 2.2 (2) by substituting
  567. B<::> for the first occurence of the longest string of zeros in the address.
  568.  
  569. =item * $ipv6naddr = ipv4to6($netaddr);
  570.  
  571. Convert an ipv4 network address into an IPv6 network address.
  572.  
  573. input: 32 bit network address
  574. returns: 128 bit network address
  575.  
  576. =item * $ipv6naddr = mask4to6($netaddr);
  577.  
  578. Convert an ipv4 network address/mask into an ipv6 network mask.
  579.  
  580. input: 32 bit network/mask address
  581. returns: 128 bit network/mask address
  582.  
  583. NOTE: returns the high 96 bits as one's
  584.  
  585. =item * $ipv6naddr = ipanyto6($netaddr);
  586.  
  587. Similar to ipv4to6 except that this function takes either an IPv4 or IPv6
  588. input and always returns a 128 bit IPv6 network address.
  589.  
  590. input: 32 or 128 bit network address
  591. returns: 128 bit network address
  592.  
  593. =item * $ipv6naddr = maskanyto6($netaddr);
  594.  
  595. Similar to mask4to6 except that this function takes either an IPv4 or IPv6
  596. netmask and always returns a 128 bit IPv6 netmask.
  597.  
  598. input: 32 or 128 bit network mask
  599. returns: 128 bit network mask
  600.  
  601. =item * $netaddr = ipv6to4($pv6naddr);
  602.  
  603. Truncate the upper 96 bits of a 128 bit address and return the lower
  604. 32 bits. Returns an IPv4 address as returned by inet_aton.
  605.  
  606. input: 128 bit network address
  607. returns: 32 bit inet_aton network address
  608.  
  609. =item * $bitsXn = shiftleft($bits128,$n);
  610.  
  611. input: 128 bit string variable,
  612. number of shifts [optional]
  613. returns: bits X n shifts
  614.  
  615. NOTE: a single shift is performed
  616. if $n is not specified
  617.  
  618. =item * addconst($ipv6naddr,$signed_32con);
  619.  
  620. Add a signed constant to a 128 bit string variable.
  621.  
  622. input: 128 bit IPv6 string,
  623. signed 32 bit integer
  624. returns: scalar carry
  625. array (carry, result)
  626.  
  627. =item * add128($ipv6naddr1,$ipv6naddr2);
  628.  
  629. Add two 128 bit string variables.
  630.  
  631. input: 128 bit string var1,
  632. 128 bit string var2
  633. returns: scalar carry
  634. array (carry, result)
  635.  
  636. =item * sub128($ipv6naddr1,$ipv6naddr2);
  637.  
  638. Subtract two 128 bit string variables.
  639.  
  640. input: 128 bit string var1,
  641. 128 bit string var2
  642. returns: scalar carry
  643. array (carry, result)
  644.  
  645. Note: The carry from this operation is the result of adding the one's
  646. complement of ARG2 +1 to the ARG1. It is logically
  647. B<NOT borrow>.
  648.  
  649. i.e. if ARG1 >= ARG2 then carry = 1
  650. or if ARG1 < ARG2 then carry = 0
  651.  
  652.  
  653. =item * ($spurious,$cidr) = notcontiguous($mask128);
  654.  
  655. This function counts the bit positions remaining in the mask when the
  656. rightmost '0's are removed.
  657.  
  658. input: 128 bit netmask
  659. returns true if there are spurious
  660. zero bits remaining in the
  661. mask, false if the mask is
  662. contiguous one's,
  663. 128 bit cidr number
  664.  
  665. =item * $bcdtext = bin2bcd($bits128);
  666.  
  667. Convert a 128 bit binary string into binary coded decimal text digits.
  668.  
  669. input: 128 bit string variable
  670. returns: string of bcd text digits
  671.  
  672. =item * $bits128 = bcd2bin($bcdtxt);
  673.  
  674. Convert a bcd text string to 128 bit string variable
  675.  
  676. input: string of bcd text digits
  677. returns: 128 bit string variable
  678.  
  679. =cut
  680.  
  681. #=item * $onescomp=NetAddr::IP::Util::comp128($ipv6addr);
  682. #
  683. #This function is not exported because it is more efficient to use perl " ~ "
  684. #on the bit string directly. This interface to the B<C> routine is published for
  685. #module testing purposes because it is used internally in the B<sub128> routine. The
  686. #function is very fast, but calling if from perl directly is very slow. It is almost
  687. #33% faster to use B<sub128> than to do a 1's comp with perl and then call
  688. #B<add128>.
  689. #
  690. #=item * $bcdpacked = NetAddr::IP::Util::bin2bcdn($bits128);
  691. #
  692. #Convert a 128 bit binary string into binary coded decimal digits.
  693. #This function is not exported.
  694. #
  695. # input: 128 bit string variable
  696. # returns: string of packed decimal digits
  697. #
  698. # i.e. text = unpack("H*", $bcd);
  699. #
  700. #=item * $bcdtext = NetAddr::IP::Util::bcdn2txt($bcdpacked);
  701. #
  702. #Convert a packed bcd string into text digits, suppress the leading zeros.
  703. #This function is not exported.
  704. #
  705. # input: string of packed decimal digits
  706. # returns: hexadecimal digits
  707. #
  708. #Similar to unpack("H*", $bcd);
  709. #
  710. #=item * $bcdpacked = NetAddr::IP::Util::simple_pack($bcdtext);
  711. #
  712. #Convert a numeric string into a packed bcd string, left fill with zeros
  713. #
  714. # input: string of decimal digits
  715. # returns: string of packed decimal digits
  716. #
  717. #Similar to pack("H*", $bcdtext);
  718.  
  719. =item * $modetext = mode;
  720.  
  721. Returns the operating mode of this module.
  722.  
  723. input: none
  724. returns: "Pure Perl"
  725. or "CC XS"
  726.  
  727. =item * ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME);
  728.  
  729. Replacement for Perl's gethostbyname if Socket6 is available
  730.  
  731. In ARRAY context, returns a list of five elements, the hostname or NAME,
  732. a space separated list of C_NAMES, AF family, length of the address
  733. structure, and an array of one or more netaddr's
  734.  
  735. In SCALAR context, returns the first netaddr.
  736.  
  737. This function ALWAYS returns an IPv6 address, even on IPv4 only systems.
  738. IPv4 addresses are mapped into IPv6 space in the form:
  739.  
  740. ::FFFF:FFFF:d.d.d.d
  741.  
  742. This is NOT the expected result from Perl's gethostbyname2. It is instead equivalent to:
  743.  
  744. On an IPv4 only system:
  745. $ipv6naddr = ipv4to6 scalar ( gethostbyname( name ));
  746.  
  747. On a system with Socket6 and a working gethostbyname2:
  748. $ipv6naddr = gethostbyname2( name, AF_INET6 );
  749. and if that fails, the IPv4 conversion above.
  750.  
  751. For a gethostbyname2 emulator that behave like Socket6, see:
  752. L<Net::DNS::Dig>
  753.  
  754. =item * $trueif = havegethostbyname2();
  755.  
  756. This function returns TRUE if Socket6 has a functioning B<gethostbyname2>,
  757. otherwise it returns FALSE. See the comments above about the behavior of
  758. B<naip_gethostbyname>.
  759.  
  760. =item * NetAddr::IP::Util::lower();
  761.  
  762. Return IPv6 strings in lowercase.
  763.  
  764. =item * NetAddr::IP::Util::upper();
  765.  
  766. Return IPv6 strings in uppercase. This is the default.
  767.  
  768. =back
  769.  
  770. =head1 EXAMPLES
  771.  
  772.  
  773. # convert any textual IP address into a 128 bit vector
  774. #
  775. sub text2vec {
  776. my($anyIP,$anyMask) = @_;
  777.  
  778. # not IPv4 bit mask
  779. my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::');
  780.  
  781. my $vecip = inet_any2n($anyIP);
  782. my $mask = inet_any2n($anyMask);
  783.  
  784. # extend mask bits for IPv4
  785. my $bits = 128; # default
  786. unless (hasbits($mask & $notiv4)) {
  787. $mask |= $notiv4;
  788. $bits = 32;
  789. }
  790. return ($vecip, $mask, $bits);
  791. }
  792.  
  793. ... alternate implementation, a little faster
  794.  
  795. sub text2vec {
  796. my($anyIP,$anyMask) = @_;
  797.  
  798. # not IPv4 bit mask
  799. my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::');
  800.  
  801. my $vecip = inet_any2n($anyIP);
  802. my $mask = inet_any2n($anyMask);
  803.  
  804. # extend mask bits for IPv4
  805. my $bits = 128; # default
  806. if (isIPv4($mask)) {
  807. $mask |= $notiv4;
  808. $bits = 32;
  809. }
  810. return ($vecip, $mask, $bits);
  811. }
  812.  
  813.  
  814. ... elsewhere
  815. $nip = {
  816. addr => $vecip,
  817. mask => $mask,
  818. bits => $bits,
  819. };
  820.  
  821. # return network and broadcast addresses from IP and Mask
  822. #
  823. sub netbroad {
  824. my($nip) = shift;
  825. my $notmask = ~ $nip->{mask};
  826. my $bcast = $nip->{addr} | $notmask;
  827. my $network = $nip->{addr} & $nip->{mask};
  828. return ($network, $broadcast);
  829. }
  830.  
  831. # check if address is within a network
  832. #
  833. sub within {
  834. my($nip,$net) = @_;
  835. my $addr = $nip->{addr}
  836. my($nw,$bc) = netbroad($net);
  837. # arg1 >= arg2, sub128 returns true
  838. return (sub128($addr,$nw) && sub128($bc,$addr))
  839. ? 1 : 0;
  840. }
  841.  
  842. # truely hard way to do $ip++
  843. # add a constant, wrapping at netblock boundaries
  844. # to subtract the constant, negate it before calling
  845. # 'addwrap' since 'addconst' will extend the sign bits
  846. #
  847. sub addwrap {
  848. my($nip,$const) = @_;
  849. my $addr = $nip->{addr};
  850. my $mask = $nip->{mask};
  851. my $bits = $nip->{bits};
  852. my $notmask = ~ $mask;
  853. my $hibits = $addr & $mask;
  854. $addr = addconst($addr,$const);
  855. my $wraponly = $addr & $notmask;
  856. my $newip = {
  857. addr => $hibits | $wraponly,
  858. mask => $mask,
  859. bits => $bits,
  860. };
  861. # bless $newip as appropriate
  862. return $newip;
  863. }
  864.  
  865. # something more useful
  866. # increment a /24 net to the NEXT net at the boundry
  867.  
  868. my $nextnet = 256; # for /24
  869. LOOP:
  870. while (...continuing) {
  871. your code....
  872. ...
  873. my $lastip = $ip-copy();
  874. $ip++;
  875. if ($ip < $lastip) { # host part wrapped?
  876. # discard carry
  877. (undef, $ip->{addr} = addconst($ip->{addr}, $nextnet);
  878. }
  879. next LOOP;
  880. }
  881.  
  882.  
  883. =head1 EXPORT_OK
  884.  
  885. inet_aton
  886. inet_ntoa
  887. ipv6_aton
  888. ipv6_ntoa
  889. ipv6_n2x
  890. ipv6_n2d
  891. inet_any2n
  892. hasbits
  893. isIPv4
  894. isNewIPv4
  895. isAnyIPv4
  896. inet_n2dx
  897. inet_n2ad
  898. inet_pton
  899. inet_ntop
  900. inet_4map6
  901. ipv4to6
  902. mask4to6
  903. ipanyto6
  904. maskanyto6
  905. ipv6to4
  906. packzeros
  907. shiftleft
  908. addconst
  909. add128
  910. sub128
  911. notcontiguous
  912. bin2bcd
  913. bcd2bin
  914. mode
  915. naip_gethostbyname
  916. havegethostbyname2
  917.  
  918. =head1 AUTHOR
  919.  
  920. Michael Robinton <michael@bizsystems.com>
  921.  
  922. =head1 COPYRIGHT
  923.  
  924. Copyright 2003 - 2013, Michael Robinton E<lt>michael@bizsystems.comE<gt>
  925.  
  926. All rights reserved.
  927.  
  928. This program is free software; you can redistribute it and/or modify
  929. it under the terms of either:
  930.  
  931. a) the GNU General Public License as published by the Free
  932. Software Foundation; either version 2, or (at your option) any
  933. later version, or
  934.  
  935. b) the "Artistic License" which comes with this distribution.
  936.  
  937. This program is distributed in the hope that it will be useful,
  938. but WITHOUT ANY WARRANTY; without even the implied warranty of
  939. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
  940. the GNU General Public License or the Artistic License for more details.
  941.  
  942. You should have received a copy of the Artistic License with this
  943. distribution, in the file named "Artistic". If not, I'll be glad to provide
  944. one.
  945.  
  946. You should also have received a copy of the GNU General Public License
  947. along with this program in the file named "Copying". If not, write to the
  948.  
  949. Free Software Foundation, Inc.
  950. 51 Franklin Street, Fifth Floor
  951. Boston, MA 02110-1301 USA.
  952.  
  953. or visit their web page on the internet at:
  954.  
  955. http://www.gnu.org/copyleft/gpl.html.
  956.  
  957. =head1 AUTHOR
  958.  
  959. Michael Robinton <michael@bizsystems.com>
  960.  
  961. =head1 SEE ALSO
  962.  
  963. NetAddr::IP(3), NetAddr::IP::Lite(3), NetAddr::IP::InetBase(3)
  964.  
  965. =cut
  966.  
  967. 1;