File Coverage

blib/lib/Net/Ifconfig/Wrapper.pm
Criterion Covered Total %
statement 22 28 78.5
branch 5 10 50.0
condition 3 9 33.3
subroutine 6 7 85.7
pod 1 2 50.0
total 37 56 66.0


line stmt bran cond sub pod time code
1             package Net::Ifconfig::Wrapper;
2            
3 1     1   106317 use warnings;
  1         4  
  1         33  
4 1     1   6 use strict;
  1         2  
  1         67  
5 1     1   8 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @EXPORT_FAIL);
  1         2  
  1         230  
6            
7             $VERSION = 0.25;
8            
9             require Exporter;
10            
11             @ISA = qw(Exporter);
12             # Items to export into caller's namespace by default. Note: do not export
13             # names by default without a very good reason. Use EXPORT_OK instead.
14             # Do not simply export all your public functions/methods/constants.
15             @EXPORT = qw();
16            
17             %EXPORT_TAGS = ('Ifconfig' => [qw(Ifconfig)]);
18            
19             foreach (keys(%EXPORT_TAGS))
20             { push(@{$EXPORT_TAGS{'all'}}, @{$EXPORT_TAGS{$_}}); };
21            
22             $EXPORT_TAGS{'all'}
23             and @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
24            
25             my $DEBUG = 0;
26            
27 1     1   9 use POSIX;
  1         1  
  1         9  
