|
996
|
1 package Language::INTERCAL::HostIP;
|
|
|
2
|
|
|
3 # Finds information about local network interfaces; this has been inspired
|
|
|
4 # by Sys::HostIP, but completely rewritten. I did email the author of
|
|
|
5 # Sys::HostIP offering patches which would make it more general (general
|
|
|
6 # enough for what I need) and more portable, but I never received an
|
|
|
7 # answer so I have decided to write my own version. At the same time,
|
|
|
8 # some of the extra bits of Sys::HostIP which I don't need have not
|
|
|
9 # been duplicated.
|
|
|
10
|
|
|
11 # This file is part of CLC-INTERCAL
|
|
|
12
|
|
|
13 # Copyright (c) 2007-2008 Claudio Calvelli, all rights reserved.
|
|
|
14
|
|
|
15 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
16 # and distribute it is granted provided that the conditions set out in the
|
|
|
17 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
18
|
|
|
19 use strict;
|
|
|
20 use vars qw($VERSION $PERVERSION);
|
|
|
21 ($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/HostIP.pm 1.-94.-2") =~ /\s(\S+)$/;
|
|
|
22
|
|
|
23 use Carp;
|
|
|
24 use Language::INTERCAL::Exporter '1.-94.-2';
|
|
|
25 use vars qw(@EXPORT_OK);
|
|
|
26 @EXPORT_OK = qw(find_interfaces);
|
|
|
27
|
|
|
28 sub find_interfaces {
|
|
|
29 @_ == 0 or croak "Usage: find_interfaces()";
|
|
|
30 if ($^O =~ /MSWin32|cygwin/i) {
|
|
|
31 return _find_interfaces_windows();
|
|
|
32 } else {
|
|
|
33 return _find_interfaces_unix();
|
|
|
34 }
|
|
|
35 }
|
|
|
36
|
|
|
37 sub _find_interfaces_unix {
|
|
|
38 my $ifconfig = undef;
|
|
|
39 # if the system has some form of ifconfig, assume we can use it...
|
|
|
40 for my $path (qw(/sbin /usr/sbin /etc /usr/etc), split(/:/, $ENV{PATH})) {
|
|
|
41 -f "$path/ifconfig" or next;
|
|
|
42 $ifconfig = "$path/ifconfig";
|
|
|
43 last;
|
|
|
44 }
|
|
|
45 $ifconfig or return {}; # sorry, can't do it
|
|
|
46 # try $ifconfig -a first; if that fails, try $ifconfig
|
|
|
47 my $res = _parse_unix("$ifconfig -a");
|
|
|
48 keys %$res and return $res;
|
|
|
49 _parse_unix($ifconfig);
|
|
|
50 }
|
|
|
51
|
|
|
52 sub _parse_unix {
|
|
|
53 my ($ifconfig) = @_;
|
|
|
54 open(IFCONFIG, "$ifconfig 2>&1 |") or return {};
|
|
|
55 my %res = ();
|
|
|
56 my $name = undef;
|
|
|
57 # this parses the output of both Linux' and *BSD's ifconfig
|
|
|
58 while (<IFCONFIG>) {
|
|
|
59 /^(\w+):?\s/ and $name = $1;
|
|
|
60 /\S/ or $name = undef;
|
|
|
61 defined $name or next;
|
|
|
62 /\binet(?:\s+addr)?\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i
|
|
|
63 and $res{$name}{addr} = $1;
|
|
|
64 /\bb(?:road)?cast\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i
|
|
|
65 and $res{$name}{bcast} = $1;
|
|
|
66 /\b(?:net)?mask\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i # linux mask
|
|
|
67 and $res{$name}{mask} = $1;
|
|
|
68 /\b(?:net)?mask\s*(?::\s*)?0x([[:xdigit:]]{2}) # *bsd mask
|
|
|
69 ([[:xdigit:]]{2})
|
|
|
70 ([[:xdigit:]]{2})
|
|
|
71 ([[:xdigit:]]{2})\b/ix
|
|
|
72 and $res{$name}{mask} = join('.', map { hex } $1, $2, $3, $4);
|
|
|
73 # XXX IPv6
|
|
|
74 }
|
|
|
75 close IFCONFIG;
|
|
|
76 \%res;
|
|
|
77 }
|
|
|
78
|
|
|
79 sub _find_interfaces_windows {
|
|
|
80 # XXX tested on 98 and eXtra Perverse, but not on Vista
|
|
|
81 open(IPCONFIG, 'ipconfig |') or return {};
|
|
|
82 my %res = ();
|
|
|
83 my $name = undef;
|
|
|
84 while (<IFCONFIG>) {
|
|
|
85 /^Windows .* IP Configuration/i and next;
|
|
|
86 /\S/ or next;
|
|
|
87 /^(?:Ethernet|Wireless)\s+adapter\s+(.*):/i and $name = $1;
|
|
|
88 /^(.*)\s+(?:Ethernet|Wireless)\s+adapter/i and $name = $1;
|
|
|
89 defined $name or next;
|
|
|
90 /\sIP\s+Address.*:\s+(\d+(?:\.\d+){3})/i
|
|
|
91 and $res{$name}{addr} = $1;
|
|
|
92 /\sMask.*:\s+(\d+(?:\.\d+){3})/i
|
|
|
93 and $res{$name}{mask} = $1;
|
|
|
94 /\sBroadcast.*:\s+(\d+(?:\.\d+){3})/i
|
|
|
95 and $res{$name}{bcast} = $1;
|
|
|
96 }
|
|
|
97 close IPCONFIG;
|
|
|
98 \%res;
|
|
|
99 }
|
|
|
100
|
|
|
101 1;
|
