[ipfire-2.x.git] / config / cfgroot / network-functions.pl

#!/usr/bin/perl -w
############################################################################
#                                                                          #
# This file is part of the IPFire Firewall.                                #
#                                                                          #
# IPFire is free software; you can redistribute it and/or modify           #
# it under the terms of the GNU General Public License as published by     #
# the Free Software Foundation; either version 2 of the License, or        #
# (at your option) any later version.                                      #
#                                                                          #
# IPFire is distributed in the hope that it will be useful,                #
# but WITHOUT ANY WARRANTY; without even the implied warranty of           #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            #
# GNU General Public License for more details.                             #
#                                                                          #
# You should have received a copy of the GNU General Public License        #
# along with IPFire; if not, write to the Free Software                    #
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA #
#                                                                          #
# Copyright (C) 2014 IPFire Team <info@ipfire.org>.                        #
#                                                                          #
############################################################################

package Network;

require "/var/ipfire/general-functions.pl";

use experimental 'smartmatch';
use Socket;

# System ethernet configuration
our %ethernet_settings = ();
&General::readhash("${General::swroot}/ethernet/settings", \%ethernet_settings);

# List of all possible network zones that can be configured
our @known_network_zones = ("red", "green", "orange", "blue");

# IPv4 netmask CIDR to dotted decimal notation conversion table
my %PREFIX2NETMASK = (
	32 => "255.255.255.255",
	31 => "255.255.255.254",
	30 => "255.255.255.252",
	29 => "255.255.255.248",
	28 => "255.255.255.240",
	27 => "255.255.255.224",
	26 => "255.255.255.192",
	25 => "255.255.255.128",
	24 => "255.255.255.0",
	23 => "255.255.254.0",
	22 => "255.255.252.0",
	21 => "255.255.248.0",
	20 => "255.255.240.0",
	19 => "255.255.224.0",
	18 => "255.255.192.0",
	17 => "255.255.128.0",
	16 => "255.255.0.0",
	15 => "255.254.0.0",
	14 => "255.252.0.0",
	13 => "255.248.0.0",
	12 => "255.240.0.0",
	11 => "255.224.0.0",
	10 => "255.192.0.0",
	 9 => "255.128.0.0",
	 8 => "255.0.0.0",
	 7 => "254.0.0.0",
	 6 => "252.0.0.0",
	 5 => "248.0.0.0",
	 4 => "240.0.0.0",
	 3 => "224.0.0.0",
	 2 => "192.0.0.0",
	 1 => "128.0.0.0",
	 0 => "0.0.0.0"
);

my %NETMASK2PREFIX = reverse(%PREFIX2NETMASK);

# Takes an IP address in dotted decimal notation and
# returns a 32 bit integer representing that IP addresss.
# Will return undef for invalid inputs.
sub ip2bin($) {
	my $address = shift;

	# This function returns undef for undefined input.
	if (!defined $address) {
		return undef;
	}

	my $address_bin = &Socket::inet_pton(AF_INET, $address);
	if ($address_bin) {
		$address_bin = unpack('N', $address_bin);
	}

	return $address_bin;
}

# Does the reverse of ip2bin().
# Will return undef for invalid inputs.
sub bin2ip($) {
	my $address_bin = shift;

	# This function returns undef for undefined input.
	if (!defined $address_bin) {
		return undef;
	}

	my $address = pack('N', $address_bin);
	if ($address) {
		$address = &Socket::inet_ntop(AF_INET, $address);
	}

	return $address;
}

# Takes two network addresses, compares them against each other
# and returns true if equal or false if not
sub network_equal {
	my $network1 = shift;
	my $network2 = shift;

	my @bin1 = &network2bin($network1);
	my @bin2 = &network2bin($network2);

	if (!defined $bin1 || !defined $bin2) {
		return undef;
	}

	if ($bin1[0] == $bin2[0] && $bin1[1] == $bin2[1]) {
		return 1;
	}

	return 0;
}