28             my ($OsName, $OsVers) = (POSIX::uname())[0,2];
29            
30             my $Win32_FormatMessage = undef;
31             my %Win32API = ();
32             my %ToLoad = ('iphlpapi' => {'GetAdaptersInfo' => [['P','P'], 'N'],
33             #'GetIpAddrTable' => [['P','P','I'], 'N'],
34             'AddIPAddress' => [['N','N','N','P','P'], 'N'],
35             'DeleteIPAddress' => [['N'], 'N'],
36             },
37             );
38            
39             my $Win32_ERROR_BUFFER_OVERFLOW = undef;
40             my $Win32_ERROR_INSUFFICIENT_BUFFER = undef;
41             my $Win32_NO_ERROR = undef;
42            
43             my $ETHERNET = 'ff:ff:ff:ff:ff:ff';
44            
45             (($^O eq 'openbsd') &&
46             (`/usr/sbin/arp -a 2>&1` =~ m/(?:\A|\n).+\s+at\s+([a-f\d]{1,2}(?:\:[a-f\d]{1,2}){5})\s+static\s*(?:\n|\Z)/i))
47             and $ETHERNET = $1;
48            
49             if (($^O eq 'MSWin32') || ($^O eq 'cygwin'))
50             {
51             eval 'use Win32::API;
52             use Win32::WinError;
53            
54             Win32::IsWinNT()
55             or die "Only WinNT (from Win2K) is supported";
56            
57             $Win32_FormatMessage = sub { return Win32::FormatMessage(@_); };
58             $Win32_ERROR_BUFFER_OVERFLOW = ERROR_BUFFER_OVERFLOW;
59             $Win32_ERROR_INSUFFICIENT_BUFFER = ERROR_INSUFFICIENT_BUFFER;
60             $Win32_NO_ERROR = NO_ERROR;
61            
62             foreach my $DLib (keys(%ToLoad))
63             {
64             foreach my $Func (keys(%{$ToLoad{$DLib}}))
65             {
66             $Win32API{$DLib}{$Func} = Win32::API->new($DLib, $Func, $ToLoad{$DLib}{$Func}->[0], $ToLoad{$DLib}{$Func}->[1])
67             or die "Cannot import function \'$Func\' from \'$DLib\' DLL: $^E";
68             };
69             };
70             ';
71            
72             $@ and die $@;
73             };
74            
75             my $MAXLOGIC = 65535;
76            
77             my %Hex2Mask = ('00000000' => '0.0.0.0', '80000000' => '128.0.0.0',
78             'c0000000' => '192.0.0.0', 'e0000000' => '224.0.0.0',
79             'f0000000' => '240.0.0.0', 'f8000000' => '248.0.0.0',
80             'fc000000' => '252.0.0.0', 'fe000000' => '254.0.0.0',
81             'ff000000' => '255.0.0.0', 'ff800000' => '255.128.0.0',
82             'ffc00000' => '255.192.0.0', 'ffe00000' => '255.224.0.0',
83             'fff00000' => '255.240.0.0', 'fff80000' => '255.248.0.0',
84             'fffc0000' => '255.252.0.0', 'fffe0000' => '255.254.0.0',
85             'ffff0000' => '255.255.0.0', 'ffff8000' => '255.255.128.0',
86             'ffffc000' => '255.255.192.0', 'ffffe000' => '255.255.224.0',
87             'fffff000' => '255.255.240.0', 'fffff800' => '255.255.248.0',
88             'fffffc00' => '255.255.252.0', 'fffffe00' => '255.255.254.0',
89             'ffffff00' => '255.255.255.0', 'ffffff80' => '255.255.255.128',
90             'ffffffc0' => '255.255.255.192', 'ffffffe0' => '255.255.255.224',
91             'fffffff0' => '255.255.255.240', 'fffffff8' => '255.255.255.248',
92             'fffffffc' => '255.255.255.252', 'fffffffe' => '255.255.255.254',
93             'ffffffff' => '255.255.255.255',
94             );
95            
96             my $Inet2Logic = undef;
97             my $Logic2Inet = undef;
98            
99             my $Name2Index = undef;
100            
101             my %Ifconfig = ();
102            
103             my $RunCmd = sub($$)
104             {
105             my ($CName, $Iface, $Logic, $Addr, $Mask) = @_;
106            
107             my $Cmd = (defined($Ifconfig{$CName}{$^O}{$OsName}{$OsVers}{'ifconfig'}) ?
108             $Ifconfig{$CName}{$^O}{$OsName}{$OsVers}{'ifconfig'} :
109             $Ifconfig{$CName}{$^O}{'ifconfig'}).' 2>&1';
110            
111             $DEBUG && print STDERR "\n=== RunCmd ===\n\$CName: $CName, \$Iface: $Iface, \$Logic: $Logic, \$Addr: $Addr, \$Mask: $Mask\n";
112            
113             $Cmd =~ s{%Iface%}{$Iface}gsex;
114             $Cmd =~ s{%Logic%}{$Logic}gsex;
115             $Cmd =~ s{%Addr%}{$Addr}gsex;
116             $Cmd =~ s{%Mask%}{$Mask}gsex;
117            
118             $DEBUG && print STDERR "Cmd is ==$Cmd==\n";
119            
120             my $saveLang = $ENV{'LANG'} || '';
121             $ENV{'LANG'} = 'C';
122             my @Output = `$Cmd`;
123             $ENV{'LANG'} = $saveLang;
124            
125             $@ = "Command '$Cmd', exit code '".(defined($?) ? $? : '!UNDEFINED!')."'".join("\t", @Output);
126            
127             $? ? return : return \@Output;
128             }; # RunCmd
129            
130             my $SolarisList = sub($$$$)
131             {
132             $Inet2Logic = undef;
133             $Logic2Inet = undef;
134            
135             my $Output = &{$RunCmd}('list', '', '', '', '') or return;
136            
137             $Inet2Logic = {};
138             $Logic2Inet = {};
139            
140             my $Iface = undef;
141             my $Logic = undef;
142             my $LogUp = undef;
143             my $Info = {};
144             foreach (@{$Output})
145             {
146             if (
147             ($_ =~ m/\A([a-z]+\d+)(?:\:(\d+))?\:\s+flags=[^\<]+\<(?:\w+\,)*(up)?(?:\,\w+)*\>.*\n?\Z/io)
148             ||
149             ($_ =~ m/\A([a-z]+\d+)(?:\:(\d+))?\:\s+flags=[^\<]+\<(?:\w+(?:\,\w+)*)*\>.*\n?\Z/io)
150             )
151             {
152             $Iface = $1;
153             $Logic = defined($2) ? $2 : '';
154             $LogUp = 1 && $3;
155             #$Info->{$Iface}{'status'} = ($Info->{$Iface}{'status'} || $LogUp) ? 1 : 0;
156             $Info->{$Iface}{'status'} = $Info->{$Iface}{'status'} || $LogUp;
157             }
158             elsif (!$Iface)
159             {
160             next;
161             }
162             elsif (
163             ($_ =~ m/\A\s+inet\s+(\d{1,3}(?:\.\d{1,3}){3})\s+netmask\s+(?:0x)?([a-f\d]{8})(?:\s.*)?\n?\Z/io)
164             ||
165             0
166             )
167             {
168             $LogUp
169             and $Info->{$Iface}{'inet'}{$1} = $Hex2Mask{$2};
170             $Inet2Logic->{$Iface}{$1} = $Logic;
171             $Logic2Inet->{$Iface}{$Logic} = $1;
172             }
173             elsif (($_ =~ m/\A\s+media\:?\s+(ethernet.*)\s*\n?\Z/io) && !$Info->{$Iface}{'ether'})
174             {
175             $Info->{$Iface}{'ether'} = $ETHERNET;
176             if (!$Info->{$Iface}{'media'})
177             {$Info->{$Iface}{'media'} = $1; };
178             }
179             elsif (($_ =~ m/\A\s+supported\s+media\:?\s+(.*)\s*\n?\Z/io) && !$Info->{$Iface}{'media'})
180             {
181             $Info->{$Iface}{'media'} = $1;
182             }
183             elsif ($_ =~ m/\A\s+ether\s+([a-f\d]{1,2}(?:\:[a-f\d]{1,2}){5})(?:\s.*)?\n?\Z/io)
184             {
185             $Info->{$Iface}{'ether'} = $1;
186             };
187             };
188             return $Info;
189             }; # SolarisList
190            
191             my $LinuxList = sub($$$$)
192             {
193             # warn " DDD start sub LinuxList...\n";
194             $Inet2Logic = undef;
195             $Logic2Inet = undef;
196            
197             my $Output = &{$RunCmd}('list', '', '', '', '')
198             or return;
199            
200             $Inet2Logic = {};
201             $Logic2Inet = {};
202            
203             my $Iface = undef;
204             my $Logic = undef;
205             my $Info = {};
206             foreach (@{$Output})
207             {
208             $DEBUG && warn " DDD looking at line of Output=$_";
209             if (
210             ($_ =~ m/\A([a-z0-9]+)(?:\:(\d+))?\s+link\s+encap\:(?:ethernet\s+hwaddr\s+([a-f\d]{1,2}(?:\:[a-f\d]{1,2}){5}))?.*\n?\Z/io)
211             ||
212             # German locale de_DE.UTF-8
213             ($_ =~ m/\A([a-z0-9]+)(?:\:(\d+))?\s+Link\s+encap\:(?:Ethernet\s+Hardware\s+Adresse\s+([a-f\d]{1,2}(?:\:[a-f\d]{1,2}){5}))?.*\n?\Z/io)
214             ||
215             # /sbin/ip on some linux systems:
216             ($_ =~ m/link\/ether\s+([a-f\d]{1,2}(?:\:[a-f\d]{1,2}){5})\s/io)
217             )
218             {
219             $Iface = $1;
220             $Logic = defined($2) ? $2 : '';
221             defined($3)
222             and $Info->{$Iface}{'ether'} = $3;
223             $Info->{$Iface}{'status'} = 0;
224             }
225             elsif (
226             ($_ =~ m/\A([a-z0-9]+)(?:\:(\d+))?\:\s+flags=\d+<(\w+(?:,\w+)*)*>.*\n?\Z/io)
227             )
228             {
229             $Iface = $1;
230             $Logic = defined($2) ? $2 : '';
231             my $sFlags = $3;
232             $DEBUG && warn " DDD matched 'flags' line, Iface=$Iface, sFlags=$sFlags\n";
233             $Info->{$Iface}{'status'} = 1 if ($sFlags =~ m/\bUP\b/);
234             }
235             elsif (!$Iface)
236             {
237             next;
238             }
239             elsif (
240             # RHEL 6 et alia:
241             ($_ =~ m/\A\s+inet\s+addr\:(\d{1,3}(?:\.\d{1,3}){3})\s+(?:.*\s)?mask\:(\d{1,3}(?:\.\d{1,3}){3}).*\n?\Z/io)
242             ||
243             # RHEL 7 et alia:
244             ($_ =~ m/\A\s+inet\s+(\d{1,3}(?:\.\d{1,3}){3})\s+netmask\s+(\d{1,3}(?:\.\d{1,3}){3})(?:\s.*)?\n?\Z/io)
245             ||
246             # German locale de_DE.UTF-8
247             ($_ =~ m/\A\s+inet\s+Adresse\:(\d{1,3}(?:\.\d{1,3}){3})\s+(?:.*\s)?Maske\:(\d{1,3}(?:\.\d{1,3}){3}).*\n?\Z/io)
248             ||
249             ($_ =~ m/\sinet\s+(\d{1,3}(?:\.\d{1,3}){3})\/(\d+)\s/io)
250             )
251             {
252             my $sIP = $1;
253             my $sNetmask = $2;
254             $DEBUG && warn " DDD matched 'netmask' line, sIP=$sIP, sNetmask=$sNetmask\n";
255             if ($sNetmask =~ m/\A\d+\z/)
256             {
257             # The netmask appeared as a slash/number at the end of the IP
258             # address; convert it to an IP "address" quad string:
259 1     1   5555 use Net::Netmask;
  1         202614  
  1         3501  
260             my $block = new Net::Netmask("$sIP/$sNetmask");
261             $sNetmask = $block->mask();
262             } # if
263             $Info->{$Iface}{'inet'}{$sIP} = $sNetmask;
264             $Inet2Logic->{$Iface}{$sIP} = $Logic;
265             $Logic2Inet->{$Iface}{$Logic} = $sIP;
266             }
267             elsif ($_ =~ m/\A\s+ether\s+([a-f0-9]{1,2}(?:\:[a-f0-9]{1,2}){5})(?:\s|\n|\Z)/io)
268             {
269             $Info->{$Iface}{'ether'} = $1;
270             }
271             elsif ($_ =~ m/\A\s+up(?:\s+[^\s]+)*\s*\n?\Z/io)
272             {
273             $DEBUG && warn " DDD matched 'up' line\n";
274             $Info->{$Iface}{'status'} = 1;
275             };
276             };
277            
278             return $Info;
279             }; # LinuxList
280            
281             # 64-bit Windows support added by Laurent Aml: use 'Q' for pointers,
282             # and align to 8 bytes.
283             my ($LQ, @pad) = (length(pack('P')) == 4) ? ('L') : ('Q', '_pad' => 'L');
284             my $st_IP_ADDR_STRING =
285             ['Next' => $LQ, #struct _IP_ADDR_STRING*
286             'IpAddress' => 'a16', #IP_ADDRESS_STRING
287             'IpMask' => 'a16', #IP_MASK_STRING
288             'Context' => 'L', #DWORD
289             @pad,
290             ];
291            
292             my $MAX_ADAPTER_NAME_LENGTH = 256;
293             my $MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
294             my $MAX_ADAPTER_ADDRESS_LENGTH = 8;
295            
296             my $st_IP_ADAPTER_INFO =
297             ['Next' => $LQ, #struct _IP_ADAPTER_INFO*
298             'ComboIndex' => 'L', #DWORD
299             'AdapterName' => 'a'.($MAX_ADAPTER_NAME_LENGTH+4), #char[MAX_ADAPTER_NAME_LENGTH + 4]
300             'Description' => 'a'.($MAX_ADAPTER_DESCRIPTION_LENGTH+4), #char[MAX_ADAPTER_DESCRIPTION_LENGTH + 4]
301             'AddressLength' => 'L', #UINT
302             'Address' => 'a'.$MAX_ADAPTER_ADDRESS_LENGTH, #BYTE[MAX_ADAPTER_ADDRESS_LENGTH]
303             'Index' => 'L', #DWORD
304             'Type' => 'L', #UINT
305             'DhcpEnabled' => 'L', #UINT
306             @pad,
307             'CurrentIpAddress' => $LQ, #PIP_ADDR_STRING
308             'IpAddressList' => $st_IP_ADDR_STRING, #IP_ADDR_STRING
309             'GatewayList' => $st_IP_ADDR_STRING, #IP_ADDR_STRING
310             'DhcpServer' => $st_IP_ADDR_STRING, #IP_ADDR_STRING
311             'HaveWins' => 'L', #BOOL
312             @pad,
313             'PrimaryWinsServer' => $st_IP_ADDR_STRING, #IP_ADDR_STRING
314             'SecondaryWinsServer' => $st_IP_ADDR_STRING, #IP_ADDR_STRING
315             'LeaseObtained' => $LQ, #time_t
316             'LeaseExpires' => $LQ, #time_t
317             ];
318            
319             #my $st_MIB_IPADDRROW =
320             # ['dwAddr' => 'L', #DWORD
321             # 'dwIndex' => 'L', #DWORD
322             # 'dwMask' => 'L', #DWORD
323             # 'dwBCastAddr' => 'L', #DWORD
324             # 'dwReasmSize' => 'L', #DWORD
325             # 'unused1' => 'S', #unsigned short
326             # 'unused2' => 'S', #unsigned short
327             # ];
328            
329             my %UnpackStrCache = ();
330             my $UnpackStr = undef;
331             $UnpackStr = sub($$)
332             {
333             my ($Struct, $Repeat) = @_;
334             $Repeat or $Repeat = 1;
335            
336             my $StructUpStr = '';
337            
338             if (!defined($UnpackStrCache{$Struct}))
339             {
340             for (my $RI = 1; defined($Struct->[$RI]); $RI += 2)
341             {
342             $StructUpStr .= ref($Struct->[$RI]) ?
343             &{$UnpackStr}($Struct->[$RI], 1) :
344             $Struct->[$RI];
345             };
346             $UnpackStrCache{$Struct} = $StructUpStr;
347             }
348             else
349             { $StructUpStr = $UnpackStrCache{$Struct}; };
350            
351             my $UpStr = '';
352             for (; $Repeat > 0; $Repeat--)
353             { $UpStr .= $StructUpStr; };
354            
355             return $UpStr;
356             }; # $Unpackstr
357            
358            
359             my $ShiftStruct = undef;
360             $ShiftStruct = sub($$)
361             {
362             my ($Array, $Struct) = @_;
363            
364             my $Result = {};
365             #tie(%{$Result}, 'Tie::IxHash');
366            
367             for (my $RI = 0; defined($Struct->[$RI]); $RI += 2)
368             {
369             $Result->{$Struct->[$RI]} = ref($Struct->[$RI+1]) ?
370             &{$ShiftStruct}($Array, $Struct->[$RI+1]) :
371             shift(@{$Array});
372             };
373             return $Result;
374             };
375            
376             my $UnpackStruct = sub($$)
377             {
378             my ($pBuff, $Struct) = @_;
379            
380             my $UpStr = &{$UnpackStr}($Struct);
381            
382             my @Array = unpack($UpStr, ${$pBuff});
383            
384             substr(${$pBuff}, 0, length(pack($UpStr)), '');
385            
386             return &{$ShiftStruct}(\@Array, $Struct);
387             };
388            
389            
390             my $if_hwaddr = sub($$)
391             {
392             my($len, $addr) = @_;
393             return join(':', map {sprintf '%02x', $_ } unpack('C' x $len, $addr));
394             };
395            
396             sub if_ipaddr {
397 0     0 0 0 my ($addr) = @_;
398 0         0 return join(".", unpack("C4", pack("L", $addr)));
399             };
400            
401             my $Win32List = sub($$$$)
402             {
403             $Inet2Logic = undef;
404             $Logic2Inet = undef;
405             $Name2Index = undef;
406            
407             my $Buff = '';
408             my $BuffLen = pack('L', 0);
409            
410             my $Res = $Win32API{'iphlpapi'}{'GetAdaptersInfo'}->Call(0, $BuffLen);
411            
412             while ($Res == $Win32_ERROR_BUFFER_OVERFLOW)
413             {
414             $Buff = "\0" x unpack("L", $BuffLen);
415             $Res = $Win32API{'iphlpapi'}{'GetAdaptersInfo'}->Call($Buff, $BuffLen);
416             } # while
417            
418             if ($Res != $Win32_NO_ERROR)
419             {
420             $! = $Res;
421             $@ = "Error running 'GetAdaptersInfo' function: ".&{$Win32_FormatMessage}($Res);
422             return;
423             } # if
424            
425             my $Info = {};
426            
427             $Inet2Logic = {};
428             $Logic2Inet = {};
429             $Name2Index = {};
430            
431             while (1)
432             {
433             my $ADAPTER_INFO = &{$UnpackStruct}(\$Buff, $st_IP_ADAPTER_INFO);
434            
435             foreach my $Field ('AdapterName', 'Description')
436             { $ADAPTER_INFO->{$Field} =~ s/\x00+\Z//o; };
437            
438             foreach my $AddrField ('IpAddressList', 'GatewayList', 'DhcpServer', 'PrimaryWinsServer', 'SecondaryWinsServer')
439             {
440             foreach my $Field ('IpAddress', 'IpMask')
441             { $ADAPTER_INFO->{$AddrField}{$Field} =~ s/\x00+\Z//o; };
442             };
443            
444            
445             $ADAPTER_INFO->{'Address'} = &{$if_hwaddr}($ADAPTER_INFO->{'AddressLength'}, $ADAPTER_INFO->{'Address'});
446            
447             foreach my $IpList ('IpAddressList', 'GatewayList')
448             {
449             my $ADDR_STRING = $ADAPTER_INFO->{$IpList};
450             $ADAPTER_INFO->{$IpList} = [$ADDR_STRING,];
451             while ($ADDR_STRING->{'Next'})
452             {
453             $ADDR_STRING = &{$UnpackStruct}(\$Buff, $st_IP_ADDR_STRING);
454             foreach my $Field ('IpAddress', 'IpMask')
455             {
456             $ADDR_STRING->{$Field} =~ s/\x00+\Z//o;
457             } # foreach
458             push(@{$ADAPTER_INFO->{$IpList}}, $ADDR_STRING);
459             } # while
460             } # foreach
461            
462             my $Iface = $ADAPTER_INFO->{'AdapterName'};
463            
464             $Info->{$Iface}{'descr'} = $ADAPTER_INFO->{'Description'};
465             $Info->{$Iface}{'ether'} = $ADAPTER_INFO->{'Address'};
466             $Info->{$Iface}{'status'} = 1;
467            
468             foreach my $Addr (@{$ADAPTER_INFO->{'IpAddressList'}})
469             {
470             ($Addr->{'IpAddress'} eq '0.0.0.0')
471             and next;
472             $Info->{$Iface}{'inet'}{$Addr->{'IpAddress'}} = $Addr->{'IpMask'};
473             $Inet2Logic->{$Iface}{$Addr->{'IpAddress'}} = $Addr->{'Context'};
474             $Logic2Inet->{$Iface}{$Addr->{'Context'}} = $Addr->{'IpAddress'};
475             } # foreach
476            
477             $Name2Index->{$Iface} = $ADAPTER_INFO->{'Index'};
478            
479             $ADAPTER_INFO->{'Next'}
480             or last;
481             } # while
482            
483            
484             #$Buff = '';
485             #$BuffLen = pack('L', 0);
486             #$Res = $Win32API{'iphlpapi'}{'GetIpAddrTable'}->Call($Buff, $BuffLen, 0);
487             #
488             #while ($Res == ERROR_INSUFFICIENT_BUFFER)
489             # {
490             # $Buff = "\0" x unpack("L", $BuffLen);
491             # $Res = $Win32API{'iphlpapi'}{'GetIpAddrTable'}->Call($Buff, $BuffLen, 0);
492             # };
493             #
494             #if ($Res != $Win32_NO_ERROR)
495             # {
496             # $! = $Res;
497             # $@ = "Error running 'GetIpAddrTable' function: ".&{$Win32_FormatMessage}($Res);
498             # return;
499             # };
500             #
501             #my $IpAddrTable = &{$UnpackStruct}(\$Buff, ['Len' => 'L']);
502             #my %Info1 = ();
503             #for (; $IpAddrTable->{'Len'} > 0; $IpAddrTable->{'Len'}--)
504             # {
505             # my $IPADDRROW = &{$UnpackStruct}(\$Buff, $st_MIB_IPADDRROW);
506             # $Info->{$IPADDRROW->{'dwIndex'}}
507             # and next;
508             # $Info1{$IPADDRROW->{'dwIndex'}}{'inet'}{if_ipaddr($IPADDRROW->{'dwAddr'})} = if_ipaddr($IPADDRROW->{'dwMask'});
509             # };
510             #
511             #foreach my $Iface (keys(%Info1))
512             # { $Info->{$Iface} = $Info1{$Iface}; };
513            
514             return wantarray ? %{$Info} : $Info;
515             }; # Win32List
516            
517            
518             my $IFCONFIG = '/sbin/ifconfig';
519             my $IP = '/sbin/ip';
520            
521             $Ifconfig{'list'} = {'solaris' => {'ifconfig' => qq/LC_ALL=C $IFCONFIG -a/,
522             'function' => $SolarisList},
523             'openbsd' => {'ifconfig' => qq/LC_ALL=C $IFCONFIG -A/,
524             'function' => $SolarisList},
525             'linux' => {'ifconfig' => -f $IFCONFIG ? qq/LC_ALL=C $IFCONFIG -a/ : qq/LC_ALL=C $IP address/,
526             'function' => $LinuxList},
527             'MSWin32' => {'ifconfig' => '',
528             'function' => $Win32List,},
529             };
530            
531             $Ifconfig{'list'}{'freebsd'} = $Ifconfig{'list'}{'solaris'};
532             $Ifconfig{'list'}{'darwin'} = $Ifconfig{'list'}{'solaris'};
533             $Ifconfig{'list'}{'cygwin'} = $Ifconfig{'list'}{'MSWin32'};
534            
535            
536             my $UpDown = sub($$$$)
537             {
538             my ($CName, $Iface, $Addr, $Mask) = @_;
539            
540             if (!(defined($Iface) && defined($Addr) && defined($Mask)))
541             {
542             $@ = "Command '$CName': interface, inet address and netmask have to be defined";
543             return;
544             };
545            
546             my $Output = &{$RunCmd}($CName, $Iface, '', $Addr, $Mask);
547            
548             $Inet2Logic = undef;
549             $Logic2Inet = undef;
550            
551             $Output ? return $Output : return;
552             }; # $UpDown
553            
554             my $UpDownNewLog = sub($$$$)
555             {
556             my ($CName, $Iface, $Addr, $Mask) = @_;
557            
558             if (!(defined($Iface) && defined($Addr) && defined($Mask)))
559             {
560             $@ = "Command '$CName': interface, inet address and netmask have to be defined";
561             return;
562             };
563            
564             defined($Inet2Logic)
565             or (defined($Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}) ?
566             &{$Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}}() :
567             &{$Ifconfig{'list'}{$^O}{'function'}}())
568             or return;
569            
570             my $Logic = $Inet2Logic->{$Iface}{$Addr};
571            
572             my $RunIndex = 1;
573             for(; !defined($Logic); $RunIndex++)
574             {
575             if ($RunIndex > $MAXLOGIC)
576             {
577             $@ = "Command '$CName': maximum number of logic interfaces ($MAXLOGIC) on interface '$Iface' exceeded";
578             return;
579             };
580             defined($Logic2Inet->{$Iface}{$RunIndex})
581             or $Logic = $RunIndex;
582             };
583            
584             my $Output = &{$RunCmd}($CName, $Iface, $Logic, $Addr, $Mask);
585            
586             $Inet2Logic = undef;
587             $Logic2Inet = undef;
588            
589             $Output ? return $Output : return;
590             }; # $UpDownNewLog
591            
592             my $UpDownReqLog = sub($$$$)
593             {
594             my ($CName, $Iface, $Addr, $Mask) = @_;
595            
596             if (!(defined($Iface) && defined($Addr) && defined($Mask)))
597             {
598             $@ = "Command '$CName': interface, inet address and netmask have to be defined";
599             return;
600             };
601            
602             defined($Inet2Logic)
603             or (defined($Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}) ?
604             &{$Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}}() :
605             &{$Ifconfig{'list'}{$^O}{'function'}}())
606             or return;
607            
608             my $Logic = $Inet2Logic->{$Iface}{$Addr};
609            
610             if (!defined($Logic))
611             {
612             $@ = "Command '$CName': can not get logic interface for interface '$Iface', inet address '$Addr'";
613             return;
614             };
615            
616             my $Output = &{$RunCmd}($CName, $Iface, $Logic, $Addr, $Mask);
617            
618             $Inet2Logic = undef;
619             $Logic2Inet = undef;
620            
621             $Output ? return $Output : return;
622             }; # $UpDownReqLog
623            
624             #my $Win32UpDown = sub($$)
625             # {
626             # my ($Iface, $State) = @_;
627             #
628             #
629             # };
630             #
631             #my $Win32Inet = sub($$$$)
632             # {
633             # my ($CName, $Iface, $Addr, $Mask) = @_;
634             #
635             #
636             # if (!(defined($Iface) && defined($Addr) && defined($Mask)))
637             # {
638             # $@ = "Command '$CName': interface, inet address and netmask have to be defined";
639             # return;
640             # };
641             #
642             # $Win32Up($Iface)
643             # or return;
644             #
645             # $Win32AddIP($Iface, $Addr, $Mask)
646             # or return;
647             # my $Output = &{$RunCmd}('inet', '$Iface', '', '$Addr', '$Mask');
648             #
649             # $Inet2Logic = undef;
650             # $Logic2Inet = undef;
651             #
652             # $Output ? return $Output : return;
653             # };
654            
655            
656             my $PackIP = sub($)
657             {
658             my @Bytes = split('\.', $_[0]);
659             return unpack("L", pack('C4', @Bytes));
660             };
661            
662             my $Win32AddAlias = sub($$$$)
663             {
664             my ($CName, $Iface, $Addr, $Mask) = @_;
665            
666             if (!(defined($Iface) && defined($Addr) && defined($Mask)))
667             {
668             $@ = "Command '$CName': interface, inet address and netmask have to be defined";
669             return;
670             };
671            
672             defined($Inet2Logic)
673             or (defined($Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}) ?
674             &{$Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}}() :
675             &{$Ifconfig{'list'}{$^O}{'function'}}())
676             or return;
677            
678             my $NTEContext = pack('L', 0);
679             my $NTEInstance = pack('L', 0);
680            
681             my $Index = $Name2Index->{$Iface};
682            
683             if (!defined($Index))
684             {
685             $@ = "Command '$CName': can not get interface index for interface '$Iface'";
686             return;
687             };
688            
689             my $Res = $Win32API{'iphlpapi'}{'AddIPAddress'}->Call(&{$PackIP}($Addr), &{$PackIP}($Mask), $Index, $NTEContext, $NTEInstance);
690            
691             if ($Res != $Win32_NO_ERROR)
692             {
693             $! = $Res;
694             $@ = &{$Win32_FormatMessage}($Res)
695             or $@ = 'Unknown error :(';
696             return;
697             };
698            
699             $Inet2Logic = undef;
700             $Logic2Inet = undef;
701            
702             return ['Command completed successfully'];
703             };
704            
705             my $Win32RemAlias = sub($$$$)
706             {
707             my ($CName, $Iface, $Addr, $Mask) = @_;
708            
709             if (!(defined($Iface) && defined($Addr) && defined($Mask)))
710             {
711             $@ = "Command '$CName': interface, inet address and netmask have to be defined";
712             return;
713             };
714            
715             defined($Inet2Logic)
716             or (defined($Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}) ?
717             &{$Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}}() :
718             &{$Ifconfig{'list'}{$^O}{'function'}}())
719             or return;
720            
721             my $Logic = $Inet2Logic->{$Iface}{$Addr};
722            
723             if (!defined($Logic))
724             {
725             $@ = "Command '$CName': can not get logic interface for interface '$Iface', inet address '$Addr'";
726             return;
727             };
728            
729             my $Res = $Win32API{'iphlpapi'}{'DeleteIPAddress'}->Call($Logic);
730            
731             if ($Res != $Win32_NO_ERROR)
732             {
733             $! = $Res;
734             $@ = &{$Win32_FormatMessage}($Res);
735             return;
736             };
737            
738             $Inet2Logic = undef;
739             $Logic2Inet = undef;
740            
741             return ['Command completed successfully'];
742             };
743            
744            
745             $Ifconfig{'inet'} = {'solaris' => {'ifconfig' => $IFCONFIG .' %Iface% inet %Addr% netmask %Mask% up',
746             'function' => $UpDown},
747             # 'MSWin32' => {'ifconfig' => '',
748             # 'function' => $Win32Inet,},
749             };
750             $Ifconfig{'inet'}{'freebsd'} = $Ifconfig{'inet'}{'solaris'};
751             $Ifconfig{'inet'}{'openbsd'} = $Ifconfig{'inet'}{'solaris'};
752             $Ifconfig{'inet'}{'linux'} = $Ifconfig{'inet'}{'solaris'};
753             $Ifconfig{'inet'}{'darwin'} = $Ifconfig{'inet'}{'solaris'};
754            
755             $Ifconfig{'up'} = $Ifconfig{'inet'};
756            
757             $Ifconfig{'down'}{'solaris'} = {'ifconfig' => $IFCONFIG .' %Iface% down',
758             'function' => $UpDown,
759             };
760             $Ifconfig{'down'}{'freebsd'} = $Ifconfig{'down'}{'solaris'};
761             $Ifconfig{'down'}{'openbsd'} = $Ifconfig{'down'}{'solaris'};
762             $Ifconfig{'down'}{'linux'} = $Ifconfig{'down'}{'solaris'};
763             $Ifconfig{'down'}{'darwin'} = $Ifconfig{'down'}{'solaris'};
764            
765             $Ifconfig{'+alias'} = {'freebsd' => {'ifconfig' => $IFCONFIG .' %Iface% inet %Addr% netmask %Mask% alias',
766             'function' => $UpDown},
767             'solaris' => {'ifconfig' => $IFCONFIG .' %Iface%:%Logic% inet %Addr% netmask %Mask% up',
768             'function' => $UpDownNewLog},
769             'MSWin32' => {'ifconfig' => '',
770             'function' => $Win32AddAlias,},
771             };
772             $Ifconfig{'+alias'}{'openbsd'} = $Ifconfig{'+alias'}{'freebsd'};
773             $Ifconfig{'+alias'}{'linux'} = $Ifconfig{'+alias'}{'solaris'};
774             $Ifconfig{'+alias'}{'darwin'} = $Ifconfig{'+alias'}{'freebsd'};
775            
776             $Ifconfig{'+alias'}{'solaris'}{'SunOS'}{'5.8'}{'ifconfig'} = $IFCONFIG .' %Iface%:%Logic% plumb; '. $IFCONFIG .' %Iface%:%Logic% inet %Addr% netmask %Mask% up';
777             $Ifconfig{'+alias'}{'solaris'}{'SunOS'}{'5.9'}{'ifconfig'} = $Ifconfig{'+alias'}{'solaris'}{'SunOS'}{'5.8'}{'ifconfig'};
778             $Ifconfig{'+alias'}{'solaris'}{'SunOS'}{'5.10'}{'ifconfig'} = $Ifconfig{'+alias'}{'solaris'}{'SunOS'}{'5.8'}{'ifconfig'};
779            
780             $Ifconfig{'alias'} = $Ifconfig{'+alias'};
781            
782            
783             $Ifconfig{'-alias'} = {'freebsd' => {'ifconfig' => $IFCONFIG .' %Iface% inet %Addr% -alias',
784             'function' => $UpDown},
785             'solaris' => {'ifconfig' => $IFCONFIG .' %Iface%:%Logic% down',
786             'function' => $UpDownReqLog},
787             'MSWin32' => {'ifconfig' => '',
788             'function' => $Win32RemAlias,},
789             };
790             $Ifconfig{'-alias'}{'openbsd'} = $Ifconfig{'-alias'}{'freebsd'};
791             $Ifconfig{'-alias'}{'linux'} = $Ifconfig{'-alias'}{'solaris'};
792             $Ifconfig{'-alias'}{'darwin'} = $Ifconfig{'-alias'}{'freebsd'};
793            
794             $Ifconfig{'-alias'}{'solaris'}{'SunOS'}{'5.9'}{'ifconfig'} = $IFCONFIG .' %Iface%:%Logic% unplumb';
795            
796             sub Ifconfig {
797 1     1 1 120 my ($CName, $Iface, $Addr, $Mask) = @_;
798 1 50 33     16 if (!($CName && $Ifconfig{$CName} && $Ifconfig{$CName}{$^O}))
      33        
799             {
800 0         0 $@ = "Command '$CName' is not defined for system '$^O'";
801 0         0 return;
802             };
803            
804             defined($Inet2Logic)
805             or (defined($Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}) ?
806 0         0 &{$Ifconfig{'list'}{$^O}{$OsName}{$OsVers}{'function'}}() :
807 1 50 33     11 &{$Ifconfig{'list'}{$^O}{'function'}}())
  1 50       5  
808             or return;
809            
810             my $Output = (defined($Ifconfig{$CName}{$^O}{$OsName}{$OsVers}{'function'}) ?
811 0         0 &{$Ifconfig{$CName}{$^O}{$OsName}{$OsVers}{'function'}}($CName, $Iface, $Addr, $Mask) :
812 1 50       16 &{$Ifconfig{$CName}{$^O}{'function'}}($CName, $Iface, $Addr, $Mask));
  1         33  
813            
814 1 50       32 $Output ? return $Output : return;
815             }
816            
817             1;
818            
819             __END__