[people/pmueller/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 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} = &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+)/;

	return $cur * 100 / $max;
}

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
45b1fc5c MT	335	sub list_wireless_interfaces() {
	336	my %interfaces = ();
	337
	338	opendir(INTERFACES, "/sys/class/net");
	339
	340	my $intf;
	341	while ($intf = readdir(INTERFACES)) {
	342	# Is this a wireless interface?
	343	opendir(PHY80211, "/sys/class/net/$intf/phy80211") or next;
	344	closedir(PHY80211);
	345
	346	# Read the MAC address
	347	my $address = &get_nic_property($intf, "address");
	348
	349	$interfaces{$address} = "$address ($intf)";
	350	}
	351
	352	closedir(INTERFACES);
	353
	354	return %interfaces;
	355	}
	356
c335b0cd MT	357	my %wireless_status = ();
	358
	359	sub _get_wireless_status($) {
	360	my $intf = shift;
	361
	362	if (!$wireless_status{$intf}) {
f3e3cb37	363	$wireless_status{$intf} = &General::system_output("iwconfig", "$intf");
c335b0cd MT	364	}
	365
	366	return $wireless_status{$intf};
	367	}
	368
	369	sub wifi_get_essid($) {
	370	my $status = &_get_wireless_status(shift);
	371
	372	my ($essid) = $status =~ /ESSID:\"(.*)\"/;
	373
	374	return $essid;
	375	}
	376
	377	sub wifi_get_frequency($) {
	378	my $status = &_get_wireless_status(shift);
	379
	380	my ($frequency) = $status =~ /Frequency:(\d+\.\d+ GHz)/;
	381
	382	return $frequency;
	383	}
	384
	385	sub wifi_get_access_point($) {
	386	my $status = &_get_wireless_status(shift);
	387
	388	my ($access_point) = $status =~ /Access Point: ([0-9A-F:]+)/;
	389
	390	return $access_point;
	391	}
	392
	393	sub wifi_get_bit_rate($) {
	394	my $status = &_get_wireless_status(shift);
	395
	396	my ($bit_rate) = $status =~ /Bit Rate=(\d+ [GM]b\/s)/;
	397
	398	return $bit_rate;
	399	}
	400
	401	sub wifi_get_link_quality($) {
	402	my $status = &_get_wireless_status(shift);
	403
	404	my ($cur, $max) = $status =~ /Link Quality=(\d+)\/(\d+)/;
	405
	406	return $cur * 100 / $max;
	407	}
	408
	409	sub wifi_get_signal_level($) {
	410	my $status = &_get_wireless_status(shift);
	411
	412	my ($signal_level) = $status =~ /Signal level=(\-\d+ dBm)/;
	413
	414	return $signal_level;
	415	}
dbfd2622 MT	416
	417	sub get_hardware_address($) {
	418	my $ip_address = shift;
	419	my $ret;
	420
	421	open(FILE, "/proc/net/arp") or die("Could not read ARP table");
	422
	423	while (<FILE>) {
	424	my ($ip_addr, $hwtype, $flags, $hwaddr, $mask, $device) = split(/\s+/, $_);
	425	if ($ip_addr eq $ip_address) {
	426	$ret = $hwaddr;
	427	last;
	428	}
	429	}
	430
	431	close(FILE);
	432
	433	return $ret;
	434	}
	435
1dcf513a FB	436	sub get_nic_property {
	437	my $nicname = shift;
	438	my $property = shift;
	439	my $result;
	440
45b1fc5c	441	open(FILE, "/sys/class/net/$nicname/$property") or die("Could not read property $property for $nicname");
1dcf513a FB	442	$result = <FILE>;
	443	close(FILE);
	444
	445	chomp($result);
	446
	447	return $result;
	448	}
	449
	450	sub valid_mac($) {
	451	my $mac = shift;
	452
	453	return $mac =~ /^([0-9A-Fa-f]{2}[:]){5}([0-9A-Fa-f]{2})$/;
	454	}
	455
