config/cfgroot/general-functions.pl

   1 # SmoothWall CGIs
   2 #
   3 # This code is distributed under the terms of the GPL
   4 #
   5 # (c) The SmoothWall Team
   6 # Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
   7 # Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
   8 # Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
   9 # Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
  10 # Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
  11 #
  12 # $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
  13 #
  14
  15 package General;
  16
  17 use strict;
  18 use Socket;
  19 use IO::Socket;
  20 use Net::SSLeay;
  21 use Net::IPv4Addr qw(:all);
  22 $|=1; # line buffering
  23
  24 $General::version = 'VERSION';
  25 $General::swroot = 'CONFIG_ROOT';
  26 $General::noipprefix = 'noipg-';
  27
  28 require "${General::swroot}/network-functions.pl";
  29
  30 # This function executes a shell command without forking a shell or do any other
  31 # Perl-voodoo before it. It deprecates the "system" command and is the only way
  32 # to call shell commands.
  33 sub safe_system($) {
  34         my @command = @_;
  35
  36         system { ${command[0]} } @command;
  37
  38         # Return exit code
  39         return $? >> 8;
  40 }
  41
  42 # Calls a process in the background and returns nothing
  43 sub system_background($) {
  44         my $pid = fork();
  45
  46         unless ($pid) {
  47                 my $rc = &system(@_);
  48                 exit($rc);
  49         }
  50
  51         return 0;
  52 }
  53
  54 # Returns the output of a shell command
  55 sub system_output($) {
  56         my @command = @_;
  57         my $pid;
  58         my @output = ();
  59
  60         unless ($pid = open(OUTPUT, "-|")) {
  61                 open(STDERR, ">&STDOUT");
  62                 exec { ${command[0]} } @command;
  63                 die "Could not execute @command: $!";
  64         }
  65
  66         waitpid($pid, 0);
  67
  68         while (<OUTPUT>) {
  69                 push(@output, $_);
  70         }
  71         close(OUTPUT);
  72
  73         return @output;
  74 }
  75
  76 # Calls a shell command and throws away the output
  77 sub system($) {
  78         my @command = @_;
  79
  80         open(SAVEOUT, ">&STDOUT");
  81         open(SAVEERR, ">&STDERR");
  82
  83         open(STDOUT, ">/dev/null");
  84         open(STDERR, ">&STDOUT");
  85
  86         select(STDERR); $|=1;
  87         select(STDOUT); $|=1;
  88
  89         my $rc = &safe_system(@command);
  90
  91         close(STDOUT);
  92         close(STDERR);
  93
  94         # Restore
  95         open(STDOUT, ">&SAVEOUT");
  96         open(STDERR, ">&SAVEERR");
  97
  98         return $rc;
  99 }
 100
 101 # Function to remove duplicates from an array
 102 sub uniq { my %seen; grep !$seen{$_}++, @_ }
 103
 104 #
 105 # log ("message") use default 'ipcop' tag
 106 # log ("tag","message") use your tag
 107 #
 108 sub log
 109 {
 110         my $tag='ipfire';
 111         $tag = shift if (@_>1);
 112         my $logmessage = $_[0];
 113         $logmessage =~ /([\w\W]*)/;
 114         $logmessage = $1;
 115         &system('logger', '-t', $tag, $logmessage);
 116 }
 117 sub setup_default_networks
 118 {
 119         my %netsettings=();
 120         my $defaultNetworks = shift;
 121
 122         &readhash("/var/ipfire/ethernet/settings", \%netsettings);
 123
 124         # Get current defined networks (Red, Green, Blue, Orange)
 125         $defaultNetworks->{$Lang::tr{'fwhost any'}}{'IPT'} = "0.0.0.0/0.0.0.0";
 126         $defaultNetworks->{$Lang::tr{'fwhost any'}}{'NAME'} = "ALL";
 127
 128         $defaultNetworks->{$Lang::tr{'green'}}{'IPT'} = "$netsettings{'GREEN_NETADDRESS'}/$netsettings{'GREEN_NETMASK'}";
 129         $defaultNetworks->{$Lang::tr{'green'}}{'NET'} = "$netsettings{'GREEN_ADDRESS'}";
 130         $defaultNetworks->{$Lang::tr{'green'}}{'NAME'} = "GREEN";
 131
 132         if ($netsettings{'RED_DEV'} ne ''){
 133                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'IPT'} = "$netsettings{'RED_NETADDRESS'}/$netsettings{'RED_NETMASK'}";
 134                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NET'} = "$netsettings{'RED_ADDRESS'}";
 135                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NAME'} = "RED";
 136         }
 137         if ($netsettings{'ORANGE_DEV'} ne ''){
 138                 $defaultNetworks->{$Lang::tr{'orange'}}{'IPT'} = "$netsettings{'ORANGE_NETADDRESS'}/$netsettings{'ORANGE_NETMASK'}";
 139                 $defaultNetworks->{$Lang::tr{'orange'}}{'NET'} = "$netsettings{'ORANGE_ADDRESS'}";
 140                 $defaultNetworks->{$Lang::tr{'orange'}}{'NAME'} = "ORANGE";
 141         }
 142
 143         if ($netsettings{'BLUE_DEV'} ne ''){
 144                 $defaultNetworks->{$Lang::tr{'blue'}}{'IPT'} = "$netsettings{'BLUE_NETADDRESS'}/$netsettings{'BLUE_NETMASK'}";
 145                 $defaultNetworks->{$Lang::tr{'blue'}}{'NET'} = "$netsettings{'BLUE_ADDRESS'}";
 146                 $defaultNetworks->{$Lang::tr{'blue'}}{'NAME'} = "BLUE";
 147         }
 148
 149         #IPFire himself
 150         $defaultNetworks->{'IPFire'}{'NAME'} = "IPFire";
 151
 152         # OpenVPN
 153         if(-e "${General::swroot}/ovpn/settings")
 154         {
 155                 my %ovpnSettings = ();
 156                 &readhash("${General::swroot}/ovpn/settings", \%ovpnSettings);
 157
 158                 # OpenVPN on Red?
 159                 if(defined($ovpnSettings{'DOVPN_SUBNET'}))
 160                 {
 161                         my ($ip,$sub) = split(/\//,$ovpnSettings{'DOVPN_SUBNET'});
 162                         $sub=&General::iporsubtocidr($sub);
 163                         my @tempovpnsubnet = split("\/", $ovpnSettings{'DOVPN_SUBNET'});
 164                         $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'ADR'} = $tempovpnsubnet[0];
 165                         $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'NAME'} = "OpenVPN-Dyn";
 166                 }
 167         } # end OpenVPN
 168         # IPsec RW NET
 169         if(-e "${General::swroot}/vpn/settings")
 170         {
 171                 my %ipsecsettings = ();
 172                 &readhash("${General::swroot}/vpn/settings", \%ipsecsettings);
 173                 if($ipsecsettings{'RW_NET'} ne '')
 174                 {
 175                         my ($ip,$sub) = split(/\//,$ipsecsettings{'RW_NET'});
 176                         $sub=&General::iporsubtocidr($sub);
 177                         my @tempipsecsubnet = split("\/", $ipsecsettings{'RW_NET'});
 178                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'ADR'} = $tempipsecsubnet[0];
 179                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NAME'} = "IPsec RW";
 180                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NET'} = &getnextip($ip);
 181                 }
 182         }
 183 }
 184 sub get_aliases
 185 {
 186
 187         my $defaultNetworks = shift;
 188         open(FILE, "${General::swroot}/ethernet/aliases") or die 'Unable to open aliases file.';
 189         my @current = <FILE>;
 190         close(FILE);
 191         my $ctr = 0;
 192         foreach my $line (@current)
 193         {
 194                 if ($line ne ''){
 195                         chomp($line);
 196                         my @temp = split(/\,/,$line);
 197                         if ($temp[2] eq '') {
 198                                 $temp[2] = "Alias $ctr : $temp[0]";
 199                         }
 200                         $defaultNetworks->{$temp[2]}{'IPT'} = "$temp[0]";
 201                         $defaultNetworks->{$temp[2]}{'NET'} = "$temp[0]";
 202
 203                         $ctr++;
 204                 }
 205         }
 206 }
 207
 208 sub readhash
 209 {
 210         my $filename = $_[0];
 211         my $hash = $_[1];
 212         my ($var, $val);
 213
 214
 215         # Some ipcop code expects that readhash 'complete' the hash if new entries
 216         # are presents. Not clear it !!!
 217         #%$hash = ();
 218
 219         open(FILE, $filename) or die "Unable to read file $filename";
 220
 221         while (<FILE>)
 222         {
 223                 chop;
 224
 225                 # Skip comments.
 226                 next if ($_ =~ /^#/);
 227
 228                 ($var, $val) = split /=/, $_, 2;
 229                 if ($var)
 230                 {
 231                         $val =~ s/^\'//g;
 232                         $val =~ s/\'$//g;
 233
 234                         # Untaint variables read from hash
 235                         # trim space from begin and end
 236                         $var =~ s/^\s+//;
 237                         $var =~ s/\s+$//;
 238                         $var =~ /([A-Za-z0-9_-]*)/;
 239                         $var = $1;
 240                         $val =~ /([\w\W]*)/;
 241                         $val = $1;
 242                         $hash->{$var} = $val;
 243                 }
 244         }
 245         close FILE;
 246 }
 247
 248
 249 sub writehash
 250 {
 251         my $filename = $_[0];
 252         my $hash = $_[1];
 253         my ($var, $val);
 254
 255         # write cgi vars to the file.
 256         open(FILE, ">${filename}") or die "Unable to write file $filename";
 257         flock FILE, 2;
 258         foreach $var (keys %$hash)
 259         {
 260                 if ( $var eq "__CGI__"){next;}
 261                 $val = $hash->{$var};
 262                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 263                 # location of the mouse are submitted as well, this was being written to the settings file causing
 264                 # some serious grief! This skips the variable.x and variable.y
 265                 if (!($var =~ /(.x|.y)$/)) {
 266                         if ($val =~ / /) {
 267                                 $val = "\'$val\'"; }
 268                         if (!($var =~ /^ACTION/)) {
 269                                 print FILE "${var}=${val}\n"; }
 270                 }
 271         }
 272         close FILE;
 273 }
 274
 275 sub writehashpart
 276 {
 277         # This function replaces the given hash in the original hash by keeping the old
 278         # content and just replacing the new content
 279
 280         my $filename = $_[0];
 281         my $newhash = $_[1];
 282         my %oldhash;
 283         my ($var, $val);
 284
 285         readhash("${filename}", \%oldhash);
 286
 287         foreach $var (keys %$newhash){
 288                 $oldhash{$var}=$newhash->{$var};
 289         }
 290
 291         # write cgi vars to the file.
 292         open(FILE, ">${filename}") or die "Unable to write file $filename";
 293         flock FILE, 2;
 294         foreach $var (keys %oldhash)
 295         {
 296                 if ( $var eq "__CGI__"){next;}
 297                 $val = $oldhash{$var};
 298                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 299                 # location of the mouse are submitted as well, this was being written to the settings file causing
 300                 # some serious grief! This skips the variable.x and variable.y
 301                 if (!($var =~ /(.x|.y)$/)) {
 302                         if ($val =~ / /) {
 303                                 $val = "\'$val\'"; }
 304                         if (!($var =~ /^ACTION/)) {
 305                                 print FILE "${var}=${val}\n"; }
 306                 }
 307         }
 308         close FILE;
 309 }
 310
 311 sub age {
 312         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 313                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 314         my $t = time() - $mtime;
 315
 316         return &format_time($t);
 317 }
 318
 319 sub format_time($) {
 320         my $totalsecs = shift;
 321         my @s = ();
 322
 323         my $secs = $totalsecs % 60;
 324         $totalsecs /= 60;
 325         if ($secs > 0) {
 326                 push(@s, "${secs}s");
 327         }
 328
 329         my $min = $totalsecs % 60;
 330         $totalsecs /= 60;
 331         if ($min > 0) {
 332                 push(@s, "${min}m");
 333         }
 334
 335         my $hrs = $totalsecs % 24;
 336         $totalsecs /= 24;
 337         if ($hrs > 0) {
 338                 push(@s, "${hrs}h");
 339         }
 340
 341         my $days = int($totalsecs);
 342         if ($days > 0) {
 343                 push(@s, "${days}d");
 344         }
 345
 346         return join(" ", reverse(@s));
 347 }
 348
 349 sub validip
 350 {
 351         my $ip = $_[0];
 352
 353         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 354                 return 0; }
 355         else
 356         {
 357                 my @octets = ($1, $2, $3, $4);
 358                 foreach $_ (@octets)
 359                 {
 360                         if (/^0./) {
 361                                 return 0; }
 362                         if ($_ < 0 || $_ > 255) {
 363                                 return 0; }
 364                 }
 365                 return 1;
 366         }
 367 }
 368
 369 sub validmask {
 370         my $mask = shift;
 371
 372         return &Network::check_netmask($mask) || &Network::check_prefix($mask);
 373 }
 374
 375 sub validipormask
 376 {
 377         my $ipormask = $_[0];
 378
 379         # see if it is a IP only.
 380         if (&validip($ipormask)) {
 381                 return 1; }
 382         # split it into number and mask.
 383         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 384                 return 0; }
 385         my $ip = $1;
 386         my $mask = $2;
 387         # first part not a ip?
 388         if (!(&validip($ip))) {
 389                 return 0; }
 390         return &validmask($mask);
 391 }
 392
 393 sub subtocidr {
 394         return &Network::convert_netmask2prefix(shift);
 395 }
 396
 397 sub cidrtosub {
 398         return &Network::convert_prefix2netmask(shift);
 399 }
 400
 401 sub iporsubtodec
 402 {
 403         #Gets: Ip address or subnetmask in decimal oder CIDR
 404         #Gives: What it gets only in CIDR format
 405         my $subnet=$_[0];
 406         my $net;
 407         my $mask;
 408         my $full=0;
 409         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 410                 ($net,$mask) = split (/\//,$subnet);
 411                 $full=1;
 412                 return "$subnet";
 413         }else{
 414                 $mask=$subnet;
 415         }
 416         #Subnet already in decimal and valid?
 417         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 418                 for (my $i=0;$i<=32;$i++){
 419                         if (&General::cidrtosub($i) eq $mask){
 420                                 if ($full == 0){return $mask;}else{
 421                                                          return $net."/".$mask;
 422                                 }
 423                         }
 424                 }
 425         }
 426         #Subnet in binary format?
 427         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 428                         if($full == 0){ return &General::cidrtosub($mask);}else{
 429                                                  return $net."/".&General::cidrtosub($mask);
 430                         }
 431         }else{
 432                         return 3;
 433         }
 434         return 3;
 435 }
 436
 437
 438 sub iporsubtocidr
 439 {
 440         #gets: Ip Address  or subnetmask in decimal oder CIDR
 441         #Gives: What it gets only in CIDR format
 442         my $subnet=$_[0];
 443         my $net;
 444         my $mask;
 445         my $full=0;
 446         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 447                 ($net,$mask) = split (/\//,$subnet);
 448                 $full=1;
 449         }else{
 450                 $mask=$subnet;
 451         }
 452         #Subnet in decimal and valid?
 453         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 454                 for (my $i=0;$i<=32;$i++){
 455                         if (&General::cidrtosub($i) eq $mask){
 456                                 if ($full == 0){return &General::subtocidr($mask);}else{
 457                                                          return $net."/".&General::subtocidr($mask);
 458                                 }
 459                         }
 460                 }
 461         }
 462         #Subnet already in binary format?
 463         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 464                         if($full == 0){ return $mask;}else{
 465                                                  return $net."/".$mask;
 466                         }
 467         }else{
 468                         return 3;
 469         }
 470         return 3;
 471 }
 472
 473 sub getnetworkip {
 474         my $arg = join("/", @_);
 475
 476         return &Network::get_netaddress($arg);
 477 }
 478
 479 sub getccdbc
 480 {
 481         #Gets: IP in Form ("192.168.0.0/24")
 482         #Gives: Broadcastaddress of network
 483         my $ccdnet=$_;
 484         my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
 485         my $ip_address_binary = inet_aton( $ccdip );
 486         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 487         my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
 488         return $broadcast_address;
 489 }
 490
 491 sub ip2dec  {
 492         return &Network::ip2bin(shift);
 493 }
 494
 495 sub dec2ip  {
 496         return &Network::bin2ip(shift);
 497 }
 498
 499 sub getnextip {
 500         return &Network::find_next_ip_address(shift, 4);
 501 }
 502
 503 sub getlastip {
 504         return &Network::find_next_ip_address(shift, -1);
 505 }
 506
 507 sub validipandmask
 508 {
 509         #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
 510         #Gives: True bzw 0 if success or false
 511         my $ccdnet=$_[0];
 512         my $subcidr;
 513
 514         if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
 515                 return 0;
 516         }
 517         my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
 518         #IP valid?
 519         if ($ccdip=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1>0 && $1<=255 && $2>=0 && $2<=255 && $3>=0 && $3<=255 && $4<=255 ))) {
 520                 #Subnet in decimal and valid?
 521                 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
 522                         for (my $i=0;$i<=32;$i++){
 523                                 if (&General::cidrtosub($i) eq $ccdsubnet){
 524                                         return 1;
 525                                 }
 526                         }
 527                 #Subnet already in binary format?
 528                 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 529                         return 1;
 530                 }else{
 531                         return 0;
 532                 }
 533
 534         }
 535         return 0;
 536 }
 537
 538 sub checksubnets
 539 {
 540         my %ccdconfhash=();
 541         my %ovpnconfhash=();
 542         my %vpnconf=();
 543         my %ipsecconf=();
 544         my %ownnet=();
 545         my %ovpnconf=();
 546         my @ccdconf=();
 547         my $ccdname=$_[0];
 548         my $ccdnet=$_[1];
 549         my $ownnet=$_[2];
 550         my $checktype=$_[3];
 551         my $errormessage;
 552         my ($ip,$cidr)=split(/\//,$ccdnet);
 553         $cidr=&iporsubtocidr($cidr);
 554
 555         #get OVPN-Subnet (dynamic range)
 556         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 557         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 558         $ovpncidr=&iporsubtocidr($ovpncidr);
 559
 560         #check if we try to use same network as ovpn server
 561         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 562                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 563                         return $errormessage;
 564         }
 565
 566         #check if we try to use same network as another ovpn N2N
 567         if($ownnet ne 'ovpn'){
 568                 &readhasharray("${General::swroot}/ovpn/ovpnconfig", \%ovpnconfhash);
 569                 foreach my $key (keys %ovpnconfhash) {
 570                         if ($ovpnconfhash{$key}[3] eq 'net'){
 571                                 my @ovpnnet=split (/\//,$ovpnconfhash{$key}[11]);
 572                                 if (&IpInSubnet($ip,$ovpnnet[0],&iporsubtodec($ovpnnet[1]))){
 573                                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnn2n'}." $ovpnconfhash{$key}[1] <br>";
 574                                         return $errormessage;
 575                                 }
 576                         }
 577                 }
 578         }
 579
 580         #check if we use a network-name/subnet (static-ovpn) that already exists
 581         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 582         foreach my $key (keys %ccdconfhash) {
 583                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 584                 if ($ccdname eq $ccdconfhash{$key}[0])
 585                 {
 586                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 587                         return $errormessage;
 588                 }
 589                 my ($newip,$newsub) = split(/\//,$ccdnet);
 590                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 591                 {
 592                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
 593                         return $errormessage;
 594                 }
 595         }
 596
 597         #check if we use a ipsec right network which is already defined
 598         if($ownnet ne 'ipsec'){
 599                 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 600                 foreach my $key (keys %ipsecconf){
 601                         if ($ipsecconf{$key}[11] ne '' && $ipsecconf{$key}[36] eq ""){
 602                                 foreach my $ipsecsubitem (split(/\|/, $ipsecconf{$key}[11])) {
 603                                         my ($ipsecip,$ipsecsub) = split (/\//, $ipsecsubitem);
 604                                         $ipsecsub=&iporsubtodec($ipsecsub);
 605                                         if($ipsecconf{$key}[1] ne $ccdname){
 606                                                 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 607                                                         $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
 608                                                         return $errormessage;
 609                                                 }
 610                                         }
 611                                 }
 612                         }
 613                 }
 614         }
 615
 616         #check if we use the ipsec RW Network (if defined)
 617         &readhash("${General::swroot}/vpn/settings", \%vpnconf);
 618         if ($vpnconf{'RW_NET'} ne ''){
 619                 my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
 620                 if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
 621                 {
 622                         $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
 623                         return $errormessage;
 624                 }
 625         }
 626
 627         #call check_net_internal
 628         if ($checktype eq "exact")
 629         {
 630                 &General::check_net_internal_exact($ccdnet);
 631         }else{
 632                 &General::check_net_internal_range($ccdnet);
 633         }
 634 }
 635
 636 sub check_net_internal_range{
 637         my $network=shift;
 638         my ($ip,$cidr)=split(/\//,$network);
 639         my %ownnet=();
 640         my $errormessage;
 641         $cidr=&iporsubtocidr($cidr);
 642         #check if we use one of ipfire's networks (green,orange,blue)
 643         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 644         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'GREEN_NETADDRESS'},&iporsubtodec($ownnet{'GREEN_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 645         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'ORANGE_NETADDRESS'},&iporsubtodec($ownnet{'ORANGE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 646         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'BLUE_NETADDRESS'},&iporsubtodec($ownnet{'BLUE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 647         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'RED_NETADDRESS'},&iporsubtodec($ownnet{'RED_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 648 }
 649
 650 sub check_net_internal_exact{
 651         my $network=shift;
 652         my ($ip,$cidr)=split(/\//,$network);
 653         my %ownnet=();
 654         my $errormessage;
 655         $cidr=&iporsubtocidr($cidr);
 656         #check if we use one of ipfire's networks (green,orange,blue)
 657         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 658         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &Network::network_equal("$ownnet{'GREEN_NETADDRESS'}/$ownnet{'GREEN_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 659         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &Network::network_equal("$ownnet{'ORANGE_NETADDRESS'}/$ownnet{'ORANGE_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 660         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &Network::network_equal("$ownnet{'BLUE_NETADDRESS'}/$ownnet{'BLUE_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 661         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &Network::network_equal("$ownnet{'RED_NETADDRESS'}/$ownnet{'RED_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 662 }
 663
 664 sub validport
 665 {
 666         $_ = $_[0];
 667
 668         if (!/^\d+$/) {
 669                 return 0; }
 670         if (/^0./) {
 671                 return 0; }
 672         if ($_ >= 1 && $_ <= 65535) {
 673                 return 1; }
 674         return 0;
 675 }
 676
 677 sub validproxyport
 678 {
 679         $_ = $_[0];
 680
 681         if (!/^\d+$/) {
 682                 return 0; }
 683         if (/^0./) {
 684                 return 0; }
 685         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 686                 return 0; }
 687         elsif ($_ >= 1 && $_ <= 65535) {
 688                 return 1; }
 689         return 0;
 690 }
 691
 692 sub validmac
 693 {
 694         my $checkmac = $_[0];
 695         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 696         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 697         {
 698                 return 0;
 699         }
 700         return 1;
 701 }
 702
 703 sub validhostname
 704 {
 705         # Checks a hostname against RFC1035
 706         my $hostname = $_[0];
 707
 708         # Hostname should be at least one character in length
 709         # but no more than 63 characters
 710         if (length ($hostname) < 1 || length ($hostname) > 63) {
 711                 return 0;}
 712         # Only valid characters are a-z, A-Z, 0-9 and -
 713         if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
 714                 return 0;}
 715         # First character can only be a letter or a digit
 716         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 717                 return 0;}
 718         # Last character can only be a letter or a digit
 719         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 720                 return 0;}
 721         return 1;
 722 }
 723
 724 sub validdomainname
 725 {
 726         my $part;
 727
 728         # Checks a domain name against RFC1035 and RFC2181
 729         my $domainname = $_[0];
 730         my @parts = split (/\./, $domainname);  # Split domain name at the '.'
 731
 732         foreach $part (@parts) {
 733                 # Each part should be at least one character in length
 734                 # but no more than 63 characters
 735                 if (length ($part) < 1 || length ($part) > 63) {
 736                         return 0;}
 737                 # Only valid characters are a-z, A-Z, 0-9, _ and -
 738                 if ($part !~ /^[a-zA-Z0-9_-]*$/) {
 739                         return 0;}
 740         }
 741         return 1;
 742 }
 743
 744 sub validfqdn
 745 {
 746         # Checks a fully qualified domain name against RFC1035 and RFC2181
 747         my $fqdn = $_[0];
 748         my @parts = split (/\./, $fqdn);        # Split FQDN at the '.'
 749         if (scalar(@parts) < 2) {               # At least two parts should
 750                 return 0;}                      # exist in a FQDN
 751                                                 # (i.e.hostname.domain)
 752
 753         for (my $index=0; $index < scalar(@parts); $index++) {
 754                 # Each part should be at least one character in length
 755                 # but no more than 63 characters
 756                 if (length ($parts[$index]) < 1 || length ($parts[$index]) > 63) {
 757                         return 0;}
 758                 if ($index eq 0) {
 759                         # This is the hostname part
 760                         # Only valid characters are a-z, A-Z, 0-9 and -
 761                         if ($parts[$index] !~ /^[a-zA-Z0-9-]*$/) {
 762                                 return 0;}
 763                         # First character can only be a letter or a digit
 764                         if (substr ($parts[$index], 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 765                                 return 0;}
 766                         # Last character can only be a letter or a digit
 767                         if (substr ($parts[$index], -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 768                                 return 0;}
 769                 } else{
 770                         # This is the domain part
 771                         # Only valid characters are a-z, A-Z, 0-9, _ and -
 772                         if ($parts[$index] !~ /^[a-zA-Z0-9_-]*$/) {
 773                                 return 0;}
 774                 }
 775         }
 776         return 1;
 777 }
 778
 779 sub validportrange # used to check a port range
 780 {
 781         my $port = $_[0]; # port values
 782         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 783         my $srcdst = $_[1]; # is it a source or destination port
 784
 785         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 786
 787                 if (!(&validport($port))) {
 788                         if ($srcdst eq 'src'){
 789                                 return $Lang::tr{'source port numbers'};
 790                         } else  {
 791                                 return $Lang::tr{'destination port numbers'};
 792                         }
 793                 }
 794         }
 795         else
 796         {
 797                 my @ports = ($1, $2);
 798                 if ($1 >= $2){
 799                         if ($srcdst eq 'src'){
 800                                 return $Lang::tr{'bad source range'};
 801                         } else  {
 802                                 return $Lang::tr{'bad destination range'};
 803                         }
 804                 }
 805                 foreach $_ (@ports)
 806                 {
 807                         if (!(&validport($_))) {
 808                                 if ($srcdst eq 'src'){
 809                                         return $Lang::tr{'source port numbers'};
 810                                 } else  {
 811                                         return $Lang::tr{'destination port numbers'};
 812                                 }
 813                         }
 814                 }
 815                 return;
 816         }
 817 }
 818
 819 sub IpInSubnet {
 820         my $addr = shift;
 821         my $network = shift;
 822         my $netmask = shift;
 823
 824         return &Network::ip_address_in_network($addr, "$network/$netmask");
 825 }
 826
 827 #
 828 # Return the following IP (IP+1) in dotted notation.
 829 # Call: NextIP ('1.1.1.1');
 830 # Return: '1.1.1.2'
 831 #
 832 sub NextIP {
 833         return &Network::find_next_ip_address(shift, 1);
 834 }
 835
 836 sub NextIP2 {
 837         return &Network::find_next_ip_address(shift, 4);
 838 }
 839
 840 sub ipcidr {
 841         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 842         return "$ip\/$cidr";
 843 }
 844
 845 sub ipcidr2msk {
 846        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 847        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 848        return "$ip\/$netmask";
 849 }
 850
 851 sub validemail {
 852     my $address = shift;
 853     my @parts = split( /\@/, $address );
 854     my $count=@parts;
 855
 856     #check if we have one part before and after '@'
 857     return 0 if ( $count != 2 );
 858
 859     #check if one of the parts starts or ends with a dot
 860     return 0 if ( substr($parts[0],0,1) eq '.' );
 861     return 0 if ( substr($parts[0],-1,1) eq '.' );
 862     return 0 if ( substr($parts[1],0,1) eq '.' );
 863     return 0 if ( substr($parts[1],-1,1) eq '.' );
 864
 865     #check first addresspart (before '@' sign)
 866     return 0 if  ( $parts[0] !~ m/^[a-zA-Z0-9\.!\-\_\+#]+$/ );
 867
 868     #check second addresspart (after '@' sign)
 869     return 0 if  ( $parts[1] !~ m/^[a-zA-Z0-9\.\-]+$/ );
 870
 871     return 1;
 872 }
 873
 874 #
 875 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 876 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 877 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 878 #
 879 sub readhasharray {
 880     my ($filename, $hash) = @_;
 881     %$hash = ();
 882
 883     open(FILE, $filename) or die "Unable to read file $filename";
 884
 885     while (<FILE>) {
 886         my ($key, $rest, @temp);
 887         chomp;
 888         ($key, $rest) = split (/,/, $_, 2);
 889         if ($key =~ /^[0-9]+$/) {
 890             @temp = split (/,/, $rest);
 891             $hash->{$key} = \@temp;
 892         }
 893     }
 894     close FILE;
 895     return;
 896 }
 897
 898 sub writehasharray {
 899     my ($filename, $hash) = @_;
 900     my ($key, @temp, $i);
 901
 902     open(FILE, ">$filename") or die "Unable to write to file $filename";
 903
 904     foreach $key (keys %$hash) {
 905                 if ($key =~ /^[0-9]+$/) {
 906                         print FILE "$key";
 907                         foreach $i (0 .. $#{$hash->{$key}}) {
 908                                 print FILE ",$hash->{$key}[$i]";
 909                         }
 910                         print FILE "\n";
 911                 }
 912     }
 913     close FILE;
 914     return;
 915 }
 916
 917 sub findhasharraykey {
 918     foreach my $i (1 .. 1000000) {
 919         if ( ! exists $_[0]{$i}) {
 920              return $i;
 921         }
 922     }
 923 }
 924
 925 sub srtarray
 926 # Darren Critchley - darrenc@telus.net - (c) 2003
 927 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 928 # This subroutine will take the following parameters:
 929 #   ColumnNumber = the column which you want to sort on, starts at 1
 930 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 931 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 932 #   ArrayToBeSorted = the array that wants sorting
 933 #
 934 #   Returns an array that is sorted to your specs
 935 #
 936 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 937 #
 938 {
 939         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 940         my @tmparray;
 941         my @srtedarray;
 942         my $line;
 943         my $newline;
 944         my $ctr;
 945         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 946         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 947                 return (@tobesorted);
 948         }
 949         my @tmp = split(/\,/,$tobesorted[0]);
 950         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 951
 952         # Darren Critchley - validate parameters
 953         if ($colno > $ttlitems){$colno = '1';}
 954         $colno--; # remove one from colno to deal with arrays starting at 0
 955         if($colno < 0){$colno = '0';}
 956         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 957         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 958
 959         foreach $line (@tobesorted)
 960         {
 961                 chomp($line);
 962                 if ($line ne '') {
 963                         my @temp = split(/\,/,$line);
 964                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 965                         my $tmpholder = $temp[0];
 966                         $temp[0] = $temp[$colno];
 967                         $temp[$colno] = $tmpholder;
 968                         $newline = "";
 969                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 970                                 $newline=$newline . $temp[$ctr] . ",";
 971                         }
 972                         chop($newline);
 973                         push(@tmparray,$newline);
 974                 }
 975         }
 976         if ($alpnum eq 'n') {
 977                 @tmparray = sort {$a <=> $b} @tmparray;
 978         } else {
 979                 @tmparray = (sort @tmparray);
 980         }
 981         foreach $line (@tmparray)
 982         {
 983                 chomp($line);
 984                 if ($line ne '') {
 985                         my @temp = split(/\,/,$line);
 986                         my $tmpholder = $temp[0];
 987                         $temp[0] = $temp[$colno];
 988                         $temp[$colno] = $tmpholder;
 989                         $newline = "";
 990                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 991                                 $newline=$newline . $temp[$ctr] . ",";
 992                         }
 993                         chop($newline);
 994                         push(@srtedarray,$newline);
 995                 }
 996         }
 997
 998         if ($srtdir eq 'dsc') {
 999                 @tmparray = reverse(@srtedarray);
1000                 return (@tmparray);
1001         } else {
1002                 return (@srtedarray);
1003         }
1004 }
1005
1006 sub FetchPublicIp {
1007     my %proxysettings;
1008     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
1009     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
1010         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
1011         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
1012     }
1013     my $user_agent = &MakeUserAgent();
1014     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
1015                                                     80,
1016                                                     "/",
1017                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
1018                                                 );
1019     if ($response =~ m%HTTP/1\.. 200 OK%) {
1020         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
1021         return $1;
1022     }
1023     return '';
1024 }
1025
1026 #
1027 # Check if hostname.domain provided have IP provided
1028 # use gethostbyname to verify that
1029 # Params:
1030 #       IP
1031 #       hostname
1032 #       domain
1033 # Output
1034 #       1 IP matches host.domain
1035 #       0 not in sync
1036 #
1037 sub DyndnsServiceSync ($;$;$) {
1038
1039     my ($ip,$hostName,$domain) = @_;
1040     my @addresses;
1041
1042     #fix me no ip GROUP, what is the name ?
1043     $hostName =~ s/$General::noipprefix//;
1044     if ($hostName) { #may be empty
1045         $hostName = "$hostName.$domain";
1046         @addresses = gethostbyname($hostName);
1047     }
1048
1049     if ($addresses[0] eq '') {                  # nothing returned ?
1050         $hostName = $domain;                    # try resolving with domain only
1051         @addresses = gethostbyname($hostName);
1052     }
1053
1054     if ($addresses[0] ne '') {                  # got something ?
1055         #&General::log("name:$addresses[0], alias:$addresses[1]");
1056         # Build clear text list of IP
1057         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
1058         if (grep (/$ip/, @addresses)) {
1059             return 1;
1060         }
1061     }
1062     return 0;
1063 }
1064 #
1065 # This sub returns the red IP used to compare in DyndnsServiceSync
1066 #
1067 sub GetDyndnsRedIP {
1068     my %settings;
1069     &General::readhash("${General::swroot}/ddns/settings", \%settings);
1070
1071     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
1072     my $ip = <IP>;
1073     close(IP);
1074     chomp $ip;
1075
1076     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
1077     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
1078         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
1079         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
1080         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
1081     {
1082         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
1083             my $RealIP = &General::FetchPublicIp;
1084             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
1085         }
1086     }
1087     return $ip;
1088 }
1089
1090 # Translate ICMP code to text
1091 # ref: http://www.iana.org/assignments/icmp-parameters
1092 sub GetIcmpDescription ($) {
1093     my $index = shift;
1094     my @icmp_description = (
1095     'Echo Reply',                       #0
1096     'Unassigned',
1097     'Unassigned',
1098     'Destination Unreachable',
1099     'Source Quench',
1100     'Redirect',
1101     'Alternate Host Address',
1102     'Unassigned',
1103     'Echo',
1104     'Router Advertisement',
1105     'Router Solicitation',              #10
1106     'Time Exceeded',
1107     'Parameter Problem',
1108     'Timestamp',
1109     'Timestamp Reply',
1110     'Information Request',
1111     'Information Reply',
1112     'Address Mask Request',
1113     'Address Mask Reply',
1114     'Reserved (for Security)',
1115     'Reserved (for Robustness Experiment)', #20
1116     'Reserved',
1117     'Reserved',
1118     'Reserved',
1119     'Reserved',
1120     'Reserved',
1121     'Reserved',
1122     'Reserved',
1123     'Reserved',
1124     'Reserved',
1125     'Traceroute',                               #30
1126     'Datagram Conversion Error',
1127     'Mobile Host Redirect',
1128     'IPv6 Where-Are-You',
1129     'IPv6 I-Am-Here',
1130     'Mobile Registration Request',
1131     'Mobile Registration Reply',
1132     'Domain Name Request',
1133     'Domain Name Reply',
1134     'SKIP',
1135     'Photur',                           #40
1136     'Experimental');
1137     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1138 }
1139
1140 sub GetCoreUpdateVersion() {
1141         my $core_update;
1142
1143         open(FILE, "/opt/pakfire/db/core/mine");
1144         while (<FILE>) {
1145                 $core_update = $_;
1146                 last;
1147         }
1148         close(FILE);
1149
1150         return $core_update;
1151 }
1152
1153 sub MakeUserAgent() {
1154         my $user_agent = "IPFire/$General::version";
1155
1156         my $core_update = &GetCoreUpdateVersion();
1157         if ($core_update ne "") {
1158                 $user_agent .= "/$core_update";
1159         }
1160
1161         return $user_agent;
1162 }
1163
1164 sub RedIsWireless() {
1165         # This function checks if a network device is a wireless device.
1166
1167         my %settings = ();
1168         &readhash("${General::swroot}/ethernet/settings", \%settings);
1169
1170         # Find the name of the network device.
1171         my $device = $settings{'RED_DEV'};
1172
1173         # Exit, if no device is configured.
1174         return 0 if ($device eq "");
1175
1176         # Return 1 if the device is a wireless one.
1177         my $path = "/sys/class/net/$device/wireless";
1178         if (-d $path) {
1179                 return 1;
1180         }
1181
1182         # Otherwise return zero.
1183         return 0;
1184 }
1185
1186 # Function to read a file with UTF-8 charset.
1187 sub read_file_utf8 ($) {
1188         my ($file) = @_;
1189
1190         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1191         local $/ = undef;
1192         my $all = <$in>;
1193         close $in;
1194
1195         return $all;
1196 }
1197
1198 # Function to write a file with UTF-8 charset.
1199 sub write_file_utf8 ($) {
1200         my ($file, $content) = @_;
1201
1202         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1203         print $out $content;
1204         close $out;
1205
1206         return;
1207 }
1208
1209 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1210
1211 sub firewall_config_changed() {
1212         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1213         close FILE;
1214 }
1215
1216 sub firewall_needs_reload() {
1217         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1218                 return 1;
1219         }
1220
1221         return 0;
1222 }
1223
1224 sub firewall_reload() {
1225         &system("/usr/local/bin/firewallctrl");
1226 }
1227
1228 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1229 # if you change this also check speed.cgi that include a local copy for systemload reasons
1230 sub get_red_interface() {
1231         my $interface;
1232         my $red_iface_file = "${General::swroot}/red/iface";
1233
1234         if (-e $red_iface_file) {
1235                 open(IFACE, "$red_iface_file") or die "Could not open $red_iface_file";
1236                 $interface = <IFACE>;
1237                 close(IFACE);
1238                 chomp $interface;
1239         }
1240
1241         return $interface;
1242 }
1243
1244 sub number_cpu_cores() {
1245         open my $cpuinfo, "/proc/cpuinfo" or die "Can't open cpuinfo: $!\n";
1246         my $cores = scalar (map /^processor/, <$cpuinfo>);
1247         close $cpuinfo;
1248
1249         return $cores;
1250 }
1251
1252 # Tiny function to grab a single IP-address from a given file.
1253 sub grab_address_from_file($) {
1254         my ($file) = @_;
1255
1256         my $address;
1257
1258         # Check if the given file exists.
1259         if(-f $file) {
1260                 # Open the file for reading.
1261                 open(FILE, $file) or die "Could not read from $file. $!\n";
1262
1263                 # Read the address from the file.
1264                 $address = <FILE>;
1265
1266                 # Close filehandle.
1267                 close(FILE);
1268
1269                 # Remove newlines.
1270                 chomp($address);
1271
1272                 # Check if the obtained address is valid.
1273                 if (&validip($address)) {
1274                         # Return the address.
1275                         return $address;
1276                 }
1277         }
1278
1279         # Return nothing.
1280         return;
1281 }
1282
1283 # Function to get all configured and enabled nameservers.
1284 sub get_nameservers () {
1285         my %settings;
1286         my %servers;
1287
1288         my @nameservers;
1289
1290         # Read DNS configuration.
1291         &readhash("$General::swroot/dns/settings", \%settings);
1292
1293         # Read configured DNS servers.
1294         &readhasharray("$General::swroot/dns/servers", \%servers);
1295
1296         # Check if the ISP assigned server should be used.
1297         if ($settings{'USE_ISP_NAMESERVERS'} eq "on") {
1298                 # Assign ISP nameserver files.
1299                 my @ISP_nameserver_files = ( "/var/run/dns1", "/var/run/dns2" );
1300
1301                 # Loop through the array of ISP assigned DNS servers.
1302                 foreach my $file (@ISP_nameserver_files) {
1303                         # Grab the IP address.
1304                         my $address = &grab_address_from_file($file);
1305
1306                         # Check if an address has been grabbed.
1307                         if ($address) {
1308                                 # Add the address to the array of nameservers.
1309                                 push(@nameservers, $address);
1310                         }
1311                 }
1312         }
1313
1314         # Check if DNS servers are configured.
1315         if (%servers) {
1316                 # Loop through the hash of configured DNS servers.
1317                 foreach my $id (keys %servers) {
1318                         my $address = $servers{$id}[0];
1319                         my $status = $servers{$id}[2];
1320
1321                         # Check if the current processed server is enabled.
1322                         if ($status eq "enabled") {
1323                                 # Add the address to the array of nameservers.
1324                                 push(@nameservers, $address);
1325                         }
1326                 }
1327         }
1328
1329         # Return the array.
1330         return &uniq(@nameservers);
1331 }
1332
1333 # Function to format a string containing the amount of bytes to
1334 # something human-readable.
1335 sub formatBytes {
1336         # Private array which contains the units.
1337         my @units = qw(B KB MB GB TB PB);
1338
1339         my $bytes = shift;
1340         my $unit;
1341
1342         # Loop through the array of units.
1343         foreach my $element (@units) {
1344                 # Assign current processed element to unit.
1345                 $unit = $element;
1346
1347                 # Break loop if the bytes are less than the next unit.
1348                 last if $bytes < 1024;
1349
1350                 # Divide bytes amount with 1024.
1351                 $bytes /= 1024;
1352         }
1353
1354         # Return the divided and rounded bytes count and the unit.
1355         return sprintf("%.2f %s", $bytes, $unit);
1356 }
1357
1358 # Function to collect and generate a hash for translating protocol numbers into
1359 # their names.
1360 sub generateProtoTransHash () {
1361         # File which contains the protocol definitions.
1362         my $protocols_file = "/etc/protocols";
1363
1364         my %protocols = ();
1365
1366         # Open protocols file.
1367         open(FILE, "$protocols_file") or die "Could not open $protocols_file. $!\n";
1368
1369         # Loop through the file.
1370         while (my $line = <FILE>) {
1371                 # Skip comments.
1372                 next if ($line =~ /^\#/);
1373
1374                 # Skip blank  lines.
1375                 next if ($line =~ /^\s*$/);
1376
1377                 # Remove any newlines.
1378                 chomp($line);
1379
1380                 # Split line content.
1381                 my ($protocol_lc, $number, $protocol_uc, $comment) = split(' ', $line);
1382
1383                 # Add proto details to the hash of protocols.
1384                 $protocols{$number} = $protocol_uc;
1385         }
1386
1387         # Close file handle.
1388         close(FILE);
1389
1390         # Return the hash.
1391         return %protocols;
1392 }
1393
1394 # Cloud Stuff
1395
1396 sub running_in_cloud() {
1397         return &running_on_ec2() || &running_on_gcp();
1398 }
1399
1400 sub running_on_ec2() {
1401         if (-e "/var/run/aws-instance-id") {
1402                 return 1;
1403         }
1404
1405         return 0;
1406 }
1407
1408 sub running_on_gcp() {
1409         if (-e "/var/run/gcp-instance-id") {
1410                 return 1;
1411         }
1412
1413         return 0;
1414 }
1415
1416 1;