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;