92d8c1f7 LAH	456	# Compares two MAC addresses and returns true if they are equal
	457	sub is_mac_equal {
	458	my $mac_1 = uc shift; # convert to upper case
	459	my $mac_2 = uc shift;
	460
	461	if(valid_mac($mac_1) && valid_mac($mac_2) && ($mac_1 eq $mac_2)) {
	462	return 1;
	463	}
	464
	465	return 0;
	466	}
	467
1dcf513a FB	468	sub random_mac {
	469	my $address = "02";
	470
	471	for my $i (0 .. 4) {
	472	$address = sprintf("$address:%02x", int(rand(255)));
	473	}
	474
	475	return $address;
	476	}
	477
	478	sub get_mac_by_name($) {
	479	my $mac = shift;
	480
	481	if ((!&valid_mac($mac)) && ($mac ne "")) {
	482	if (-e "/sys/class/net/$mac/") {
	483	$mac = get_nic_property($mac, "address");
	484	}
	485	}
	486
	487	return $mac;
	488	}
	489
45b1fc5c MT	490	sub get_intf_by_address($) {
	491	my $address = shift;
	492
	493	opendir(INTERFACES, "/sys/class/net");
	494
	495	while (my $intf = readdir(INTERFACES)) {
	496	next if ($intf eq "." or $intf eq "..");
	497
	498	my $intf_address = &get_nic_property($intf, "address");
	499
	500	# Skip interfaces without addresses
	501	next if ($intf_address eq "");
	502
	503	# Return a match
	504	return $intf if ($intf_address eq $address);
	505	}
	506
	507	closedir(INTERFACES);
	508
	509	return undef;
	510	}
	511
abffcc99 LAH	512	#
	513	## Function to get a list of all available network zones.
	514	#
	515	sub get_available_network_zones () {
abffcc99	516	# Obtain the configuration type from the netsettings hash.
eea288bc	517	my $config_type = $ethernet_settings{'CONFIG_TYPE'};
abffcc99 LAH	518
	519	# Hash which contains the conversation from the config mode
	520	# to the existing network interface names. They are stored like
	521	# an array.
	522	#
	523	# Mode "0" red is a modem and green
	524	# Mode "1" red is a netdev and green
	525	# Mode "2" red, green and orange
	526	# Mode "3" red, green and blue
	527	# Mode "4" red, green, blue, orange
	528	my %config_type_to_interfaces = (
	529	"0" => [ "red", "green" ],
	530	"1" => [ "red", "green" ],
	531	"2" => [ "red", "green", "orange" ],
	532	"3" => [ "red", "green", "blue" ],
	533	"4" => [ "red", "green", "blue", "orange" ]
	534	);
	535
	536	# Obtain and dereference the corresponding network interaces based on the read
	537	# network config type.
	538	my @network_zones = @{ $config_type_to_interfaces{$config_type} };
	539
	540	# Return them.
	541	return @network_zones;
	542	}
	543
eea288bc LAH	544	#
	545	## Function to check if a network zone is available in the current configuration
	546	#
	547	sub is_zone_available() {
	548	my $zone = lc shift;
	549
	550	# Make sure the zone is valid
	551	die("Unknown network zone '$zone'") unless ($zone ~~ @known_network_zones);
	552
	553	# Get available zones and return result
	554	my @available_zones = get_available_network_zones();
	555	return ($zone ~~ @available_zones);
	556	}
	557
	558	#
	559	## Function to determine if the RED zone is in standard IP (or modem, PPP, VDSL, ...) mode
	560	#
	561	sub is_red_mode_ip() {
	562	# Obtain the settings from the netsettings hash
	563	my $config_type = $ethernet_settings{'CONFIG_TYPE'};
	564	my $red_type = $ethernet_settings{'RED_TYPE'};
	565
	566	# RED must be a network device (configuration 1-4) with dynamic or static IP
	567	return (($config_type ~~ [1..4]) && ($red_type ~~ ["DHCP", "STATIC"]));
	568	}
	569
4e9a2b57 MT	570	1;
	571
	572	# Remove the next line to enable the testsuite
	573	__END__
	574