# Takes a network in either a.b.c.d/a.b.c.d or a.b.c.d/e notation
# and will return an 32 bit integer representing the start
# address and an other one representing the network mask.
sub network2bin($) {
	my $network = shift;

	my ($address, $netmask) = split(/\//, $network, 2);

	if (&check_prefix($netmask)) {
		$netmask = &convert_prefix2netmask($netmask);
	}

	my $address_bin = &ip2bin($address);
	my $netmask_bin = &ip2bin($netmask);

	if (!defined $address_bin || !defined $netmask_bin) {
		return undef;
	}

	my $network_start = $address_bin & $netmask_bin;

	return ($network_start, $netmask_bin);
}

# Deletes leading zeros in ip address
sub ip_remove_zero{
	my $address = shift;
	my @ip = split (/\./, $address);

	foreach my $octet (@ip) {
		$octet = int($octet);
	}

	$address = join (".", @ip);

	return $address;
}
# Returns True for all valid IP addresses
sub check_ip_address($) {
	my $address = shift;

	# Normalise the IP address and compare the result with
	# the input - which should obviously the same.
	my $normalised_address = &_normalise_ip_address($address);

	return ((defined $normalised_address) && ($address eq $normalised_address));
}

# Returns True for all valid prefixes.
sub check_prefix($) {
	my $prefix = shift;

	return (exists $PREFIX2NETMASK{$prefix});
}

# Returns True for all valid subnet masks.
sub check_netmask($) {
	my $netmask = shift;

	return (exists $NETMASK2PREFIX{$netmask});
}

# Returns True for all valid inputs like a.b.c.d/a.b.c.d.
sub check_ip_address_and_netmask($$) {
	my $network = shift;

	my ($address, $netmask) = split(/\//, $network, 2);

	# Check if the IP address is fine.
	#
	my $result = &check_ip_address($address);
	unless ($result) {
		return $result;
	}

	return &check_netmask($netmask);
}

# Returns True for all valid subnets like a.b.c.d/e or a.b.c.d/a.b.c.d
sub check_subnet($) {
	my $subnet = shift;

	my ($address, $network) = split(/\//, $subnet, 2);

	# Check if the IP address is fine.
	my $result = &check_ip_address($address);
	unless ($result) {
		return $result;
	}

	return &check_prefix($network) || &check_netmask($network);
}

# For internal use only. Will take an IP address and
# return it in a normalised style. Like 8.8.8.010 -> 8.8.8.8.
sub _normalise_ip_address($) {
	my $address = shift;

	my $address_bin = &ip2bin($address);
	if (!defined $address_bin) {
		return undef;
	}

	return &bin2ip($address_bin);
}

# Returns the prefix for the given subnet mask.
sub convert_netmask2prefix($) {
	my $netmask = shift;

	if (exists $NETMASK2PREFIX{$netmask}) {
		return $NETMASK2PREFIX{$netmask};
	}

	return undef;
}

# Returns the subnet mask for the given prefix.
sub convert_prefix2netmask($) {
	my $prefix = shift;

	if (exists $PREFIX2NETMASK{$prefix}) {
		return $PREFIX2NETMASK{$prefix};
	}

	return undef;
}

# Takes an IP address and an offset and
# will return the offset'th IP address.
sub find_next_ip_address($$) {
	my $address = shift;
	my $offset = shift;

	my $address_bin = &ip2bin($address);
	$address_bin += $offset;

	return &bin2ip($address_bin);
}

# Returns the network address of the given network.
sub get_netaddress($) {
	my $network = shift;
	my ($network_bin, $netmask_bin) = &network2bin($network);

	if (defined $network_bin) {
		return &bin2ip($network_bin);
	}

	return undef;
}

# Returns the broadcast of the given network.
sub get_broadcast($) {
	my $network = shift;
	my ($network_bin, $netmask_bin) = &network2bin($network);

	return &bin2ip($network_bin ^ ~$netmask_bin);
}

# Returns True if $address is in $network.
sub ip_address_in_network($$) {
	my $address = shift;
	my $network = shift;

	my $address_bin = &ip2bin($address);
	return undef unless (defined $address_bin);

	my ($network_bin, $netmask_bin) = &network2bin($network);

	# Find end address
	my $broadcast_bin = $network_bin ^ (~$netmask_bin % 2 ** 32);

	return (($address_bin >= $network_bin) && ($address_bin <= $broadcast_bin));
}

sub setup_upstream_proxy() {
	my %proxysettings = ();
	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);

	if ($proxysettings{'UPSTREAM_PROXY'}) {
		my $credentials = "";

		if ($proxysettings{'UPSTREAM_USER'}) {
			$credentials = $proxysettings{'UPSTREAM_USER'};

			if ($proxysettings{'UPSTREAM_PASSWORD'}) {
				$credentials .= ":" . $proxysettings{'UPSTREAM_PASSWORD'};
			}

			$credentials .= "@";
		}

		my $proxy = "http://" . $credentials . $proxysettings{'UPSTREAM_PROXY'};

		$ENV{'http_proxy'} = $proxy;
		$ENV{'https_proxy'} = $proxy;
		$ENV{'ftp_proxy'} = $proxy;
	}
}

sub get_red_interfaces() {
	my $default = &General::get_red_interface();

	my @intfs = (
		$default,
	);

	opendir(INTERFACES, "/sys/class/net");

	while (my $intf = readdir(INTERFACES)) {
		if ($intf =~ m/^red[0-9]+$/) {
			push(@intfs, $intf);
		}
	}

	closedir(INTERFACES);

	return &General::uniq(@intfs);
}

sub list_wireless_interfaces() {
	my %interfaces = ();

	opendir(INTERFACES, "/sys/class/net");

	my $intf;
	while ($intf = readdir(INTERFACES)) {
		# Is this a wireless interface?
		opendir(PHY80211, "/sys/class/net/$intf/phy80211") or next;
		closedir(PHY80211);

		# Read the MAC address
		my $address = &get_nic_property($intf, "address");

		$interfaces{$address} = "$address ($intf)";
	}

	closedir(INTERFACES);

	return %interfaces;
}

my %wireless_status = ();

sub _get_wireless_status($) {
	my $intf = shift;

	if (!$wireless_status{$intf}) {
		$wireless_status{$intf} = join('\n', &General::system_output("iwconfig", "$intf"));
	}

	return $wireless_status{$intf};
}

sub wifi_get_essid($) {
	my $status = &_get_wireless_status(shift);

	my ($essid) = $status =~ /ESSID:\"(.*)\"/;

	return $essid;
}

sub wifi_get_frequency($) {
	my $status = &_get_wireless_status(shift);

	my ($frequency) = $status =~ /Frequency:(\d+\.\d+ GHz)/;

	return $frequency;
}

sub wifi_get_access_point($) {
	my $status = &_get_wireless_status(shift);

	my ($access_point) = $status =~ /Access Point: ([0-9A-F:]+)/;

	return $access_point;
}

sub wifi_get_bit_rate($) {
	my $status = &_get_wireless_status(shift);

	my ($bit_rate) = $status =~ /Bit Rate=(\d+ [GM]b\/s)/;

	return $bit_rate;
}

sub wifi_get_link_quality($) {
	my $status = &_get_wireless_status(shift);

	my ($cur, $max) = $status =~ /Link Quality=(\d+)\/(\d+)/;

	if($max > 0) {
		return sprintf('%.0f', ($cur * 100) / $max);
	}

	return 0;
}

sub wifi_get_signal_level($) {
	my $status = &_get_wireless_status(shift);

	my ($signal_level) = $status =~ /Signal level=(\-\d+ dBm)/;

	return $signal_level;
}

sub get_hardware_address($) {
	my $ip_address = shift;
	my $ret;

	open(FILE, "/proc/net/arp") or die("Could not read ARP table");

	while (<FILE>) {
		my ($ip_addr, $hwtype, $flags, $hwaddr, $mask, $device) = split(/\s+/, $_);
		if ($ip_addr eq $ip_address) {
			$ret = $hwaddr;
			last;
		}
	}

	close(FILE);

	return $ret;
}

sub get_nic_property {
	my $nicname = shift;
	my $property = shift;
	my $result;

	open(FILE, "/sys/class/net/$nicname/$property") or die("Could not read property $property for $nicname");
	$result = <FILE>;
	close(FILE);

	chomp($result);

	return $result;
}

sub valid_mac($) {
	my $mac = shift;

	return $mac =~ /^([0-9A-Fa-f]{2}[:]){5}([0-9A-Fa-f]{2})$/;
}

# Compares two MAC addresses and returns true if they are equal
sub is_mac_equal {
	my $mac_1 = uc shift; # convert to upper case
	my $mac_2 = uc shift;

	if(valid_mac($mac_1) && valid_mac($mac_2) && ($mac_1 eq $mac_2)) {
		return 1;
	}

	return 0;
}

sub random_mac {
	my $address = "02";

	for my $i (0 .. 4) {
		$address = sprintf("$address:%02x", int(rand(255)));
	}

	return $address;
}

sub get_mac_by_name($) {
	my $mac = shift;

	if ((!&valid_mac($mac)) && ($mac ne "")) {
		if (-e "/sys/class/net/$mac/") {
			$mac = get_nic_property($mac, "address");
		}
	}

	return $mac;
}

sub get_intf_by_address($) {
	my $address = shift;

	opendir(INTERFACES, "/sys/class/net");

	while (my $intf = readdir(INTERFACES)) {
		next if ($intf eq "." or $intf eq "..");

		my $intf_address = &get_nic_property($intf, "address");

		# Skip interfaces without addresses
		next if ($intf_address eq "");

		# Return a match
		return $intf if ($intf_address eq $address);
	}

	closedir(INTERFACES);

	return undef;
}

#
## Function to get a list of all available network zones.
#
sub get_available_network_zones () {
	# Obtain the configuration type from the netsettings hash.
	my $config_type = $ethernet_settings{'CONFIG_TYPE'};

	# Hash which contains the conversation from the config mode
	# to the existing network interface names. They are stored like
	# an array.
	#
	# Mode "0" red is a modem and green
	# Mode "1" red is a netdev and green
	# Mode "2" red, green and orange
	# Mode "3" red, green and blue
	# Mode "4" red, green, blue, orange
	my %config_type_to_interfaces = (
		"0" => [ "red", "green" ],
		"1" => [ "red", "green" ],
		"2" => [ "red", "green", "orange" ],
		"3" => [ "red", "green", "blue" ],
		"4" => [ "red", "green", "blue", "orange" ]
	);

	# Obtain and dereference the corresponding network interaces based on the read
	# network config type.
	my @network_zones = @{ $config_type_to_interfaces{$config_type} };

	# Return them.
	return @network_zones;
}

#
## Function to check if a network zone is available in the current configuration
#
sub is_zone_available() {
	my $zone = lc shift;
	
	# Make sure the zone is valid
	die("Unknown network zone '$zone'") unless ($zone ~~ @known_network_zones);
	
	# Get available zones and return result
	my @available_zones = get_available_network_zones();
	return ($zone ~~ @available_zones);
}

#
## Function to determine if the RED zone is in standard IP (or modem, PPP, VDSL, ...) mode
#
sub is_red_mode_ip() {
	# Obtain the settings from the netsettings hash
	my $config_type = $ethernet_settings{'CONFIG_TYPE'};
	my $red_type = $ethernet_settings{'RED_TYPE'};

	# RED must be a network device (configuration 1-4) with dynamic or static IP
	return (($config_type ~~ [1..4]) && ($red_type ~~ ["DHCP", "STATIC"]));
}

1;

# Remove the next line to enable the testsuite
__END__

sub assert($$) {
	my $tst = shift;
	my $ret = shift;

	if ($ret) {
		return;
	}

	print "ASSERTION ERROR - $tst\n";
	exit(1);
}

sub testsuite() {
	my $result;

	my $address1 = &ip2bin("8.8.8.8");
	assert('ip2bin("8.8.8.8")', $address1 == 134744072);

	my $address2 = &bin2ip($address1);
	assert("bin2ip($address1)", $address2 eq "8.8.8.8");

	# Check if valid IP addresses are correctly recognised.
	foreach my $address ("1.2.3.4", "192.168.180.1", "127.0.0.1") {
		if (!&check_ip_address($address)) {
			print "$address is not correctly recognised as a valid IP address!\n";
			exit 1;
		};
	}

	# Check if invalid IP addresses are correctly found.
	foreach my $address ("456.2.3.4", "192.768.180.1", "127.1", "1", "a.b.c.d", "1.2.3.4.5", "1.2.3.4/12") {
		if (&check_ip_address($address)) {
			print "$address is recognised as a valid IP address!\n";
			exit 1;
		};
	}

	$result = &check_ip_address_and_netmask("192.168.180.0/255.255.255.0");
	assert('check_ip_address_and_netmask("192.168.180.0/255.255.255.0")', $result);

	$result = &convert_netmask2prefix("255.255.254.0");
	assert('convert_netmask2prefix("255.255.254.0")', $result == 23);

	$result = &convert_prefix2netmask(8);
	assert('convert_prefix2netmask(8)', $result eq "255.0.0.0");

	$result = &find_next_ip_address("1.2.3.4", 2);
	assert('find_next_ip_address("1.2.3.4", 2)', $result eq "1.2.3.6");

	$result = &network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0");
	assert('network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0")', $result);

	$result = &network_equal("192.168.0.0/24", "192.168.0.0/25");
	assert('network_equal("192.168.0.0/24", "192.168.0.0/25")', !$result);

	$result = &network_equal("192.168.0.0/24", "192.168.0.128/25");
	assert('network_equal("192.168.0.0/24", "192.168.0.128/25")', !$result);

	$result = &network_equal("192.168.0.1/24", "192.168.0.XXX/24");
	assert('network_equal("192.168.0.1/24", "192.168.0.XXX/24")', !$result);

	$result = &ip_address_in_network("10.0.1.4", "10.0.0.0/8");
	assert('ip_address_in_network("10.0.1.4", "10.0.0.0/8"', $result);

	$result = &ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0");
	assert('ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0")', $result);

	$result = &ip_address_in_network("192.168.30.11", "0.0.0.0/8");
	assert('ip_address_in_network("192.168.30.11", "0.0.0.0/8")', !$result);

	print "Testsuite completed successfully!\n";

	return 0;
}

&testsuite();
Commit	Line	Data
4e9a2b57 MT	1	#!/usr/bin/perl -w
	2	############################################################################
	3	# #
	4	# This file is part of the IPFire Firewall. #
	5	# #
	6	# IPFire is free software; you can redistribute it and/or modify #
	7	# it under the terms of the GNU General Public License as published by #
	8	# the Free Software Foundation; either version 2 of the License, or #
	9	# (at your option) any later version. #
	10	# #
	11	# IPFire is distributed in the hope that it will be useful, #
	12	# but WITHOUT ANY WARRANTY; without even the implied warranty of #
	13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
	14	# GNU General Public License for more details. #
	15	# #
	16	# You should have received a copy of the GNU General Public License #
	17	# along with IPFire; if not, write to the Free Software #
	18	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA #
	19	# #
	20	# Copyright (C) 2014 IPFire Team <info@ipfire.org>. #
	21	# #
	22	############################################################################
	23
	24	package Network;
	25
5428eeee MT	26	require "/var/ipfire/general-functions.pl";
5428eeee MT	27
69d90c36	28	use experimental 'smartmatch';
4e9a2b57 MT	29	use Socket;
4e9a2b57 MT	30
eea288bc LAH	31	# System ethernet configuration
	32	our %ethernet_settings = ();
	33	&General::readhash("${General::swroot}/ethernet/settings", \%ethernet_settings);
	34
	35	# List of all possible network zones that can be configured
	36	our @known_network_zones = ("red", "green", "orange", "blue");
	37
	38	# IPv4 netmask CIDR to dotted decimal notation conversion table
4e9a2b57 MT	39	my %PREFIX2NETMASK = (
	40	32 => "255.255.255.255",
	41	31 => "255.255.255.254",
	42	30 => "255.255.255.252",
	43	29 => "255.255.255.248",
	44	28 => "255.255.255.240",
	45	27 => "255.255.255.224",
	46	26 => "255.255.255.192",
	47	25 => "255.255.255.128",
	48	24 => "255.255.255.0",
	49	23 => "255.255.254.0",
	50	22 => "255.255.252.0",
	51	21 => "255.255.248.0",
	52	20 => "255.255.240.0",
	53	19 => "255.255.224.0",
	54	18 => "255.255.192.0",
	55	17 => "255.255.128.0",
	56	16 => "255.255.0.0",
	57	15 => "255.254.0.0",
	58	14 => "255.252.0.0",
	59	13 => "255.248.0.0",
	60	12 => "255.240.0.0",
	61	11 => "255.224.0.0",
	62	10 => "255.192.0.0",
	63	9 => "255.128.0.0",
	64	8 => "255.0.0.0",
	65	7 => "254.0.0.0",
	66	6 => "252.0.0.0",
	67	5 => "248.0.0.0",
	68	4 => "240.0.0.0",
	69	3 => "224.0.0.0",
	70	2 => "192.0.0.0",
	71	1 => "128.0.0.0",
	72	0 => "0.0.0.0"
	73	);
	74
	75	my %NETMASK2PREFIX = reverse(%PREFIX2NETMASK);
	76
	77	# Takes an IP address in dotted decimal notation and
	78	# returns a 32 bit integer representing that IP addresss.
	79	# Will return undef for invalid inputs.
	80	sub ip2bin($) {
	81	my $address = shift;
	82
	83	# This function returns undef for undefined input.
	84	if (!defined $address) {
	85	return undef;
	86	}
	87
	88	my $address_bin = &Socket::inet_pton(AF_INET, $address);
	89	if ($address_bin) {
	90	$address_bin = unpack('N', $address_bin);
	91	}
	92
	93	return $address_bin;
	94	}
	95
	96	# Does the reverse of ip2bin().
	97	# Will return undef for invalid inputs.
	98	sub bin2ip($) {
	99	my $address_bin = shift;
	100
	101	# This function returns undef for undefined input.
	102	if (!defined $address_bin) {
103	return undef;
104	}
105
106	my $address = pack('N', $address_bin);
107	if ($address) {
108	$address = &Socket::inet_ntop(AF_INET, $address);
109	}
110
111	return $address;
112	}
113
8f23ce8e MT	114	# Takes two network addresses, compares them against each other
	115	# and returns true if equal or false if not
	116	sub network_equal {
ff6cc711 AM	117	my $network1 = shift;
ff6cc711 AM	118	my $network2 = shift;
8f23ce8e	119
1047805d AM	120	my @bin1 = &network2bin($network1);
1047805d AM	121	my @bin2 = &network2bin($network2);
8f23ce8e	122
3f3974b7 AM	123	if (!defined $bin1 \|\| !defined $bin2) {
	124	return undef;
	125	}
	126
6386584b	127	if ($bin1[0] == $bin2[0] && $bin1[1] == $bin2[1]) {
ff6cc711 AM	128	return 1;
ff6cc711 AM	129	}
8f23ce8e	130
ff6cc711 AM	131	return 0;
	132	}
	133
4e9a2b57 MT	134	# Takes a network in either a.b.c.d/a.b.c.d or a.b.c.d/e notation
	135	# and will return an 32 bit integer representing the start
	136	# address and an other one representing the network mask.
	137	sub network2bin($) {
	138	my $network = shift;
	139
	140	my ($address, $netmask) = split(/\//, $network, 2);
	141
	142	if (&check_prefix($netmask)) {
	143	$netmask = &convert_prefix2netmask($netmask);
	144	}
	145
	146	my $address_bin = &ip2bin($address);
	147	my $netmask_bin = &ip2bin($netmask);
	148
3f3974b7 AM	149	if (!defined $address_bin \|\| !defined $netmask_bin) {
	150	return undef;
	151	}
	152
4e9a2b57 MT	153	my $network_start = $address_bin & $netmask_bin;
	154
	155	return ($network_start, $netmask_bin);
	156	}
	157
f770b728 AM	158	# Deletes leading zeros in ip address
	159	sub ip_remove_zero{
	160	my $address = shift;
	161	my @ip = split (/\./, $address);
	162
	163	foreach my $octet (@ip) {
	164	$octet = int($octet);
	165	}
	166
	167	$address = join (".", @ip);
	168
	169	return $address;
	170	}
4e9a2b57 MT	171	# Returns True for all valid IP addresses
	172	sub check_ip_address($) {
	173	my $address = shift;
	174
	175	# Normalise the IP address and compare the result with
	176	# the input - which should obviously the same.
	177	my $normalised_address = &_normalise_ip_address($address);
	178
	179	return ((defined $normalised_address) && ($address eq $normalised_address));
	180	}
	181
	182	# Returns True for all valid prefixes.
	183	sub check_prefix($) {
	184	my $prefix = shift;
	185
	186	return (exists $PREFIX2NETMASK{$prefix});
	187	}
	188
	189	# Returns True for all valid subnet masks.
	190	sub check_netmask($) {
	191	my $netmask = shift;
	192
	193	return (exists $NETMASK2PREFIX{$netmask});
	194	}
	195
	196	# Returns True for all valid inputs like a.b.c.d/a.b.c.d.
	197	sub check_ip_address_and_netmask($$) {
	198	my $network = shift;
	199
	200	my ($address, $netmask) = split(/\//, $network, 2);
	201
	202	# Check if the IP address is fine.
cc9eb2d3	203	#
4e9a2b57 MT	204	my $result = &check_ip_address($address);
	205	unless ($result) {
	206	return $result;
	207	}
	208
	209	return &check_netmask($netmask);
	210	}
	211
883c5453 MT	212	# Returns True for all valid subnets like a.b.c.d/e or a.b.c.d/a.b.c.d
	213	sub check_subnet($) {
	214	my $subnet = shift;
	215
	216	my ($address, $network) = split(/\//, $subnet, 2);
	217
	218	# Check if the IP address is fine.
	219	my $result = &check_ip_address($address);
	220	unless ($result) {
	221	return $result;
	222	}
	223
	224	return &check_prefix($network) \|\| &check_netmask($network);
	225	}
	226
4e9a2b57 MT	227	# For internal use only. Will take an IP address and
	228	# return it in a normalised style. Like 8.8.8.010 -> 8.8.8.8.
	229	sub _normalise_ip_address($) {
	230	my $address = shift;
	231
	232	my $address_bin = &ip2bin($address);
	233	if (!defined $address_bin) {
	234	return undef;
	235	}
	236
	237	return &bin2ip($address_bin);
	238	}
	239
	240	# Returns the prefix for the given subnet mask.
	241	sub convert_netmask2prefix($) {
	242	my $netmask = shift;
	243
	244	if (exists $NETMASK2PREFIX{$netmask}) {
	245	return $NETMASK2PREFIX{$netmask};
	246	}
	247
	248	return undef;
	249	}
	250
	251	# Returns the subnet mask for the given prefix.
	252	sub convert_prefix2netmask($) {
	253	my $prefix = shift;
	254
	255	if (exists $PREFIX2NETMASK{$prefix}) {
	256	return $PREFIX2NETMASK{$prefix};
	257	}
	258
	259	return undef;
	260	}
	261
	262	# Takes an IP address and an offset and
	263	# will return the offset'th IP address.
	264	sub find_next_ip_address($$) {
	265	my $address = shift;
	266	my $offset = shift;
	267
	268	my $address_bin = &ip2bin($address);
	269	$address_bin += $offset;
	270
	271	return &bin2ip($address_bin);
	272	}
	273
	274	# Returns the network address of the given network.
	275	sub get_netaddress($) {
	276	my $network = shift;
	277	my ($network_bin, $netmask_bin) = &network2bin($network);
	278
	279	if (defined $network_bin) {
	280	return &bin2ip($network_bin);
	281	}
	282
	283	return undef;
	284	}
	285
	286	# Returns the broadcast of the given network.
	287	sub get_broadcast($) {
	288	my $network = shift;
	289	my ($network_bin, $netmask_bin) = &network2bin($network);
	290
291	return &bin2ip($network_bin ^ ~$netmask_bin);
292	}
293
294	# Returns True if $address is in $network.
295	sub ip_address_in_network($$) {
296	my $address = shift;
297	my $network = shift;
298
299	my $address_bin = &ip2bin($address);
300	return undef unless (defined $address_bin);
301
302	my ($network_bin, $netmask_bin) = &network2bin($network);
303
304	# Find end address
01d61d15	305	my $broadcast_bin = $network_bin ^ (~$netmask_bin % 2 ** 32);
4e9a2b57	306
6386584b	307	return (($address_bin >= $network_bin) && ($address_bin <= $broadcast_bin));
4e9a2b57 MT	308	}
4e9a2b57 MT	309
5428eeee MT	310	sub setup_upstream_proxy() {
	311	my %proxysettings = ();
	312	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
	313
	314	if ($proxysettings{'UPSTREAM_PROXY'}) {
	315	my $credentials = "";
	316
	317	if ($proxysettings{'UPSTREAM_USER'}) {
	318	$credentials = $proxysettings{'UPSTREAM_USER'};
	319
	320	if ($proxysettings{'UPSTREAM_PASSWORD'}) {
	321	$credentials .= ":" . $proxysettings{'UPSTREAM_PASSWORD'};
	322	}
	323
	324	$credentials .= "@";
	325	}
	326
	327	my $proxy = "http://" . $credentials . $proxysettings{'UPSTREAM_PROXY'};
	328
	329	$ENV{'http_proxy'} = $proxy;
	330	$ENV{'https_proxy'} = $proxy;
	331	$ENV{'ftp_proxy'} = $proxy;
	332	}
	333	}
	334
6395bed8 MT	335	sub get_red_interfaces() {
	336	my $default = &General::get_red_interface();
	337
	338	my @intfs = (
	339	$default,
	340	);
	341
	342	opendir(INTERFACES, "/sys/class/net");
	343
	344	while (my $intf = readdir(INTERFACES)) {
	345	if ($intf =~ m/^red[0-9]+$/) {
	346	push(@intfs, $intf);
	347	}
	348	}
	349
	350	closedir(INTERFACES);
	351
	352	return &General::uniq(@intfs);
	353	}
	354
45b1fc5c MT	355	sub list_wireless_interfaces() {
	356	my %interfaces = ();
	357
	358	opendir(INTERFACES, "/sys/class/net");
	359
	360	my $intf;
	361	while ($intf = readdir(INTERFACES)) {
	362	# Is this a wireless interface?
	363	opendir(PHY80211, "/sys/class/net/$intf/phy80211") or next;
	364	closedir(PHY80211);
	365
	366	# Read the MAC address
	367	my $address = &get_nic_property($intf, "address");
	368
	369	$interfaces{$address} = "$address ($intf)";
	370	}
	371
	372	closedir(INTERFACES);
	373
	374	return %interfaces;
	375	}
	376
c335b0cd MT	377	my %wireless_status = ();
	378
	379	sub _get_wireless_status($) {
	380	my $intf = shift;
	381
	382	if (!$wireless_status{$intf}) {
b9a0d706	383	$wireless_status{$intf} = join('\n', &General::system_output("iwconfig", "$intf"));
c335b0cd MT	384	}
	385
	386	return $wireless_status{$intf};
	387	}
	388
	389	sub wifi_get_essid($) {
	390	my $status = &_get_wireless_status(shift);
	391
	392	my ($essid) = $status =~ /ESSID:\"(.*)\"/;
	393
	394	return $essid;
	395	}
	396
	397	sub wifi_get_frequency($) {
	398	my $status = &_get_wireless_status(shift);
	399
	400	my ($frequency) = $status =~ /Frequency:(\d+\.\d+ GHz)/;
	401
	402	return $frequency;
	403	}
	404
	405	sub wifi_get_access_point($) {
	406	my $status = &_get_wireless_status(shift);
	407
	408	my ($access_point) = $status =~ /Access Point: ([0-9A-F:]+)/;
	409
	410	return $access_point;
	411	}
	412
	413	sub wifi_get_bit_rate($) {
	414	my $status = &_get_wireless_status(shift);
	415
	416	my ($bit_rate) = $status =~ /Bit Rate=(\d+ [GM]b\/s)/;
	417
	418	return $bit_rate;
	419	}
	420
	421	sub wifi_get_link_quality($) {
	422	my $status = &_get_wireless_status(shift);
	423
	424	my ($cur, $max) = $status =~ /Link Quality=(\d+)\/(\d+)/;
	425
6dd084c2 LAH	426	if($max > 0) {
	427	return sprintf('%.0f', ($cur * 100) / $max);
	428	}
	429
	430	return 0;
c335b0cd MT	431	}
	432
	433	sub wifi_get_signal_level($) {
	434	my $status = &_get_wireless_status(shift);
	435
	436	my ($signal_level) = $status =~ /Signal level=(\-\d+ dBm)/;
	437
	438	return $signal_level;
	439	}
dbfd2622 MT	440
	441	sub get_hardware_address($) {
	442	my $ip_address = shift;
	443	my $ret;
	444
	445	open(FILE, "/proc/net/arp") or die("Could not read ARP table");
	446
	447	while (<FILE>) {
	448	my ($ip_addr, $hwtype, $flags, $hwaddr, $mask, $device) = split(/\s+/, $_);
	449	if ($ip_addr eq $ip_address) {
	450	$ret = $hwaddr;
	451	last;
	452	}
	453	}
	454
	455	close(FILE);
	456
	457	return $ret;
	458	}
	459
1dcf513a FB	460	sub get_nic_property {
	461	my $nicname = shift;
	462	my $property = shift;
	463	my $result;
	464
45b1fc5c	465	open(FILE, "/sys/class/net/$nicname/$property") or die("Could not read property $property for $nicname");
1dcf513a FB	466	$result = <FILE>;
	467	close(FILE);
	468
	469	chomp($result);
	470
	471	return $result;
	472	}
	473
	474	sub valid_mac($) {
	475	my $mac = shift;
	476
	477	return $mac =~ /^([0-9A-Fa-f]{2}[:]){5}([0-9A-Fa-f]{2})$/;
	478	}
	479
92d8c1f7 LAH	480	# Compares two MAC addresses and returns true if they are equal
	481	sub is_mac_equal {
	482	my $mac_1 = uc shift; # convert to upper case
	483	my $mac_2 = uc shift;
	484
	485	if(valid_mac($mac_1) && valid_mac($mac_2) && ($mac_1 eq $mac_2)) {
	486	return 1;
	487	}
	488
	489	return 0;
	490	}
	491
1dcf513a FB	492	sub random_mac {
	493	my $address = "02";
	494
	495	for my $i (0 .. 4) {
	496	$address = sprintf("$address:%02x", int(rand(255)));
	497	}
	498
	499	return $address;
	500	}
	501
	502	sub get_mac_by_name($) {
	503	my $mac = shift;
	504
	505	if ((!&valid_mac($mac)) && ($mac ne "")) {
	506	if (-e "/sys/class/net/$mac/") {
	507	$mac = get_nic_property($mac, "address");
	508	}
	509	}
	510
	511	return $mac;
	512	}
	513
45b1fc5c MT	514	sub get_intf_by_address($) {
	515	my $address = shift;
	516
	517	opendir(INTERFACES, "/sys/class/net");
	518
	519	while (my $intf = readdir(INTERFACES)) {
	520	next if ($intf eq "." or $intf eq "..");
	521
	522	my $intf_address = &get_nic_property($intf, "address");
	523
	524	# Skip interfaces without addresses
	525	next if ($intf_address eq "");
	526
	527	# Return a match
	528	return $intf if ($intf_address eq $address);
	529	}
	530
	531	closedir(INTERFACES);
	532
	533	return undef;
	534	}
	535
abffcc99 LAH	536	#
	537	## Function to get a list of all available network zones.
	538	#
	539	sub get_available_network_zones () {
abffcc99	540	# Obtain the configuration type from the netsettings hash.
eea288bc	541	my $config_type = $ethernet_settings{'CONFIG_TYPE'};
abffcc99 LAH	542
	543	# Hash which contains the conversation from the config mode
	544	# to the existing network interface names. They are stored like
	545	# an array.
	546	#
	547	# Mode "0" red is a modem and green
	548	# Mode "1" red is a netdev and green
	549	# Mode "2" red, green and orange
	550	# Mode "3" red, green and blue
	551	# Mode "4" red, green, blue, orange
	552	my %config_type_to_interfaces = (
	553	"0" => [ "red", "green" ],
	554	"1" => [ "red", "green" ],
	555	"2" => [ "red", "green", "orange" ],
	556	"3" => [ "red", "green", "blue" ],
	557	"4" => [ "red", "green", "blue", "orange" ]
	558	);
	559
	560	# Obtain and dereference the corresponding network interaces based on the read
	561	# network config type.
	562	my @network_zones = @{ $config_type_to_interfaces{$config_type} };
	563
	564	# Return them.
	565	return @network_zones;
	566	}
	567
eea288bc LAH	568	#
	569	## Function to check if a network zone is available in the current configuration
	570	#
	571	sub is_zone_available() {
	572	my $zone = lc shift;
	573
	574	# Make sure the zone is valid
	575	die("Unknown network zone '$zone'") unless ($zone ~~ @known_network_zones);
	576
	577	# Get available zones and return result
	578	my @available_zones = get_available_network_zones();
	579	return ($zone ~~ @available_zones);
	580	}
	581
	582	#
	583	## Function to determine if the RED zone is in standard IP (or modem, PPP, VDSL, ...) mode
	584	#
	585	sub is_red_mode_ip() {
	586	# Obtain the settings from the netsettings hash
	587	my $config_type = $ethernet_settings{'CONFIG_TYPE'};
	588	my $red_type = $ethernet_settings{'RED_TYPE'};
	589
	590	# RED must be a network device (configuration 1-4) with dynamic or static IP
	591	return (($config_type ~~ [1..4]) && ($red_type ~~ ["DHCP", "STATIC"]));
	592	}
	593
4e9a2b57 MT	594	1;
	595
	596	# Remove the next line to enable the testsuite
	597	__END__
	598
cc9eb2d3 PM	599	sub assert($$) {
cc9eb2d3 PM	600	my $tst = shift;
4e9a2b57 MT	601	my $ret = shift;
	602
	603	if ($ret) {
	604	return;
	605	}
	606
cc9eb2d3	607	print "ASSERTION ERROR - $tst\n";
4e9a2b57 MT	608	exit(1);
	609	}
	610
	611	sub testsuite() {
	612	my $result;
	613
	614	my $address1 = &ip2bin("8.8.8.8");
cc9eb2d3	615	assert('ip2bin("8.8.8.8")', $address1 == 134744072);
4e9a2b57 MT	616
4e9a2b57 MT	617	my $address2 = &bin2ip($address1);
cc9eb2d3	618	assert("bin2ip($address1)", $address2 eq "8.8.8.8");
4e9a2b57 MT	619
	620	# Check if valid IP addresses are correctly recognised.
	621	foreach my $address ("1.2.3.4", "192.168.180.1", "127.0.0.1") {
	622	if (!&check_ip_address($address)) {
	623	print "$address is not correctly recognised as a valid IP address!\n";
	624	exit 1;
	625	};
	626	}
	627
	628	# Check if invalid IP addresses are correctly found.
	629	foreach my $address ("456.2.3.4", "192.768.180.1", "127.1", "1", "a.b.c.d", "1.2.3.4.5", "1.2.3.4/12") {
	630	if (&check_ip_address($address)) {
	631	print "$address is recognised as a valid IP address!\n";
	632	exit 1;
	633	};
	634	}
	635
	636	$result = &check_ip_address_and_netmask("192.168.180.0/255.255.255.0");
cc9eb2d3	637	assert('check_ip_address_and_netmask("192.168.180.0/255.255.255.0")', $result);
4e9a2b57 MT	638
4e9a2b57 MT	639	$result = &convert_netmask2prefix("255.255.254.0");
cc9eb2d3	640	assert('convert_netmask2prefix("255.255.254.0")', $result == 23);
4e9a2b57 MT	641
4e9a2b57 MT	642	$result = &convert_prefix2netmask(8);
cc9eb2d3	643	assert('convert_prefix2netmask(8)', $result eq "255.0.0.0");
4e9a2b57 MT	644
4e9a2b57 MT	645	$result = &find_next_ip_address("1.2.3.4", 2);
cc9eb2d3	646	assert('find_next_ip_address("1.2.3.4", 2)', $result eq "1.2.3.6");
4e9a2b57	647
3713af1e	648	$result = &network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0");
cc9eb2d3	649	assert('network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0")', $result);
3713af1e MT	650
3713af1e MT	651	$result = &network_equal("192.168.0.0/24", "192.168.0.0/25");
cc9eb2d3	652	assert('network_equal("192.168.0.0/24", "192.168.0.0/25")', !$result);
3713af1e MT	653
3713af1e MT	654	$result = &network_equal("192.168.0.0/24", "192.168.0.128/25");
cc9eb2d3	655	assert('network_equal("192.168.0.0/24", "192.168.0.128/25")', !$result);
3713af1e MT	656
3713af1e MT	657	$result = &network_equal("192.168.0.1/24", "192.168.0.XXX/24");
cc9eb2d3	658	assert('network_equal("192.168.0.1/24", "192.168.0.XXX/24")', !$result);
3713af1e	659
4e9a2b57	660	$result = &ip_address_in_network("10.0.1.4", "10.0.0.0/8");
cc9eb2d3	661	assert('ip_address_in_network("10.0.1.4", "10.0.0.0/8"', $result);
4e9a2b57	662
01d61d15	663	$result = &ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0");
cc9eb2d3 PM	664	assert('ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0")', $result);
	665
	666	$result = &ip_address_in_network("192.168.30.11", "0.0.0.0/8");
	667	assert('ip_address_in_network("192.168.30.11", "0.0.0.0/8")', !$result);
01d61d15	668
3713af1e MT	669	print "Testsuite completed successfully!\n";
3713af1e MT	670
4e9a2b57 MT	671	return 0;
	672	}
	673
	674	&testsuite();