File Coverage

blib/lib/Net/Interface.pm
Criterion Covered Total %
statement 75 140 53.5
branch 36 72 50.0
condition 21 42 50.0
subroutine 13 23 56.5
pod 10 12 83.3
total 155 289 53.6


line stmt bran cond sub pod time code
1             package Net::Interface;
2              
3 12     12   108876 use strict;
  12         19  
  12         358  
4             #use lib qw(blib/lib blib/arch);
5 12         2625 use vars qw(
6             $VERSION
7             @ISA
8             %EXPORT_TAGS
9             @EXPORT_OK
10 12     12   44 );
  12         15  
11              
12             #use AutoLoader qw(AUTOLOAD);
13             require Exporter;
14             require DynaLoader;
15              
16             @ISA = qw(Exporter DynaLoader);
17             require Net::Interface::NetSymbols; # just for the EXPORT symbol arrays
18              
19             @EXPORT_OK = (
20             @Net::Interface::NetSymbols::EXPORT_OK,
21             qw(
22             cidr2mask
23             full_inet_ntop
24             ipV6compress
25             mac_bin2hex
26             mask2cidr
27             net_symbols
28             type
29             scope
30             inet_aton
31             inet_ntoa
32             inet_pton
33             inet_ntop
34             _NI_AF_TEST
35             )
36             );
37              
38             %EXPORT_TAGS = %Net::Interface::NetSymbols::EXPORT_TAGS;
39             $EXPORT_TAGS{constants} = $EXPORT_TAGS{ifs}; # deprecated form
40             $EXPORT_TAGS{inet} = [qw(
41             inet_aton
42             inet_ntoa
43             inet_pton
44             inet_ntop
45             )];
46              
47             $VERSION = do { sprintf "%d.%03d", (q$Revision: 1.14 $ =~ /\d+/g) };
48              
49             bootstrap Net::Interface $VERSION;
50              
51             # register the conditionally compiled family modules
52             Net::Interface::conreg();
53              
54              
55             # provide AF family data for use in this module
56              
57             my $AF_inet = eval { 0 + AF_INET() } || 0;
58             my $AF_inet6 = eval { 0 + AF_INET6() } || 0;
59              
60 0     0 0 0 sub af_inet { return $AF_inet; }
61 0     0 0 0 sub af_inet6 { return $AF_inet6; }
62              
63             sub net_symbols() {
64 12     12   48 no strict;
  12         17  
  12         1497  
65 0     0 1 0 my %sym;
66 0         0 my $max = AF_MAX();
67 0         0 foreach (
68 0         0 @{$EXPORT_TAGS{afs}},
69 0         0 @{$EXPORT_TAGS{pfs}},
70 0         0 @{$EXPORT_TAGS{ifs}},
71 0         0 @{$EXPORT_TAGS{iftype}},
72 0         0 @{$EXPORT_TAGS{scope}},
73             ) {
74 0         0 my $v = &$_;
75 0 0       0 next if $v > $max;
76 0         0 $sym{$_} = &$_;
77             }
78 0         0 return \%sym;
79             }
80              
81             ########## begin code ############
82              
83             *broadcast = \&destination;
84            
85             use overload
86              
87 12     12   10928 '""' => sub { $_[0]->name(); };
  12     1   8729  
  12         79  
  1         272  