cc9eb2d3 PM	575	sub assert($$) {
cc9eb2d3 PM	576	my $tst = shift;
4e9a2b57 MT	577	my $ret = shift;
	578
	579	if ($ret) {
	580	return;
	581	}
	582
cc9eb2d3	583	print "ASSERTION ERROR - $tst\n";
4e9a2b57 MT	584	exit(1);
	585	}
	586
	587	sub testsuite() {
	588	my $result;
	589
	590	my $address1 = &ip2bin("8.8.8.8");
cc9eb2d3	591	assert('ip2bin("8.8.8.8")', $address1 == 134744072);
4e9a2b57 MT	592
4e9a2b57 MT	593	my $address2 = &bin2ip($address1);
cc9eb2d3	594	assert("bin2ip($address1)", $address2 eq "8.8.8.8");
4e9a2b57 MT	595
	596	# Check if valid IP addresses are correctly recognised.
	597	foreach my $address ("1.2.3.4", "192.168.180.1", "127.0.0.1") {
	598	if (!&check_ip_address($address)) {
	599	print "$address is not correctly recognised as a valid IP address!\n";
	600	exit 1;
	601	};
	602	}
	603
	604	# Check if invalid IP addresses are correctly found.
	605	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") {
	606	if (&check_ip_address($address)) {
	607	print "$address is recognised as a valid IP address!\n";
	608	exit 1;
	609	};
	610	}
	611
	612	$result = &check_ip_address_and_netmask("192.168.180.0/255.255.255.0");
cc9eb2d3	613	assert('check_ip_address_and_netmask("192.168.180.0/255.255.255.0")', $result);
4e9a2b57 MT	614
4e9a2b57 MT	615	$result = &convert_netmask2prefix("255.255.254.0");
cc9eb2d3	616	assert('convert_netmask2prefix("255.255.254.0")', $result == 23);
4e9a2b57 MT	617
4e9a2b57 MT	618	$result = &convert_prefix2netmask(8);
cc9eb2d3	619	assert('convert_prefix2netmask(8)', $result eq "255.0.0.0");
4e9a2b57 MT	620
4e9a2b57 MT	621	$result = &find_next_ip_address("1.2.3.4", 2);
cc9eb2d3	622	assert('find_next_ip_address("1.2.3.4", 2)', $result eq "1.2.3.6");
4e9a2b57	623
3713af1e	624	$result = &network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0");
cc9eb2d3	625	assert('network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0")', $result);
3713af1e MT	626
3713af1e MT	627	$result = &network_equal("192.168.0.0/24", "192.168.0.0/25");
cc9eb2d3	628	assert('network_equal("192.168.0.0/24", "192.168.0.0/25")', !$result);
3713af1e MT	629
3713af1e MT	630	$result = &network_equal("192.168.0.0/24", "192.168.0.128/25");
cc9eb2d3	631	assert('network_equal("192.168.0.0/24", "192.168.0.128/25")', !$result);
3713af1e MT	632
3713af1e MT	633	$result = &network_equal("192.168.0.1/24", "192.168.0.XXX/24");
cc9eb2d3	634	assert('network_equal("192.168.0.1/24", "192.168.0.XXX/24")', !$result);
3713af1e	635
4e9a2b57	636	$result = &ip_address_in_network("10.0.1.4", "10.0.0.0/8");
cc9eb2d3	637	assert('ip_address_in_network("10.0.1.4", "10.0.0.0/8"', $result);
4e9a2b57	638
01d61d15	639	$result = &ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0");
cc9eb2d3 PM	640	assert('ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0")', $result);
	641
	642	$result = &ip_address_in_network("192.168.30.11", "0.0.0.0/8");
	643	assert('ip_address_in_network("192.168.30.11", "0.0.0.0/8")', !$result);
01d61d15	644
3713af1e MT	645	print "Testsuite completed successfully!\n";
3713af1e MT	646
4e9a2b57 MT	647	return 0;
	648	}
	649
	650	&testsuite();