Mercurial > repo
view interps/clc-intercal/CLC-INTERCAL-INET-1.-94.-2/INTERCAL/HostIP.pm @ 9707:e5fd34d2adcc
<shachaf> rm bin/re-ss
author | HackBot |
---|---|
date | Thu, 17 Nov 2016 17:06:57 +0000 |
parents | 859f9b4339e6 |
children |
line wrap: on
line source
package Language::INTERCAL::HostIP; # Finds information about local network interfaces; this has been inspired # by Sys::HostIP, but completely rewritten. I did email the author of # Sys::HostIP offering patches which would make it more general (general # enough for what I need) and more portable, but I never received an # answer so I have decided to write my own version. At the same time, # some of the extra bits of Sys::HostIP which I don't need have not # been duplicated. # This file is part of CLC-INTERCAL # Copyright (c) 2007-2008 Claudio Calvelli, all rights reserved. # CLC-INTERCAL is copyrighted software. However, permission to use, modify, # and distribute it is granted provided that the conditions set out in the # licence agreement are met. See files README and COPYING in the distribution. use strict; use vars qw($VERSION $PERVERSION); ($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/HostIP.pm 1.-94.-2") =~ /\s(\S+)$/; use Carp; use Language::INTERCAL::Exporter '1.-94.-2'; use vars qw(@EXPORT_OK); @EXPORT_OK = qw(find_interfaces); sub find_interfaces { @_ == 0 or croak "Usage: find_interfaces()"; if ($^O =~ /MSWin32|cygwin/i) { return _find_interfaces_windows(); } else { return _find_interfaces_unix(); } } sub _find_interfaces_unix { my $ifconfig = undef; # if the system has some form of ifconfig, assume we can use it... for my $path (qw(/sbin /usr/sbin /etc /usr/etc), split(/:/, $ENV{PATH})) { -f "$path/ifconfig" or next; $ifconfig = "$path/ifconfig"; last; } $ifconfig or return {}; # sorry, can't do it # try $ifconfig -a first; if that fails, try $ifconfig my $res = _parse_unix("$ifconfig -a"); keys %$res and return $res; _parse_unix($ifconfig); } sub _parse_unix { my ($ifconfig) = @_; open(IFCONFIG, "$ifconfig 2>&1 |") or return {}; my %res = (); my $name = undef; # this parses the output of both Linux' and *BSD's ifconfig while (<IFCONFIG>) { /^(\w+):?\s/ and $name = $1; /\S/ or $name = undef; defined $name or next; /\binet(?:\s+addr)?\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i and $res{$name}{addr} = $1; /\bb(?:road)?cast\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i and $res{$name}{bcast} = $1; /\b(?:net)?mask\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i # linux mask and $res{$name}{mask} = $1; /\b(?:net)?mask\s*(?::\s*)?0x([[:xdigit:]]{2}) # *bsd mask ([[:xdigit:]]{2}) ([[:xdigit:]]{2}) ([[:xdigit:]]{2})\b/ix and $res{$name}{mask} = join('.', map { hex } $1, $2, $3, $4); # XXX IPv6 } close IFCONFIG; \%res; } sub _find_interfaces_windows { # XXX tested on 98 and eXtra Perverse, but not on Vista open(IPCONFIG, 'ipconfig |') or return {}; my %res = (); my $name = undef; while (<IFCONFIG>) { /^Windows .* IP Configuration/i and next; /\S/ or next; /^(?:Ethernet|Wireless)\s+adapter\s+(.*):/i and $name = $1; /^(.*)\s+(?:Ethernet|Wireless)\s+adapter/i and $name = $1; defined $name or next; /\sIP\s+Address.*:\s+(\d+(?:\.\d+){3})/i and $res{$name}{addr} = $1; /\sMask.*:\s+(\d+(?:\.\d+){3})/i and $res{$name}{mask} = $1; /\sBroadcast.*:\s+(\d+(?:\.\d+){3})/i and $res{$name}{bcast} = $1; } close IPCONFIG; \%res; } 1;