88              
89             our $full_format = "%02X%02X:%02X%02X:%02X%02X:%02X%02X:%02X%02X:%02X%02X:%02X%02X:%02X%02X";
90             our $ipv6_format = 1;
91             our $mac_format = "%02X:%02X:%02X:%02X:%02X:%02X";
92              
93             sub import {
94 13 100   13   83 if (grep { $_ eq ':lower' } @_) {
  50         98  
95 2         5 $full_format = lc($full_format);
96 2         3 $ipv6_format = 0;
97 2         3 $mac_format = lc($mac_format);
98 2         3 @_ = grep { $_ ne ':lower' } @_;
  4         8  
99             }
100 13 50       15 if (grep { $_ eq ':upper' } @_) {
  48         60  
101 0         0 $full_format = uc($full_format);
102 0         0 $ipv6_format = 1;
103 0         0 $mac_format = uc($mac_format);
104 0         0 @_ = grep { $_ ne ':upper' } @_;
  0         0  
105             }
106 13         6309 Net::Interface->export_to_level(1,@_);
107             }
108              
109       0     sub DESTROY () {}
110              
111             #1;
112             #__END__
113              
114             # create blessed object for testing
115             #
116             sub _bo($) {
117 3     3   47729 my $proto = shift;
118 3   33     24 my $class = ref($proto) || $proto;
119 3         10 bless {}, $class;
120             }
121              
122             =head1 NAME
123              
124             Net::Interface - Perl extension to access network interfaces
125              
126             =head1 SYNOPSIS
127              
128             use Net::Interface qw(
129             cidr2mask
130             full_inet_ntop
131             ipV6compress
132             mac_bin2hex
133             mask2cidr
134             net_symbols
135             type
136             scope
137             inet_aton
138             inet_ntoa
139             inet_pton
140             inet_ntop
141             :afs
142             :pfs
143             :ifs
144             :iffs
145             :iffIN6
146             :iftype
147             :scope
148             :constants
149             :inet
150             :all
151             :lower
152             :upper
153             );
154              
155             =head2 TAGS
156            
157             Note: tags :afs, :pfs, :constants, :ifs
158             include all AF_[family names], PF_[family names] and
159             IFxxxx values that exist on this architecture.
160              
161             :iffs includes only IFF_xxx values
162             :iffIN6 includes IN6_IFF_xxx values on BSD flavored OS's
163              
164             :inet includes inet_aton, inet_ntoa,
165             inet_pton, inet_ntop
166              
167             On platforms that support IPV6, :iftype :scope
168             provide additional attribute screening
169              
170             :constants is a deprecated synonym for :ifs
171              
172             See L built specifically for this platform for
173             a detailed list and description of all symbols available on this specific
174             architecture and operating systems version.
175              
176             By default B functions and methods return string IPv6
177             addresses and MAC addresses in uppercase. To change that to lowercase:
178              
179             use Net::Interface qw(:lower);
180              
181             To ensure the current string case behavior even if the default
182             changes:
183              
184             use Net::Interface qw(:upper);
185              
186              
187             =head2 FUNCTIONS and METHODS
188              
189             @all_ifs = Net::Interface->interfaces();
190              
191             $this_if = Net::Interface->new('eth0');
192             $refresh_if = $any_if->new();
193             $refresh_if = $this_if->delete($naddr);
194              
195             $create_if = Net::Interface->new(\%iface_spec);
196              
197             @ifnames = "@all_ifs";
198             $if_name_txt = $if->name;
199              
200             print $if,"\n"; # prints the name
201             print "@all_ifs\n" # prints all names
202              
203             ---------------------------------------------
204             WARNING API CHANGE !
205              
206             $naddr = $if->address([$family],[$index]);
207             $naddr = $if->netmask([$family],[$index]);
208             $naddr = $if->destination([$family],[$index]);
209             same as
210             $naddr = $if->broadcast([$family],[$index]);
211              
212             @addresses = $if->address([$family]);
213             @netmasks = $if->netmask([$family]);
214             @destinats = $if->destination([$family]);
215             same as
216             @broaddrs = $if->broadcast([$family]);
217              
218             $bin_mac = $if->hwaddress($hwaddr);
219             ---------------------------------------------
220              
221             $val = $if->flags($val);
222             $val = $if->mtu ($val);
223             $val = $if->metric($val);
224             $val = $if=>index();
225              
226             $cidr = $if->mask2cidr([$naddmsk])
227             $cidr = mask2cidr($naddrmsk);
228             $naddrmsk = cidr2mask($cidr,[family])
229              
230             $mac_txt = if->mac_bin2hex();
231             $mac_txt = mac_bin2hex($bin_mac);
232              
233             $naddr = inet_aton($host or $dotquad);
234             $dotquad = inet_ntoa($naddr);
235              
236             $info = $if->info();
237              
238             for ipV6 only
239             $type = $if->type([$naddr6]);
240             $type = type($naddr6);
241             $scope = $if->scope([$naddr6]);
242             $scope = scope($naddr6);
243              
244             $full_ipV6_txt = full_inet_ntop($naddr6);
245             $ipV6_txt = inet_ntop($naddr6)
246             $naddr6 = inet_pton($ipV6_txt);
247              
248             =head1 DESCRIPTION
249              
250             B is a module that allows access to the host network
251             interfaces in a manner similar to I. Version 1.00 is a complete
252             re-write and includes support for IPV6 as well as the traditional IPV4.
253              
254             Both read and write access to network device attributes including the
255             creation of new logical and physical interfaces is available where
256             supported by the OS and this module.
257              
258             NOTE: if your OS is not supported, please feel free to contribute new
259             capabilities, patches, etc.... see: L
260              
261             ANOTHER NOTE: Many of the operations of B, particularly
262             those that set interface values require privileged access to OS resources.
263             Wherever possible, B will simply fail I when there
264             are not adequate privileges to perform the requested operation or where the
265             operation is not supported.
266              
267             =head1 OPERATION
268              
269             B retrieves information about the network devices on its
270             host in a fashion similar to I running in a terminal window.
271             With I, the information is returned to the screen and
272             any additional activity on a particular network device goes on without the
273             knowledge of the user. Similarly, B only retrieves
274             information about network devices when methods I and I are
275             invoked. Calls to I retrieves information about all network
276             devices known to the host. Calls to I make the same function call to
277             the host library but rather than returning all the interface net device
278             information to the user, it selects out only information for the specified
279             device. The function call to the OS is the same. This information is cached
280             in the object returned to the user interface and it is from this object that
281             data is returned to the user program.
282              
283             To continually monitor a particular device, it is necessary to issue
284             repeat calls to I.
285              
286             =head1 SYMBOLS
287              
288             B provide a large number of network interface symbols
289             with a module generated on its build host. These symbols include all of the
290             available AF_xxxx, PF_xxx, IFF_xxx symbols and many more. For a detailed
291             list of all of these symbols, see L.
292              
293             =head2 HINTS and TIPS for use SYMBOLS
294              
295             Most of the symbols provided by B have dual values.
296              
297             1) a numeric value when use in arithmetic context and
298              
299             2) a text value when used in string/text context
300              
301             Symbols are actually calls to functions. Because of this certain usage rules
302             apply that are not necessarily obvious.
303              
304             If you make it a practice to build your Perl modules using:
305              
306             #!/usr/bin/perl
307             use strict;
308              
309             Then usage of symbols will require that they explicitly be called as
310             functions. i.e.
311              
312             $functval = &AF_INET is OK
313              
314             $functval = AF_INET() is better
315              
316             The first calling method allows the function to pick up the contents of
317             B<@_>. This works fine as long as B<@_> is empty. Since symbols do not take
318             arguments, when B<@_> contains something the symbol call will fail with a
319             message from Perl about inappropriate calling syntax.
320              
321             If you do not C (not recommended) then bare symbols will work just fine in your
322             Perl scripts. You can also imbed your symbols in blocks where B is
323             not enforced.
324              
325             {
326             no strict;
327             $functval = AF_INET
328             }
329              
330             Lastly, to access the numeric value of a symbol unconditionally:
331              
332             $numeric = 0 + AF_INET
333              
334             =head1 WARNING - API CHANGES
335              
336             The following changes have been made to the API. This may I existing
337             code. If you have been using a previous version of Net::Interface you should
338             verify that these API changes do not break your code.
339              
340             =over 6
341              
342             B
343              
344             =item * I<$naddr=$if-Eaddress($naddr);>
345              
346             =item * I<$naddr=$if-Enetmask($naddr);>
347              
348             =item * I<$naddr=$if-Edestination($naddr);>
349              
350             =item * I<$naddr=$if-Ebroadcast($naddr);>
351              
352             =item * I<$mac = $if->hwaddress($hwaddr);>
353              
354             =back
355              
356             Setting address values was never implemented in previous versions of
357             Net::Interface. With this version (where supported) changing an address
358             will be implemented using a hash argument containing the required and
359             optional elements in a manner similar to I. See:
360              
361             Net::Interface->new(\%iface_spec);
362              
363             =over 6
364              
365             B
366              
367             =item * I<($sa_family,$size,$naddr)=$if-Eaddress($naddr);>
368              
369             =back
370              
371             On most platforms, multiple addresses and multiple address families can be
372             assigned to the same interface. The returned data described above conflicts
373             with the requirement to report multiple addresses for a particular
374             interface. In addition, the returned information only reflected the
375             attributes of the I address assigned to the device where there could
376             be many of mixed families. i.e. AF_INET, AF_INET6, and perhaps more as the
377             capabilities of this module are enhanced to support additional address
378             families.
379              
380             The API has been changed to reflect this reality and the need to report
381             multiple addresses on the same interface.
382              
383             @addresses = $if->address([$family]);
384              
385             The new API is described in detail later in this document.
386              
387             =over 6
388              
389             B
390              
391             =item * I<($sa_family,$size,$hwaddr)=$if-Ehwaddress($hwaddr);>
392              
393             =back
394              
395             As in the preceding case, it is not possible to accurately report the
396             address family attributes of an interface which may support assignments
397             of more than one address from differing address families.
398              
399             see: if->info();
400              
401             =head1 METHODS
402              
403             Brackets [] indicates an optional parameter.
404              
405             The return value for I attempts on systems that do not support the
406             operation is not settled. Current practice is to silently
407             ignore the set request. This may change so don't count on this behavior.
408              
409             Unless otherwise specified, errors for all methods return either B or and empty array depending
410             on the expected return context.
411              
412             =cut
413              
414             # ********************************************* *
415             # The information for each interface (IF) is *
416             # contained in an HV. The name slot of the *
417             # HV holds the IF name. The args slot points *
418             # to a hash whose key values represent the *
419             # last interrogated state of the IF. *
420             # *
421             # HV { *
422             # indx => IV, *
423             # flav => IV, *
424             # name => interface name; *
425             # args => { *
426             # maci => bin string, *
427             # mtui => IV, *
428             # metk => IV, *
429             # flag => NV, *
430             # afk => { *
431             # size => IV, *
432             # addr => [], *
433             # netm => [], *
434             # dsta => [], *
435             # }, *
436             # afk => { *
437             # size => IV, *
438             # addr => [], *
439             # netm => [], *
440             # dsta => [], *
441             # }, *
442             # } *
443             # }; *
444             # Note: for ease of coding, all keys=4 chars *
445             # except for 'afk' which is computed *
446             # ********************************************* *
447              
448             =pod
449              
450             =over 4
451              
452             =item * I<-Einterfaces();>
453              
454             Returns a list of interface objects for each interface that supports IPV4
455             or IPV6.
456              
457             On failure, returns an empty list.
458              
459             usage:
460              
461             @all_ifs = Net::Interface->interfaces();
462              
463             foreach my $if (@all_ifs) {
464             $if_name = $if->name;
465             or
466             print $if, "\n"; # (overloaded)
467             }
468              
469             Get or Set (where supported)
470             $old_mtu = $if->mtu($new_mtu);
471             $old_metric = $if->metric($new_metric);
472             etc...
473              
474             =back
475              
476             =item * I<-Enew();> has multiple calling invocations.
477              
478             This method will refresh the data for an existing interface OR it can modify
479             and existing interface OR it can create a new interface or alias.
480              
481             =over 4
482              
483             =item * $this_if = I<-Enew('eth0');>
484              
485             Same as I<-Einterfaces> above except for a single known interface. An
486             interface object is returned for the specific logical device requested.
487              
488             On failure return B
489              
490             =item * $refresh_if = I<-Enew();>
491              
492             The a new (refreshed) interface object is returned for the same logical
493             device.
494              
495             =item * $new_if = I<-Enew(%iface_spec);>
496              
497             =item * $new_if = I<-Enew(\%iface_spec);>
498              
499             A logical device is created or updated. The specification is contained in a hash
500             table that is passed to I either directly or as a reference.
501              
502             The interface specification is architecture dependent. For example, adding
503             an address to an existing interface.
504              
505             i.e. Linux
506              
507             $iface_spec = {
508             name => 'eth0:0',
509             address => inet_aton('192.168.1.2'),
510             netmask => inet_aton('255.255.255.0),
511             # netmask may be optionally specified as:
512             # cidr => 24,
513             broadcast => inet_aton('192.168.1.255),
514             # optional values, defaults shown
515             metric => 1,
516             mtu => 1500,
517             };
518              
519             The address family is determined by inspection of the size of the address.
520              
521             i.e. BSD variants
522              
523             $iface_spec = {
524             name => 'eth0', # primary interface
525             alias => inet_aton('192.168.1.2'),
526             netmask => inet_aton('255.255.255.255),
527             # netmask may be optionally specified as:
528             # cidr => 32,
529             # optional values, defaults shown
530             metric => 1,
531             mtu => 1500,
532             };
533              
534             The keyword B says not to change the primary interface but instead to
535             add an address to the interface.
536              
537             =item * $refresh_if = I<-Edelete($naddr);>
538              
539             Removes and address from an interface where supported.
540              
541             =item * I<-Ename();>
542              
543             Return the B of the interface.
544              
545             =cut
546              
547             sub name ($) {
548 1     1 1 2 return $_[0]->{name};
549             }
550              
551             =item * I<-Eaddress([$family],[$index]);>
552              
553             B
554              
555             Get the interface specified by the optional C<$family> and C<$index>.
556              
557             Absent a C<$family> and C<$index>, the first available interface for the
558             family AF_INET (or if not present AF_INET6) will be returned.
559              
560             NOTE: this is not a definitive response. The OS may report the interfaces in
561             any order. Usually the primary interface is reported first but this is not
562             guaranteed. Use ARRAY context instead to get all addresses.
563              
564             B
565              
566             Returns a list of addresses assigned to this interface.
567              
568             If a C<$family> is not specified then AF_INET is assumed or AF_INET6 if
569             there are no AF_INET addresses present.
570              
571             =item * I<-Enetmask([$family],[$index]);>
572              
573             Similar to I<-Eaddress([$family],[$index]);> above. Netmasks are reported in the
574             same order as the addresses above, in matching positions in the returned
575             array.
576              
577             =item * I<-Edestination([$family],[$index]);>
578              
579             =item * I<-Ebroadcast([$family],[$index]);>
580              
581             These to methods are identical in execution. The returned address
582             attribute(s) will be destination or broadcast addresses depending on the
583             status of the POINTOPOINT flag.
584              
585             Similar to I<-Eaddress([$family],[$index]);> above. If an address attribute is
586             unknown, the array slot will contain I.
587              
588             =cut
589              
590             sub address ($;$$) {
591 0     0 1 0 unshift @_, 'addr';
592             # can't use 'goto', work around for broken perl 5.80-5.85 @_ bug
593 0 0       0 return &_address
594             if wantarray;
595 0         0 return scalar &_address;
596             }
597              
598             sub netmask ($;$$) {
599 0     0 1 0 unshift @_, 'netm';
600             # can't use 'goto', work around for broken perl 5.80-5.85 @_ bug
601 0 0       0 return &_address
602             if wantarray;
603 0         0 return scalar &_address;
604             }
605              
606             sub destination ($;$$) {
607 0     0 1 0 unshift @_, 'dsta';
608             # can't use 'goto', work around for broken perl 5.80-5.85 @_ bug
609 0 0       0 return &_address
610             if wantarray;
611 0         0 return scalar &_address;
612             }
613              
614             sub _address {
615 0     0   0 my($k,$if,$f,$i) = @_;
616 0   0     0 my $idx = $i || 0;
617 0 0       0 $f = 0 unless $f;
618 0         0 my $fam = 0 + $f;
619 0 0       0 unless ($f) { # if the family is missing
620 0 0       0 if (exists $if->{args}->{&af_inet}) {
621 0         0 $fam = &af_inet; # select default, AF_INET
622             }
623             else {
624 0         0 $fam = &af_inet6; # or AF_INET6 if present
625             }
626             }
627 0 0 0     0 if (! exists $if->{args}->{$fam} || # there is no such family
      0        
628 0         0 $idx < 0 || $idx > $#{$if->{args}->{$fam}->{addr}}) { # or the index is out of range
629 0 0       0 return () if wantarray; # PUNT!
630 0         0 return undef;
631             }
632              
633 0 0       0 return @{$if->{args}->{$fam}->{$k}}
  0         0  
634             if wantarray;
635 0         0 return $if->{args}->{$fam}->{$k}->[$idx];
636             }
637              
638             =item * I<-Ehwaddress([$hwaddr]);>
639              
640             Returns the binary value of the MAC address for the interface. Optionally, where
641             supported, it allows setting of the MAC address.
642              
643             i.e. $old_binmac = $if->hwaddress($new_binmac);
644             $new_binmac = $if->hwaddress();
645              
646              
647             =item * I<-Eflags([$new_flags]);>
648              
649             Get or Set (where supported) the flags on the interface.
650              
651             i.e. down an interface.
652             $flags = $if->flags();
653             $mask = ~IFF_UP;
654             $old_fg = $if->flags($flags & $mask);
655             $flags = $if->flags();
656              
657             UPDATES the if object
658              
659             NOTE: returns undef if the interface is down or not configured.
660              
661             =item * I<-Emtu([$new_mtu]);>
662              
663             Get or Set (where supported) the mtu of the interface.
664              
665             $mtu = $if->mtu();
666             $old_mtu = $if->mtu($new_mtu);
667              
668             UPDATES the if object
669              
670             NOTE: returns undef if the interface is down or not configured.
671              
672             =item * I<-Emetric([$new_metric]);>
673              
674             Get or Set (where supported) the metric for the interface.
675              
676             $metric = $if->metric();
677             $old_metric = $if->metric($new_metric);
678              
679             UPDATES the if object
680              
681             NOTE: returns undef if the interface is down or not configured.
682              
683             =item * I<-Eindex();>
684              
685             Get the interface index, not to be confused with the index number of the IP
686             assigned to a particular index.
687              
688             There is no provision to SET the index.
689              
690             $index = $if->index();
691              
692             =item * I<-Emask2cidr([$naddrmsk]);>
693              
694             =item * $cidr = mask2cidr($naddrmsk);
695              
696             Returns the CIDR (prefix length) for the netmask C<$naddrmsk>.
697              
698             When no I<$naddrmsk> is specified the method will return the first address
699             in the first family starting with AF_INET, AF_INET6, etc... This is
700             particularly useful for interfaces with only a single address assigned.
701              
702             May be called as a METHOD or a FUNCTION.
703              
704             =item * I<-Emac_bin2hex();>
705              
706             =item * $mac_txt = mac_bin2hex($bin_mac);
707              
708             Converts a binary MAC address into hex text.
709              
710             i.e. A1:B2:C3:D4:E5:F6
711              
712             May be called as a METHOD or a FUNCTION.
713              
714             =item * I<-Einfo();>
715              
716             Returns a pointer to a hash containing information about the interface as
717             follows:
718              
719             $info = {
720             name => 'eth0',
721             index => 1,
722             mtu => 1500,
723             metric => 1,
724             flags => 1234,
725             mac => binary_mac_address,
726             $fam0 => {
727             number => of_addresses,
728             size => of_address,
729             },
730             $fam1 => etc....
731             };
732              
733             where $famX is one of AF_INET, AF_INET6, etc...
734              
735             =cut
736              
737             sub info ($) {
738 0     0 1 0 my $if = shift;
739 0         0 my $name = $if->{name};
740 0         0 my ($mtu,$metric,$flags,$mac,$index) = @{$if->{args}}{qw(mtui metk flag maci indx)};
  0         0  
741              
742 0         0 my $info = {
743             name => $name,
744             mtu => $mtu,
745             metric => $metric,
746             flags => $flags,
747             mac => $mac,
748             index => $index,
749             };
750 0   0     0 my $af_inet6 = eval { &af_inet6 } || 0;
751 0         0 foreach(&af_inet,$af_inet6) {
752 0 0       0 next unless $_;
753 0 0       0 if (exists $if->{args}->{$_}) {
754 0         0 $info->{$_}->{size} = $if->{args}->{$_}->{size};
755 0         0 $info->{$_}->{number} = @{$if->{args}->{$_}->{addr}};
  0         0  
756             }
757             }
758 0         0 return $info;
759             }
760              
761             =item * I<-Etype([$naddr6]);>
762              
763             =item * $type = type($naddr6);
764              
765             B method. Returns attributes of an IPV6 address that may be tested
766             with these bit masks:
767              
768             IPV6_ADDR_ANY unknown
769             IPV6_ADDR_UNICAST unicast
770             IPV6_ADDR_MULTICAST multicast
771             IPV6_ADDR_ANYCAST anycast
772             IPV6_ADDR_LOOPBACK loopback
773             IPV6_ADDR_LINKLOCAL link-local
774             IPV6_ADDR_SITELOCAL site-local
775             IPV6_ADDR_COMPATv4 compat-v4
776             IPV6_ADDR_SCOPE_MASK scope-mask
777             IPV6_ADDR_MAPPED mapped
778             IPV6_ADDR_RESERVED reserved
779             IPV6_ADDR_ULUA uniq-lcl-unicast
780             IPV6_ADDR_6TO4 6to4
781             IPV6_ADDR_6BONE 6bone
782             IPV6_ADDR_AGU global-unicast
783             IPV6_ADDR_UNSPECIFIED unspecified
784             IPV6_ADDR_SOLICITED_NODE solicited-node
785             IPV6_ADDR_ISATAP ISATAP
786             IPV6_ADDR_PRODUCTIVE productive
787             IPV6_ADDR_6TO4_MICROSOFT 6to4-ms
788             IPV6_ADDR_TEREDO teredo
789             IPV6_ADDR_ORCHID orchid
790             IPV6_ADDR_NON_ROUTE_DOC non-routeable-doc
791              
792             i.e. if ($type & $mask) {
793             print $mask,"\n";
794             ...
795              
796             ... will print the string shown to the right of the bit mask.
797              
798             When no I<$naddr6> is specified the method will return the first AF_INET6
799             address found. This is particularly useful for interfaces with only a single
800             address assigned.
801              
802             May be called as a METHOD or a FUNCTION with an $naddr6 argument.
803              
804             =item * I<-Escope([$naddr6]);>
805              
806             =item * $scope = scope($naddr6);
807              
808             Returns the RFC-2373 scope of an IPV6 address that may be equated to these
809             constants.
810              
811             RFC2373_GLOBAL global-scope 0xE
812             RFC2373_ORGLOCAL org-local 0x8
813             RFC2373_SITELOCAL site-local 0x5
814             RFC2373_LINKLOCAL link-local 0x2
815             RFC2373_NODELOCAL loopback 0x1
816              
817             One additional constant is provided as there is an out of band
818             scope value mapped returned when determining scope. If you want B
819             RFC2373 scope only, && the return value with 0xF
820              
821             LINUX_COMPATv4 lx-compat-v4 0x10
822              
823             i.e. if ($scope = $const) {
824             print $const,"\n";
825             ...
826              
827             ... will print the string shown to the right of the constant.
828              
829             When no I<$naddr6> is specified the method will return the first AF_INET6
830             address found. This is particularly useful for interfaces with only a single
831             address assigned.
832              
833             May be called as a METHOD or a FUNCTION with an $naddr6 argument.
834              
835             =back
836              
837             =cut
838              
839             sub _family {
840 0     0   0 my $len = length($_[0]);
841 0 0       0 if ($len == 4) {
    0          
842 0         0 return &af_inet;
843             }
844             elsif ($len == 16) {
845 0         0 return &af_inet6;
846             }
847 0         0 return 0;
848             }
849              
850             =head1 FUNCTIONS
851              
852             Unless otherwise specified, errors for all methods return either B or
853             and empty array depending on the expected return context.
854              
855              
856              
857             =over 4
858              
859             =item * $naddr = inet_aton($host or $dotquad);
860              
861             Converts a hostname or dotquad ipV4 address into a packed network address.
862              
863             =cut
864              
865             # if Socket lib is broken in some way, check for overange values
866             #
867             my $overange = yinet_aton('256.1') ? 1:0;
868              
869             sub inet_aton {
870 4 50 33 4 1 1245 if (! $overange || $_[0] =~ /[^0-9\.]/) { # hostname
871 4         18 return &yinet_aton;
872             }
873 0         0 my @dq = split(/\./,$_[0]);
874 0         0 foreach (@dq) {
875 0 0       0 return undef if $_ > 255;
876             }
877 0         0 return &yinet_aton;
878             }
879              
880             =item * $dotquad = inet_ntoa($naddr);
881              
882             Convert a binary IPV4 address into a dotquad text string.
883              
884             =item * $ipV6_txt = full_inet_ntop($naddr6);
885              
886             Returns an uncompressed text string for a net6 address.
887              
888             i.e. FE80:02A0:0000:0000:0000:0000:0123:4567
889              
890             =item * $minimized = ipV6compress($ipV6_txt);
891              
892             Compress an ipV6 address to the minimum RFC-1884 format
893              
894             i.e. FE80:02A0:0000:0000:0000:0000:0123:4567
895             to FE80:2A0::123:4567
896              
897             =cut
898              
899             sub _ipv6_acommon {
900 197     197   213 my($ipv6) = @_;
901 197 100       290 return undef unless $ipv6;
902 169         486 local($1,$2,$3,$4,$5);
903 169 100       607 if ($ipv6 =~ /^(.*:)(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) { # mixed hex, dot-quad
904 1 50 33     23 return undef if $2 > 255 || $3 > 255 || $4 > 255 || $5 > 255;
      33        
      33        
905 1         9 $ipv6 = sprintf("%s%X%02X:%X%02X",$1,$2,$3,$4,$5); # convert to pure hex
906             }
907 169         121 my $c;
908             return undef if
909 169 100 100     1299 $ipv6 =~ /[^:0-9a-fA-F]/ || # non-hex character
      66        
      100        
910             (($c = $ipv6) =~ s/::/x/ && $c =~ /(?:x|:):/) || # double :: ::?
911             $ipv6 =~ /[0-9a-fA-F]{5,}/; # more than 4 digits
912 155         180 $c = $ipv6 =~ tr/:/:/; # count the colons
913 155 100 100     277 return undef if $c < 7 && $ipv6 !~ /::/;
914 153 100       195 if ($c > 7) { # strip leading or trailing ::
915             return undef unless
916 12 100 100     43 $ipv6 =~ s/^::/:/ ||
917             $ipv6 =~ s/::$/:/;
918 8 50       22 return undef if --$c > 7;
919             }
920 141         214 while ($c++ < 7) { # expand compressed fields
921 39         75 $ipv6 =~ s/::/:::/;
922             }
923 141 100       197 $ipv6 .= 0 if $ipv6 =~ /:$/;
924 141         299 return $ipv6;
925             }
926              
927             sub ipV6compress ($) {
928 72     72 1 3840 my $ipv6 = &_ipv6_acommon;
929 72 50       113 return undef unless $ipv6;
930             my $c = 'X'. join(':',map { # compression begins
931 72 100       180 if ($_ !~ /[a-fA-F1-9]/) {
  576 100       781  
932 421         493 0;
933             }
934             elsif ($_ =~ /^0+(.+)/) {
935 67         109 $1;
936             }
937             else {
938 88         114 $_;
939             }} split(/\:/,$ipv6)) .'X';
940              
941 72         265 my @stuff = ($c =~ /[X\:][0\:]+[X\:]/g);
942 72 100       116 unless (@stuff) {
943 1         2 $c =~ s/X//g;
944 1 50       6 return ($ipv6_format) ? uc $c : lc $c;
945             }
946              
947 71         62 my $max = 0;
948 71         50 my $idx = 0;
949 71         133 foreach(0..$#stuff) {
950 88         81 my $len = length($stuff[$_]);
951 88 100       146 if ($len > $max) {
952 78         50 $max = $len;
953 78         89 $idx = $_;
954             }
955             }
956 71 100       110 if ($max > 3) {
957 63         499 $c =~ s/$stuff[$idx]/::/;
958             }
959 71         126 $c =~ s/X//g;
960 71 100       212 return ($ipv6_format) ? uc $c : lc $c;
961             }
962              
963             =item * $ipV6_txt = inet_ntop($naddr6)
964              
965             Returns a minimized RFC-1884 IPV6 address
966              
967             =cut
968              
969             sub inet_ntop ($) {
970 60     60 1 1460 return (ipV6compress(full_inet_ntop($_[0])));
971             }
972              
973             =item * $naddr6 = inet_pton($ipV6_txt);
974              
975             Takes an IPv6 text address of the form described in rfc1884
976             and returns a naddr6 128 bit binary address string in network order.
977              
978             =cut
979              
980             sub inet_pton {
981 125     125 1 68806 my $ipv6 = &_ipv6_acommon;
982 125 100       179 return undef unless $ipv6;
983 69         183 my @hex = split(/:/,$ipv6);
984 69         147 foreach(0..$#hex) {
985 552   100     887 $hex[$_] = hex($hex[$_] || 0);
986             }
987 69         235 pack("n8",@hex);
988             }
989              
990             =item * $cidr = mask2cidr($naddrmsk);
991              
992             =item * I<-Emask2cidr($naddrmsk);>
993              
994             Returns the CIDR (prefix length) for the netmask C<$naddrmsk>.
995              
996             May be called as a FUNCTION or a METHOD.
997              
998             =item * $mac_txt = mac_bin2hex($bin_mac);
999              
1000             =item * I<-Emac_bin2hex();>
1001              
1002             Converts a binary MAC address into hex text.
1003              
1004             i.e. A1:B2:C3:D4:E5:F6
1005              
1006             May be called as a FUNCTION or a METHOD.
1007              
1008             =item * $type = type($naddr6);
1009              
1010             =item * I<-Etype($naddr6);>
1011              
1012             B method. Returns attributes of an IPV6 address that may be tested
1013             with the bit masks described in detail in the METHOD section above.
1014              
1015             May be called as a FUNCTION or a METHOD with an $naddr6 argument.
1016              
1017             =item * $scope = scope($naddr6);
1018              
1019             =item * I<-Escope($naddr6);>
1020              
1021             Returns the RFC-2373 scope of an IPV6 address that may be equated module
1022             constants described in detail in the METHOD section above.
1023              
1024             May be called as a FUNCTION or a METHOD with an $naddr6 argument.
1025              
1026             =item * $symbolptr = net_symbols();
1027              
1028             Returns a hash containing most of the network symbols available for this
1029             architecture.
1030              
1031             where $symbolptr = {
1032             SYMBOL_TEXT => value,
1033             ...
1034             };
1035              
1036             Most all of these symbols have both a numeric and text value. Perl does the
1037             B thing and uses the numeric value in all logic and arithmetic
1038             operations and provides the text value for print requests.
1039              
1040             To print the numeric value:
1041              
1042             print (0 + &SYMBOL),"\n";
1043              
1044             i.e. print (0 + AF_INET()),"\n";
1045              
1046             results in the digit B<2> being printed, whereas:
1047              
1048             print AF_INET,"\n";
1049              
1050             results in the string "B" being printed.
1051              
1052             NOTE: that many symbols are OS dependent. Do not use
1053             numeric values in your code, instead use the symbol.
1054              
1055             i.e. AF_INET, AF_INET6, AF_LINK, etc...
1056              
1057             =back
1058              
1059             =head1 ACKNOWLEDGEMENTS
1060              
1061             This version of Net::Interface has been completely rewritten and updated to
1062             include support for IPV6. Credit should be given to the original author
1063              
1064             Stephen Zander
1065              
1066             for conceiving the idea behind Net::Interface and to the work done by
1067              
1068             Jerrad Pierce jpierce@cpan.org
1069              
1070             on the maintenance and improvements to the original version.
1071              
1072             Thanks also go to
1073              
1074             Jens Rehsack
1075              
1076             for inspiring me to create this updated version and for his assistance in
1077             vetting the design concepts and loads of other helpful things.
1078              
1079             The following functions are used in whole or in part as include files to
1080             Interface.xs. The copyright (same as Perl itself) is include in the file.
1081              
1082             file: functions:
1083              
1084             miniSocketXS.c inet_aton, inet_ntoa
1085              
1086             inet_aton, inet_ntoa are from the perl-5.8.0 release by Larry Wall, copyright
1087             1989-2002. inet_aton, inet_ntoa code is current through perl-5.9.3 release.
1088             Thank you Larry for making PERL possible for all of us.
1089              
1090             =head1 COPYRIGHT 2008-2009 Michael Robinton
1091              
1092             All rights reserved.
1093              
1094             This program is free software; you can redistribute it and/or modify
1095             it under the terms of either:
1096              
1097             a) the GNU General Public License as published by the Free
1098             Software Foundation; either version 2, or (at your option) any
1099             later version, or
1100              
1101             b) the "Artistic License" which comes with this distribution.
1102              
1103             This program is distributed in the hope that it will be useful,
1104             but WITHOUT ANY WARRANTY; without even the implied warranty of
1105             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
1106             the GNU General Public License or the Artistic License for more details.
1107              
1108             You should have received a copy of the Artistic License with this
1109             distribution, in the file named "Artistic". If not, I'll be glad to provide one.
1110              
1111             You should also have received a copy of the GNU General Public License
1112             along with this program in the file named "Copying". If not, write to the
1113              
1114             Free Software Foundation, Inc.
1115             59 Temple Place, Suite 330
1116             Boston, MA 02111-1307, USA
1117              
1118             or visit their web page on the internet at:
1119              
1120             http://www.gnu.org/copyleft/gpl.html.
1121              
1122             =head1 SEE ALSO
1123              
1124             ifconfig(8), Net::Interface::NetSymbols,
1125             L
1126              
1127             =cut
1128              
1129             1;