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