← Index
NYTProf Performance Profile   « line view »
For nd2: #2 manager: init
  Run on Thu May 2 17:38:58 2019
Reported on Thu May 2 17:40:49 2019

Filename/appl/netdisco/perl5/lib/perl5/x86_64-linux-thread-multi/NetAddr/IP/Util.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
50557221250ms250msNetAddr::IP::Util::::notcontiguous NetAddr::IP::Util::notcontiguous (xsub)
25278611184ms184msNetAddr::IP::Util::::ipv4to6 NetAddr::IP::Util::ipv4to6 (xsub)
29697911137ms137msNetAddr::IP::Util::::sub128 NetAddr::IP::Util::sub128 (xsub)
25258211106ms106msNetAddr::IP::Util::::hasbits NetAddr::IP::Util::hasbits (xsub)
0000s0sNetAddr::IP::Util::::BEGIN NetAddr::IP::Util::BEGIN
0000s0sNetAddr::IP::Util::::DESTROY NetAddr::IP::Util::DESTROY
0000s0sNetAddr::IP::Util::::havegethostbyname2 NetAddr::IP::Util::havegethostbyname2
0000s0sNetAddr::IP::Util::::import NetAddr::IP::Util::import
0000s0sNetAddr::IP::Util::::inet_4map6 NetAddr::IP::Util::inet_4map6
0000s0sNetAddr::IP::Util::::mode NetAddr::IP::Util::mode
0000s0sNetAddr::IP::Util::::naip_gethostbyname NetAddr::IP::Util::naip_gethostbyname
0000s0sNetAddr::IP::UtilPolluted::::BEGINNetAddr::IP::UtilPolluted::BEGIN
0000s0sNetAddr::IP::UtilPolluted::::__ANON__[:237]NetAddr::IP::UtilPolluted::__ANON__[:237]
0000s0sNetAddr::IP::UtilPolluted::::__ANON__[:245]NetAddr::IP::UtilPolluted::__ANON__[:245]
0000s0sNetAddr::IP::UtilPolluted::::__ANON__[:255]NetAddr::IP::UtilPolluted::__ANON__[:255]
0000s0sNetAddr::IP::UtilPolluted::::_end_gethostbynameNetAddr::IP::UtilPolluted::_end_gethostbyname
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/bin/perl
2package NetAddr::IP::Util;
3
4use strict;
5#use diagnostics;
6#use lib qw(blib/lib);
7
8use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS $Mode);
9use AutoLoader qw(AUTOLOAD);
10use NetAddr::IP::Util_IS;
11use 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
19require DynaLoader;
20require Exporter;
21
22@ISA = qw(Exporter DynaLoader);
23
24$VERSION = do { my @r = (q$Revision: 1.53 $ =~ /\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
129if (NetAddr::IP::Util_IS->not_pure) {
130 eval { ## attempt to load 'C' version of utilities
131 bootstrap NetAddr::IP::Util $VERSION;
132 };
133}
134if (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}
142else {
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
151sub mode() { $Mode };
152
153my $_newV4compat = pack('N4',0,0,0xffff,0);
154
155sub 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
170sub DESTROY {};
171
172my $havegethostbyname2 = 0;
173
174my $mygethostbyname;
175
176my $_Sock6ok = 1; # for testing gethostbyname
177
178sub havegethostbyname2 {
179 return $_Sock6ok
180 ? $havegethostbyname2
181 : 0;
182}
183
184sub import {
185 if (grep { $_ eq ':noSock6' } @_) {
186 $_Sock6ok = 0;
187 @_ = grep { $_ ne ':noSock6' } @_;
188 }
189 NetAddr::IP::Util->export_to_level(1,@_);
190}
191
192package 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
197use strict;
198use Socket;
199
200my $_v4zero = pack('L',0);
201my $_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
209sub _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
232unless ( 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
258package NetAddr::IP::Util;
259
260sub 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
2691;
270
271__END__
272
273=head1 NAME
274
275NetAddr::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
378Un-tar the distribution in an appropriate directory and type:
379
380 perl Makefile.PL
381 make
382 make test
383 make install
384
385B<NetAddr::IP::Util> installs by default with its primary functions compiled
386using Perl's XS extensions to build a 'C' library. If you do not have a 'C'
387complier available or would like the slower Pure Perl version for some other
388reason, then type:
389
390 perl Makefile.PL -noxs
391 make
392 make test
393 make install
394
395=head1 DESCRIPTION
396
397B<NetAddr::IP::Util> provides a suite of tools for manipulating and
398converting IPv4 and IPv6 addresses into 128 bit string context and back to
399text. The strings can be manipulated with Perl's logical operators:
400
401 and &
402 or |
403 xor ^
404 ~ compliment
405
406in the same manner as 'vec' strings.
407
408The 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
420Convert 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
427Convert 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
434Takes an IPv6 address of the form described in rfc1884
435and 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
442Convert a 128 bit binary IPv6 address to compressed rfc 1884
443text representation.
444
445 input: 128 bit RDATA string
446 returns: ipv6 text
447
448=item * $hex_text = ipv6_n2x($ipv6addr);
449
450Takes 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
457Takes an IPv6 RDATA string and returns a mixed hex - decimal IPv6 address
458with the 6 uppermost chunks in hex and the lower 32 bits in dot-quad
459representation.
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
466This function converts a text IPv4 or IPv6 address in text format in any
467standard notation into a 128 bit IPv6 string address. It prefixes any
468dot-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
475This function returns true if there are one's present in the 128 bit string
476and 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
486This 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
496This function returns an ipV6 network address with the first 80 bits
497set to zero and the next 16 bits set to one, while the last 32 bits
498are 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
506An ipV6 network address must be in one of the two compatible ipV4
507mapped address spaces. i.e.
508
509 ::ffff::d.d.d.d or ::d.d.d.d
510
511=item * $rv = isIPv4($bits128);
512
513This function returns true if there are no on bits present in the IPv6
514portion of the 128 bit string and false otherwise.
515
516 i.e. the address must be of the form - ::d.d.d.d
517
518Note: this is an old and deprecated ipV4 compatible ipV6 address
519
520=item * $rv = isNewIPv4($bits128);
521
522This function return true if the IPv6 128 bit string is of the form
523
524 ::ffff::d.d.d.d
525
526=item * $rv = isAnyIPv4($bits128);
527
528This function return true if the IPv6 bit string is of the form
529
530 ::d.d.d.d or ::ffff::d.d.d.d
531
532=item * $dotquad or $hex_text = inet_n2dx($ipv6naddr);
533
534This function B<does the right thing> and returns the text for either a
535dot-quad IPv4 or a hex notation IPv6 address.
536
537 input: 128 bit IPv6 string
538 returns: ddd.ddd.ddd.ddd
539 or x:x:x:x:x:x:x:x
540
541=item * $dotquad or $dec_text = inet_n2ad($ipv6naddr);
542
543This function B<does the right thing> and returns the text for either a
544dot-quad IPv4 or a hex::decimal notation IPv6 address.
545
546 input: 128 bit IPv6 string
547 returns: ddd.ddd.ddd.ddd
548 or x:x:x:x:x:x:ddd.ddd.ddd.dd
549
550=item * $netaddr = inet_pton($AF_family,$hex_text);
551
552This function takes an IP address in IPv4 or IPv6 text format and converts it into
553binary format. The type of IP address conversion is controlled by the FAMILY
554argument.
555
556=item * $hex_text = inet_ntop($AF_family,$netaddr);
557
558This function takes and IP address in binary format and converts it into
559text format. The type of IP address conversion is controlled by the FAMILY
560argument.
561
562NOTE: inet_ntop ALWAYS returns lowercase characters.
563
564=item * $hex_text = packzeros($hex_text);
565
566This function optimizes and rfc 1884 IPv6 hex address to reduce the number of
567long strings of zero bits as specified in rfc 1884, 2.2 (2) by substituting
568B<::> for the first occurence of the longest string of zeros in the address.
569
570=item * $ipv6naddr = ipv4to6($netaddr);
571
572Convert an ipv4 network address into an IPv6 network address.
573
574 input: 32 bit network address
575 returns: 128 bit network address
576
577=item * $ipv6naddr = mask4to6($netaddr);
578
579Convert an ipv4 network address/mask into an ipv6 network mask.
580
581 input: 32 bit network/mask address
582 returns: 128 bit network/mask address
583
584NOTE: returns the high 96 bits as one's
585
586=item * $ipv6naddr = ipanyto6($netaddr);
587
588Similar to ipv4to6 except that this function takes either an IPv4 or IPv6
589input and always returns a 128 bit IPv6 network address.
590
591 input: 32 or 128 bit network address
592 returns: 128 bit network address
593
594=item * $ipv6naddr = maskanyto6($netaddr);
595
596Similar to mask4to6 except that this function takes either an IPv4 or IPv6
597netmask and always returns a 128 bit IPv6 netmask.
598
599 input: 32 or 128 bit network mask
600 returns: 128 bit network mask
601
602=item * $netaddr = ipv6to4($pv6naddr);
603
604Truncate the upper 96 bits of a 128 bit address and return the lower
60532 bits. Returns an IPv4 address as returned by inet_aton.
606
607 input: 128 bit network address
608 returns: 32 bit inet_aton network address
609
610=item * $bitsXn = shiftleft($bits128,$n);
611
612 input: 128 bit string variable,
613 number of shifts [optional]
614 returns: bits X n shifts
615
616 NOTE: a single shift is performed
617 if $n is not specified
618
619=item * addconst($ipv6naddr,$signed_32con);
620
621Add a signed constant to a 128 bit string variable.
622
623 input: 128 bit IPv6 string,
624 signed 32 bit integer
625 returns: scalar carry
626 array (carry, result)
627
628=item * add128($ipv6naddr1,$ipv6naddr2);
629
630Add two 128 bit string variables.
631
632 input: 128 bit string var1,
633 128 bit string var2
634 returns: scalar carry
635 array (carry, result)
636
637=item * sub128($ipv6naddr1,$ipv6naddr2);
638
639Subtract two 128 bit string variables.
640
641 input: 128 bit string var1,
642 128 bit string var2
643 returns: scalar carry
644 array (carry, result)
645
646Note: The carry from this operation is the result of adding the one's
647complement of ARG2 +1 to the ARG1. It is logically
648B<NOT borrow>.
649
650 i.e. if ARG1 >= ARG2 then carry = 1
651 or if ARG1 < ARG2 then carry = 0
652
653
654=item * ($spurious,$cidr) = notcontiguous($mask128);
655
656This function counts the bit positions remaining in the mask when the
657rightmost '0's are removed.
658
659 input: 128 bit netmask
660 returns true if there are spurious
661 zero bits remaining in the
662 mask, false if the mask is
663 contiguous one's,
664 128 bit cidr number
665
666=item * $bcdtext = bin2bcd($bits128);
667
668Convert a 128 bit binary string into binary coded decimal text digits.
669
670 input: 128 bit string variable
671 returns: string of bcd text digits
672
673=item * $bits128 = bcd2bin($bcdtxt);
674
675Convert a bcd text string to 128 bit string variable
676
677 input: string of bcd text digits
678 returns: 128 bit string variable
679
680=cut
681
682#=item * $onescomp=NetAddr::IP::Util::comp128($ipv6addr);
683#
684#This function is not exported because it is more efficient to use perl " ~ "
685#on the bit string directly. This interface to the B<C> routine is published for
686#module testing purposes because it is used internally in the B<sub128> routine. The
687#function is very fast, but calling if from perl directly is very slow. It is almost
688#33% faster to use B<sub128> than to do a 1's comp with perl and then call
689#B<add128>.
690#
691#=item * $bcdpacked = NetAddr::IP::Util::bin2bcdn($bits128);
692#
693#Convert a 128 bit binary string into binary coded decimal digits.
694#This function is not exported.
695#
696# input: 128 bit string variable
697# returns: string of packed decimal digits
698#
699# i.e. text = unpack("H*", $bcd);
700#
701#=item * $bcdtext = NetAddr::IP::Util::bcdn2txt($bcdpacked);
702#
703#Convert a packed bcd string into text digits, suppress the leading zeros.
704#This function is not exported.
705#
706# input: string of packed decimal digits
707# returns: hexadecimal digits
708#
709#Similar to unpack("H*", $bcd);
710#
711#=item * $bcdpacked = NetAddr::IP::Util::simple_pack($bcdtext);
712#
713#Convert a numeric string into a packed bcd string, left fill with zeros
714#
715# input: string of decimal digits
716# returns: string of packed decimal digits
717#
718#Similar to pack("H*", $bcdtext);
719
720=item * $modetext = mode;
721
722Returns the operating mode of this module.
723
724 input: none
725 returns: "Pure Perl"
726 or "CC XS"
727
728=item * ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME);
729
730Replacement for Perl's gethostbyname if Socket6 is available
731
732In ARRAY context, returns a list of five elements, the hostname or NAME,
733a space separated list of C_NAMES, AF family, length of the address
734structure, and an array of one or more netaddr's
735
736In SCALAR context, returns the first netaddr.
737
738This function ALWAYS returns an IPv6 address, even on IPv4 only systems.
739IPv4 addresses are mapped into IPv6 space in the form:
740
741 ::FFFF:FFFF:d.d.d.d
742
743This is NOT the expected result from Perl's gethostbyname2. It is instead equivalent to:
744
745 On an IPv4 only system:
746 $ipv6naddr = ipv4to6 scalar ( gethostbyname( name ));
747
748 On a system with Socket6 and a working gethostbyname2:
749 $ipv6naddr = gethostbyname2( name, AF_INET6 );
750 and if that fails, the IPv4 conversion above.
751
752For a gethostbyname2 emulator that behave like Socket6, see:
753L<Net::DNS::Dig>
754
755=item * $trueif = havegethostbyname2();
756
757This function returns TRUE if Socket6 has a functioning B<gethostbyname2>,
758otherwise it returns FALSE. See the comments above about the behavior of
759B<naip_gethostbyname>.
760
761=item * NetAddr::IP::Util::lower();
762
763Return IPv6 strings in lowercase.
764
765=item * NetAddr::IP::Util::upper();
766
767Return IPv6 strings in uppercase. This is the default.
768
769=back
770
771=head1 EXAMPLES
772
773
774 # convert any textual IP address into a 128 bit vector
775 #
776 sub text2vec {
777 my($anyIP,$anyMask) = @_;
778
779 # not IPv4 bit mask
780 my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::');
781
782 my $vecip = inet_any2n($anyIP);
783 my $mask = inet_any2n($anyMask);
784
785 # extend mask bits for IPv4
786 my $bits = 128; # default
787 unless (hasbits($mask & $notiv4)) {
788 $mask |= $notiv4;
789 $bits = 32;
790 }
791 return ($vecip, $mask, $bits);
792 }
793
794 ... alternate implementation, a little faster
795
796 sub text2vec {
797 my($anyIP,$anyMask) = @_;
798
799 # not IPv4 bit mask
800 my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::');
801
802 my $vecip = inet_any2n($anyIP);
803 my $mask = inet_any2n($anyMask);
804
805 # extend mask bits for IPv4
806 my $bits = 128; # default
807 if (isIPv4($mask)) {
808 $mask |= $notiv4;
809 $bits = 32;
810 }
811 return ($vecip, $mask, $bits);
812 }
813
814
815 ... elsewhere
816 $nip = {
817 addr => $vecip,
818 mask => $mask,
819 bits => $bits,
820 };
821
822 # return network and broadcast addresses from IP and Mask
823 #
824 sub netbroad {
825 my($nip) = shift;
826 my $notmask = ~ $nip->{mask};
827 my $bcast = $nip->{addr} | $notmask;
828 my $network = $nip->{addr} & $nip->{mask};
829 return ($network, $broadcast);
830 }
831
832 # check if address is within a network
833 #
834 sub within {
835 my($nip,$net) = @_;
836 my $addr = $nip->{addr}
837 my($nw,$bc) = netbroad($net);
838 # arg1 >= arg2, sub128 returns true
839 return (sub128($addr,$nw) && sub128($bc,$addr))
840 ? 1 : 0;
841 }
842
843 # truely hard way to do $ip++
844 # add a constant, wrapping at netblock boundaries
845 # to subtract the constant, negate it before calling
846 # 'addwrap' since 'addconst' will extend the sign bits
847 #
848 sub addwrap {
849 my($nip,$const) = @_;
850 my $addr = $nip->{addr};
851 my $mask = $nip->{mask};
852 my $bits = $nip->{bits};
853 my $notmask = ~ $mask;
854 my $hibits = $addr & $mask;
855 $addr = addconst($addr,$const);
856 my $wraponly = $addr & $notmask;
857 my $newip = {
858 addr => $hibits | $wraponly,
859 mask => $mask,
860 bits => $bits,
861 };
862 # bless $newip as appropriate
863 return $newip;
864 }
865
866 # something more useful
867 # increment a /24 net to the NEXT net at the boundry
868
869 my $nextnet = 256; # for /24
870 LOOP:
871 while (...continuing) {
872 your code....
873 ...
874 my $lastip = $ip-copy();
875 $ip++;
876 if ($ip < $lastip) { # host part wrapped?
877 # discard carry
878 (undef, $ip->{addr} = addconst($ip->{addr}, $nextnet);
879 }
880 next LOOP;
881 }
882
883
884=head1 EXPORT_OK
885
886 inet_aton
887 inet_ntoa
888 ipv6_aton
889 ipv6_ntoa
890 ipv6_n2x
891 ipv6_n2d
892 inet_any2n
893 hasbits
894 isIPv4
895 isNewIPv4
896 isAnyIPv4
897 inet_n2dx
898 inet_n2ad
899 inet_pton
900 inet_ntop
901 inet_4map6
902 ipv4to6
903 mask4to6
904 ipanyto6
905 maskanyto6
906 ipv6to4
907 packzeros
908 shiftleft
909 addconst
910 add128
911 sub128
912 notcontiguous
913 bin2bcd
914 bcd2bin
915 mode
916 naip_gethostbyname
917 havegethostbyname2
918
919=head1 AUTHOR
920
921Michael Robinton <michael@bizsystems.com>
922
923=head1 COPYRIGHT
924
925Copyright 2003 - 2014, Michael Robinton E<lt>michael@bizsystems.comE<gt>
926
927All rights reserved.
928
929This program is free software; you can redistribute it and/or modify
930it under the terms of either:
931
932 a) the GNU General Public License as published by the Free
933 Software Foundation; either version 2, or (at your option) any
934 later version, or
935
936 b) the "Artistic License" which comes with this distribution.
937
938This program is distributed in the hope that it will be useful,
939but WITHOUT ANY WARRANTY; without even the implied warranty of
940MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
941the GNU General Public License or the Artistic License for more details.
942
943You should have received a copy of the Artistic License with this
944distribution, in the file named "Artistic". If not, I'll be glad to provide
945one.
946
947You should also have received a copy of the GNU General Public License
948along with this program in the file named "Copying". If not, write to the
949
950 Free Software Foundation, Inc.
951 51 Franklin Street, Fifth Floor
952 Boston, MA 02110-1301 USA.
953
954or visit their web page on the internet at:
955
956 http://www.gnu.org/copyleft/gpl.html.
957
958=head1 AUTHOR
959
960Michael Robinton <michael@bizsystems.com>
961
962=head1 SEE ALSO
963
964NetAddr::IP(3), NetAddr::IP::Lite(3), NetAddr::IP::InetBase(3)
965
966=cut
967
9681;
 
# spent 106ms within NetAddr::IP::Util::hasbits which was called 252582 times, avg 421ns/call: # 252582 times (106ms+0s) by NetAddr::IP::Lite::within at line 1364 of NetAddr/IP/Lite.pm, avg 421ns/call
sub NetAddr::IP::Util::hasbits; # xsub
# spent 184ms within NetAddr::IP::Util::ipv4to6 which was called 252786 times, avg 727ns/call: # 252786 times (184ms+0s) by NetAddr::IP::Lite::_xnew at line 1047 of NetAddr/IP/Lite.pm, avg 727ns/call
sub NetAddr::IP::Util::ipv4to6; # xsub
# spent 250ms within NetAddr::IP::Util::notcontiguous which was called 505572 times, avg 494ns/call: # 252786 times (127ms+0s) by NetAddr::IP::Lite::masklen at line 1139 of NetAddr/IP/Lite.pm, avg 502ns/call # 252786 times (123ms+0s) by NetAddr::IP::Lite::_xnew at line 1063 of NetAddr/IP/Lite.pm, avg 486ns/call
sub NetAddr::IP::Util::notcontiguous; # xsub
# spent 137ms within NetAddr::IP::Util::sub128 which was called 296979 times, avg 461ns/call: # 296979 times (137ms+0s) by NetAddr::IP::Lite::within at line 1369 of NetAddr/IP/Lite.pm, avg 461ns/call
sub NetAddr::IP::Util::sub128; # xsub
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.