2 ############################################################################
4 # This file is part of the IPFire Firewall. #
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. #
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. #
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 #
20 # Copyright (C) 2014 IPFire Team <info@ipfire.org>. #
22 ############################################################################
26 require "/var/ipfire/general-functions.pl";
28 use experimental
'smartmatch';
31 # System ethernet configuration
32 our %ethernet_settings = ();
33 &General
::readhash
("${General::swroot}/ethernet/settings", \
%ethernet_settings);
35 # List of all possible network zones that can be configured
36 our @known_network_zones = ("red", "green", "orange", "blue");
38 # IPv4 netmask CIDR to dotted decimal notation conversion table
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",
75 my %NETMASK2PREFIX = reverse(%PREFIX2NETMASK);
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.
83 # This function returns undef for undefined input.
84 if (!defined $address) {
88 my $address_bin = &Socket
::inet_pton
(AF_INET
, $address);
90 $address_bin = unpack('N', $address_bin);
96 # Does the reverse of ip2bin().
97 # Will return undef for invalid inputs.
99 my $address_bin = shift;
101 # This function returns undef for undefined input.
102 if (!defined $address_bin) {
106 my $address = pack('N', $address_bin);
108 $address = &Socket
::inet_ntop
(AF_INET
, $address);
114 # Takes two network addresses, compares them against each other
115 # and returns true if equal or false if not
117 my $network1 = shift;
118 my $network2 = shift;
120 my @bin1 = &network2bin
($network1);
121 my @bin2 = &network2bin
($network2);
123 if (!defined $bin1 || !defined $bin2) {
127 if ($bin1[0] == $bin2[0] && $bin1[1] == $bin2[1]) {
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.
140 my ($address, $netmask) = split(/\//, $network, 2);
142 if (&check_prefix
($netmask)) {
143 $netmask = &convert_prefix2netmask
($netmask);
146 my $address_bin = &ip2bin
($address);
147 my $netmask_bin = &ip2bin
($netmask);
149 if (!defined $address_bin || !defined $netmask_bin) {
153 my $network_start = $address_bin & $netmask_bin;
155 return ($network_start, $netmask_bin);
158 # Deletes leading zeros in ip address
161 my @ip = split (/\./, $address);
163 foreach my $octet (@ip) {
164 $octet = int($octet);
167 $address = join (".", @ip);
171 # Returns True for all valid IP addresses
172 sub check_ip_address
($) {
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);
179 return ((defined $normalised_address) && ($address eq $normalised_address));
182 # Returns True for all valid prefixes.
183 sub check_prefix
($) {
186 return (exists $PREFIX2NETMASK{$prefix});
189 # Returns True for all valid subnet masks.
190 sub check_netmask
($) {
193 return (exists $NETMASK2PREFIX{$netmask});
196 # Returns True for all valid inputs like a.b.c.d/a.b.c.d.
197 sub check_ip_address_and_netmask
($$) {
200 my ($address, $netmask) = split(/\//, $network, 2);
202 # Check if the IP address is fine.
204 my $result = &check_ip_address
($address);
209 return &check_netmask
($netmask);
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
($) {
216 my ($address, $network) = split(/\//, $subnet, 2);
218 # Check if the IP address is fine.
219 my $result = &check_ip_address
($address);
224 return &check_prefix
($network) || &check_netmask
($network);
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
($) {
232 my $address_bin = &ip2bin
($address);
233 if (!defined $address_bin) {
237 return &bin2ip
($address_bin);
240 # Returns the prefix for the given subnet mask.
241 sub convert_netmask2prefix
($) {
244 if (exists $NETMASK2PREFIX{$netmask}) {
245 return $NETMASK2PREFIX{$netmask};
251 # Returns the subnet mask for the given prefix.
252 sub convert_prefix2netmask
($) {
255 if (exists $PREFIX2NETMASK{$prefix}) {
256 return $PREFIX2NETMASK{$prefix};
262 # Takes an IP address and an offset and
263 # will return the offset'th IP address.
264 sub find_next_ip_address
($$) {
268 my $address_bin = &ip2bin
($address);
269 $address_bin += $offset;
271 return &bin2ip
($address_bin);
274 # Returns the network address of the given network.
275 sub get_netaddress
($) {
277 my ($network_bin, $netmask_bin) = &network2bin
($network);
279 if (defined $network_bin) {
280 return &bin2ip
($network_bin);
286 # Returns the broadcast of the given network.
287 sub get_broadcast
($) {
289 my ($network_bin, $netmask_bin) = &network2bin
($network);
291 return &bin2ip
($network_bin ^ ~$netmask_bin);
294 # Returns True if $address is in $network.
295 sub ip_address_in_network
($$) {
299 my $address_bin = &ip2bin
($address);
300 return undef unless (defined $address_bin);
302 my ($network_bin, $netmask_bin) = &network2bin
($network);
305 my $broadcast_bin = $network_bin ^ (~$netmask_bin % 2 ** 32);
307 return (($address_bin >= $network_bin) && ($address_bin <= $broadcast_bin));
310 # Returns True if $ipaddress is within $ipstart and $ipend range.
311 sub ip_address_in_range
($$) {
312 my $ipaddress = shift;
316 my $ipaddress_bin = &ip2bin
($ipaddress);
317 return undef unless (defined $ipaddress_bin);
319 my $ipstart_bin = &ip2bin
($ipstart);
320 return undef unless (defined $ipstart_bin);
322 my $ipend_bin = &ip2bin
($ipend);
323 return undef unless (defined $ipend_bin);
325 return (($ipaddress_bin >= $ipstart_bin) && ($ipaddress_bin <= $ipend_bin));
328 sub setup_upstream_proxy
() {
329 my %proxysettings = ();
330 &General
::readhash
("${General::swroot}/proxy/settings", \
%proxysettings);
332 if ($proxysettings{'UPSTREAM_PROXY'}) {
333 my $credentials = "";
335 if ($proxysettings{'UPSTREAM_USER'}) {
336 $credentials = $proxysettings{'UPSTREAM_USER'};
338 if ($proxysettings{'UPSTREAM_PASSWORD'}) {
339 $credentials .= ":" . $proxysettings{'UPSTREAM_PASSWORD'};
345 my $proxy = "http://" . $credentials . $proxysettings{'UPSTREAM_PROXY'};
347 $ENV{'http_proxy'} = $proxy;
348 $ENV{'https_proxy'} = $proxy;
349 $ENV{'ftp_proxy'} = $proxy;
353 sub get_red_interfaces
() {
354 my $default = &General
::get_red_interface
();
360 opendir(INTERFACES
, "/sys/class/net");
362 while (my $intf = readdir(INTERFACES
)) {
363 if ($intf =~ m/^red[0-9]+$/) {
368 closedir(INTERFACES
);
370 return &General
::uniq
(@intfs);
373 sub list_wireless_interfaces
() {
376 opendir(INTERFACES
, "/sys/class/net");
379 while ($intf = readdir(INTERFACES
)) {
380 # Is this a wireless interface?
381 opendir(PHY80211
, "/sys/class/net/$intf/phy80211") or next;
384 # Read the MAC address
385 my $address = &get_nic_property
($intf, "address");
387 $interfaces{$address} = "$address ($intf)";
390 closedir(INTERFACES
);
395 my %wireless_status = ();
397 sub _get_wireless_status
($) {
400 if (!$wireless_status{$intf}) {
401 $wireless_status{$intf} = join('\n', &General
::system_output
("iwconfig", "$intf"));
404 return $wireless_status{$intf};
407 sub wifi_get_essid
($) {
408 my $status = &_get_wireless_status
(shift);
410 my ($essid) = $status =~ /ESSID:\"(.*)\"/;
415 sub wifi_get_frequency
($) {
416 my $status = &_get_wireless_status
(shift);
418 my ($frequency) = $status =~ /Frequency:(\d+\.\d+ GHz)/;
423 sub wifi_get_access_point
($) {
424 my $status = &_get_wireless_status
(shift);
426 my ($access_point) = $status =~ /Access Point: ([0-9A-F:]+)/;
428 return $access_point;
431 sub wifi_get_bit_rate
($) {
432 my $status = &_get_wireless_status
(shift);
434 my ($bit_rate) = $status =~ /Bit Rate=(\d+ [GM]b\/s)/;
439 sub wifi_get_link_quality
($) {
440 my $status = &_get_wireless_status
(shift);
442 my ($cur, $max) = $status =~ /Link Quality=(\d+)\/(\d
+)/;
445 return sprintf('%.0f', ($cur * 100) / $max);
451 sub wifi_get_signal_level
($) {
452 my $status = &_get_wireless_status
(shift);
454 my ($signal_level) = $status =~ /Signal level=(\-\d+ dBm)/;
456 return $signal_level;
459 sub get_hardware_address
($) {
460 my $ip_address = shift;
463 open(FILE
, "/proc/net/arp") or die("Could not read ARP table");
466 my ($ip_addr, $hwtype, $flags, $hwaddr, $mask, $device) = split(/\s+/, $_);
467 if ($ip_addr eq $ip_address) {
478 sub get_nic_property
{
480 my $property = shift;
483 open(FILE
, "/sys/class/net/$nicname/$property") or die("Could not read property $property for $nicname");
495 return $mac =~ /^([0-9A-Fa-f]{2}[:]){5}([0-9A-Fa-f]{2})$/;
498 # Compares two MAC addresses and returns true if they are equal
500 my $mac_1 = uc shift; # convert to upper case
501 my $mac_2 = uc shift;
503 if(valid_mac
($mac_1) && valid_mac
($mac_2) && ($mac_1 eq $mac_2)) {
514 $address = sprintf("$address:%02x", int(rand(255)));
520 sub get_mac_by_name
($) {
523 if ((!&valid_mac
($mac)) && ($mac ne "")) {
524 if (-e
"/sys/class/net/$mac/") {
525 $mac = get_nic_property
($mac, "address");
532 sub get_intf_by_address
($) {
535 opendir(INTERFACES
, "/sys/class/net");
537 while (my $intf = readdir(INTERFACES
)) {
538 next if ($intf eq "." or $intf eq "..");
540 my $intf_address = &get_nic_property
($intf, "address");
542 # Skip interfaces without addresses
543 next if ($intf_address eq "");
546 return $intf if ($intf_address eq $address);
549 closedir(INTERFACES
);
555 ## Function to get a list of all available network zones.
557 sub get_available_network_zones
() {
558 # Obtain the configuration type from the netsettings hash.
559 my $config_type = $ethernet_settings{'CONFIG_TYPE'};
561 # Hash which contains the conversation from the config mode
562 # to the existing network interface names. They are stored like
565 # Mode "0" red is a modem and green
566 # Mode "1" red is a netdev and green
567 # Mode "2" red, green and orange
568 # Mode "3" red, green and blue
569 # Mode "4" red, green, blue, orange
570 my %config_type_to_interfaces = (
571 "0" => [ "red", "green" ],
572 "1" => [ "red", "green" ],
573 "2" => [ "red", "green", "orange" ],
574 "3" => [ "red", "green", "blue" ],
575 "4" => [ "red", "green", "blue", "orange" ]
578 # Obtain and dereference the corresponding network interaces based on the read
579 # network config type.
580 my @network_zones = @
{ $config_type_to_interfaces{$config_type} };
583 return @network_zones;
587 ## Function to check if a network zone is available in the current configuration
589 sub is_zone_available
() {
592 # Make sure the zone is valid
593 die("Unknown network zone '$zone'") unless ($zone ~~ @known_network_zones);
595 # Get available zones and return result
596 my @available_zones = get_available_network_zones
();
597 return ($zone ~~ @available_zones);
601 ## Function to determine if the RED zone is in standard IP (or modem, PPP, VDSL, ...) mode
603 sub is_red_mode_ip
() {
604 # Obtain the settings from the netsettings hash
605 my $config_type = $ethernet_settings{'CONFIG_TYPE'};
606 my $red_type = $ethernet_settings{'RED_TYPE'};
608 # RED must be a network device (configuration 1-4) with dynamic or static IP
609 return (($config_type ~~ [1..4]) && ($red_type ~~ ["DHCP", "STATIC"]));
614 # Remove the next line to enable the testsuite
625 print "ASSERTION ERROR - $tst\n";
632 my $address1 = &ip2bin
("8.8.8.8");
633 assert
('ip2bin("8.8.8.8")', $address1 == 134744072);
635 my $address2 = &bin2ip
($address1);
636 assert
("bin2ip($address1)", $address2 eq "8.8.8.8");
638 # Check if valid IP addresses are correctly recognised.
639 foreach my $address ("1.2.3.4", "192.168.180.1", "127.0.0.1") {
640 if (!&check_ip_address
($address)) {
641 print "$address is not correctly recognised as a valid IP address!\n";
646 # Check if invalid IP addresses are correctly found.
647 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") {
648 if (&check_ip_address
($address)) {
649 print "$address is recognised as a valid IP address!\n";
654 $result = &check_ip_address_and_netmask
("192.168.180.0/255.255.255.0");
655 assert
('check_ip_address_and_netmask("192.168.180.0/255.255.255.0")', $result);
657 $result = &convert_netmask2prefix
("255.255.254.0");
658 assert
('convert_netmask2prefix("255.255.254.0")', $result == 23);
660 $result = &convert_prefix2netmask
(8);
661 assert
('convert_prefix2netmask(8)', $result eq "255.0.0.0");
663 $result = &find_next_ip_address
("1.2.3.4", 2);
664 assert
('find_next_ip_address("1.2.3.4", 2)', $result eq "1.2.3.6");
666 $result = &network_equal
("192.168.0.0/24", "192.168.0.0/255.255.255.0");
667 assert
('network_equal("192.168.0.0/24", "192.168.0.0/255.255.255.0")', $result);
669 $result = &network_equal
("192.168.0.0/24", "192.168.0.0/25");
670 assert
('network_equal("192.168.0.0/24", "192.168.0.0/25")', !$result);
672 $result = &network_equal
("192.168.0.0/24", "192.168.0.128/25");
673 assert
('network_equal("192.168.0.0/24", "192.168.0.128/25")', !$result);
675 $result = &network_equal
("192.168.0.1/24", "192.168.0.XXX/24");
676 assert
('network_equal("192.168.0.1/24", "192.168.0.XXX/24")', !$result);
678 $result = &ip_address_in_network
("10.0.1.4", "10.0.0.0/8");
679 assert
('ip_address_in_network("10.0.1.4", "10.0.0.0/8"', $result);
681 $result = &ip_address_in_network
("192.168.30.11", "192.168.30.0/255.255.255.0");
682 assert
('ip_address_in_network("192.168.30.11", "192.168.30.0/255.255.255.0")', $result);
684 $result = &ip_address_in_network
("192.168.30.11", "0.0.0.0/8");
685 assert
('ip_address_in_network("192.168.30.11", "0.0.0.0/8")', !$result);
687 $result = &ip_address_in_range
("192.168.30.11", "192.168.30.10", "192.168.30.20");
688 assert
('ip_address_in_range("192.168.30.11", "192.168.30.10", "192.168.30.20")', $result);
690 $result = &ip_address_in_range
("192.168.30.21", "192.168.30.10", "192.168.30.20");
691 assert
('ip_address_in_range("192.168.30.21", "192.168.30.10", "192.168.30.20")', !$result);
693 print "Testsuite completed successfully!\n";