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 validccdname
 725 {
 726         # Checks a ccdname for letters, numbers and spaces
 727         my $ccdname = $_[0];
 728
 729         # ccdname should be at least one character in length
 730         # but no more than 63 characters
 731         if (length ($ccdname) < 1 || length ($ccdname) > 63) {
 732                 return 0;}
 733         # Only valid characters are a-z, A-Z, 0-9, space and -
 734         if ($ccdname !~ /^[a-zA-Z0-9 -]*$/) {
 735                 return 0;}
 736         return 1;
 737 }
 738
 739 sub validdomainname
 740 {
 741         my $part;
 742
 743         # Checks a domain name against RFC1035 and RFC2181
 744         my $domainname = $_[0];
 745         my @parts = split (/\./, $domainname);  # Split domain name at the '.'
 746
 747         foreach $part (@parts) {
 748                 # Each part should be at least one character in length
 749                 # but no more than 63 characters
 750                 if (length ($part) < 1 || length ($part) > 63) {
 751                         return 0;}
 752                 # Only valid characters are a-z, A-Z, 0-9, _ and -
 753                 if ($part !~ /^[a-zA-Z0-9_-]*$/) {
 754                         return 0;}
 755         }
 756         return 1;
 757 }
 758
 759 sub validfqdn
 760 {
 761         # Checks a fully qualified domain name against RFC1035 and RFC2181
 762         my $fqdn = $_[0];
 763         my @parts = split (/\./, $fqdn);        # Split FQDN at the '.'
 764         if (scalar(@parts) < 2) {               # At least two parts should
 765                 return 0;}                      # exist in a FQDN
 766                                                 # (i.e.hostname.domain)
 767
 768         for (my $index=0; $index < scalar(@parts); $index++) {
 769                 # Each part should be at least one character in length
 770                 # but no more than 63 characters
 771                 if (length ($parts[$index]) < 1 || length ($parts[$index]) > 63) {
 772                         return 0;}
 773                 if ($index eq 0) {
 774                         # This is the hostname part
 775                         # Only valid characters are a-z, A-Z, 0-9 and -
 776                         if ($parts[$index] !~ /^[a-zA-Z0-9-]*$/) {
 777                                 return 0;}
 778                         # First character can only be a letter or a digit
 779                         if (substr ($parts[$index], 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 780                                 return 0;}
 781                         # Last character can only be a letter or a digit
 782                         if (substr ($parts[$index], -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 783                                 return 0;}
 784                 } else{
 785                         # This is the domain part
 786                         # Only valid characters are a-z, A-Z, 0-9, _ and -
 787                         if ($parts[$index] !~ /^[a-zA-Z0-9_-]*$/) {
 788                                 return 0;}
 789                 }
 790         }
 791         return 1;
 792 }
 793
 794 sub validportrange # used to check a port range
 795 {
 796         my $port = $_[0]; # port values
 797         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 798         my $srcdst = $_[1]; # is it a source or destination port
 799
 800         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 801
 802                 if (!(&validport($port))) {
 803                         if ($srcdst eq 'src'){
 804                                 return $Lang::tr{'source port numbers'};
 805                         } else  {
 806                                 return $Lang::tr{'destination port numbers'};
 807                         }
 808                 }
 809         }
 810         else
 811         {
 812                 my @ports = ($1, $2);
 813                 if ($1 >= $2){
 814                         if ($srcdst eq 'src'){
 815                                 return $Lang::tr{'bad source range'};
 816                         } else  {
 817                                 return $Lang::tr{'bad destination range'};
 818                         }
 819                 }
 820                 foreach $_ (@ports)
 821                 {
 822                         if (!(&validport($_))) {
 823                                 if ($srcdst eq 'src'){
 824                                         return $Lang::tr{'source port numbers'};
 825                                 } else  {
 826                                         return $Lang::tr{'destination port numbers'};
 827                                 }
 828                         }
 829                 }
 830                 return;
 831         }
 832 }
 833
 834 sub IpInSubnet {
 835         my $addr = shift;
 836         my $network = shift;
 837         my $netmask = shift;
 838
 839         return &Network::ip_address_in_network($addr, "$network/$netmask");
 840 }
 841
 842 #
 843 # Return the following IP (IP+1) in dotted notation.
 844 # Call: NextIP ('1.1.1.1');
 845 # Return: '1.1.1.2'
 846 #
 847 sub NextIP {
 848         return &Network::find_next_ip_address(shift, 1);
 849 }
 850
 851 sub NextIP2 {
 852         return &Network::find_next_ip_address(shift, 4);
 853 }
 854
 855 sub ipcidr {
 856         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 857         return "$ip\/$cidr";
 858 }
 859
 860 sub ipcidr2msk {
 861        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 862        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 863        return "$ip\/$netmask";
 864 }
 865
 866 sub validemail {
 867     my $address = shift;
 868     my @parts = split( /\@/, $address );
 869     my $count=@parts;
 870
 871     #check if we have one part before and after '@'
 872     return 0 if ( $count != 2 );
 873
 874     #check if one of the parts starts or ends with a dot
 875     return 0 if ( substr($parts[0],0,1) eq '.' );
 876     return 0 if ( substr($parts[0],-1,1) eq '.' );
 877     return 0 if ( substr($parts[1],0,1) eq '.' );
 878     return 0 if ( substr($parts[1],-1,1) eq '.' );
 879
 880     #check first addresspart (before '@' sign)
 881     return 0 if  ( $parts[0] !~ m/^[a-zA-Z0-9\.!\-\_\+#]+$/ );
 882
 883     #check second addresspart (after '@' sign)
 884     return 0 if  ( $parts[1] !~ m/^[a-zA-Z0-9\.\-]+$/ );
 885
 886     return 1;
 887 }
 888
 889 #
 890 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 891 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 892 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 893 #
 894 sub readhasharray {
 895     my ($filename, $hash) = @_;
 896     %$hash = ();
 897
 898     open(FILE, $filename) or die "Unable to read file $filename";
 899
 900     while (<FILE>) {
 901         my ($key, $rest, @temp);
 902         chomp;
 903         ($key, $rest) = split (/,/, $_, 2);
 904         if ($key =~ /^[0-9]+$/) {
 905             @temp = split (/,/, $rest);
 906             $hash->{$key} = \@temp;
 907         }
 908     }
 909     close FILE;
 910     return;
 911 }
 912
 913 sub writehasharray {
 914     my ($filename, $hash) = @_;
 915     my ($key, @temp, $i);
 916
 917     open(FILE, ">$filename") or die "Unable to write to file $filename";
 918
 919     foreach $key (keys %$hash) {
 920                 if ($key =~ /^[0-9]+$/) {
 921                         print FILE "$key";
 922                         foreach $i (0 .. $#{$hash->{$key}}) {
 923                                 print FILE ",$hash->{$key}[$i]";
 924                         }
 925                         print FILE "\n";
 926                 }
 927     }
 928     close FILE;
 929     return;
 930 }
 931
 932 sub findhasharraykey {
 933     foreach my $i (1 .. 1000000) {
 934         if ( ! exists $_[0]{$i}) {
 935              return $i;
 936         }
 937     }
 938 }
 939
 940 sub srtarray
 941 # Darren Critchley - darrenc@telus.net - (c) 2003
 942 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 943 # This subroutine will take the following parameters:
 944 #   ColumnNumber = the column which you want to sort on, starts at 1
 945 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 946 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 947 #   ArrayToBeSorted = the array that wants sorting
 948 #
 949 #   Returns an array that is sorted to your specs
 950 #
 951 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 952 #
 953 {
 954         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 955         my @tmparray;
 956         my @srtedarray;
 957         my $line;
 958         my $newline;
 959         my $ctr;
 960         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 961         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 962                 return (@tobesorted);
 963         }
 964         my @tmp = split(/\,/,$tobesorted[0]);
 965         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 966
 967         # Darren Critchley - validate parameters
 968         if ($colno > $ttlitems){$colno = '1';}
 969         $colno--; # remove one from colno to deal with arrays starting at 0
 970         if($colno < 0){$colno = '0';}
 971         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 972         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 973
 974         foreach $line (@tobesorted)
 975         {
 976                 chomp($line);
 977                 if ($line ne '') {
 978                         my @temp = split(/\,/,$line);
 979                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 980                         my $tmpholder = $temp[0];
 981                         $temp[0] = $temp[$colno];
 982                         $temp[$colno] = $tmpholder;
 983                         $newline = "";
 984                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 985                                 $newline=$newline . $temp[$ctr] . ",";
 986                         }
 987                         chop($newline);
 988                         push(@tmparray,$newline);
 989                 }
 990         }
 991         if ($alpnum eq 'n') {
 992                 @tmparray = sort {$a <=> $b} @tmparray;
 993         } else {
 994                 @tmparray = (sort @tmparray);
 995         }
 996         foreach $line (@tmparray)
 997         {
 998                 chomp($line);
 999                 if ($line ne '') {
1000                         my @temp = split(/\,/,$line);
1001                         my $tmpholder = $temp[0];
1002                         $temp[0] = $temp[$colno];
1003                         $temp[$colno] = $tmpholder;
1004                         $newline = "";
1005                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
1006                                 $newline=$newline . $temp[$ctr] . ",";
1007                         }
1008                         chop($newline);
1009                         push(@srtedarray,$newline);
1010                 }
1011         }
1012
1013         if ($srtdir eq 'dsc') {
1014                 @tmparray = reverse(@srtedarray);
1015                 return (@tmparray);
1016         } else {
1017                 return (@srtedarray);
1018         }
1019 }
1020
1021 sub FetchPublicIp {
1022     my %proxysettings;
1023     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
1024     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
1025         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
1026         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
1027     }
1028     my $user_agent = &MakeUserAgent();
1029     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
1030                                                     80,
1031                                                     "/",
1032                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
1033                                                 );
1034     if ($response =~ m%HTTP/1\.. 200 OK%) {
1035         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
1036         return $1;
1037     }
1038     return '';
1039 }
1040
1041 #
1042 # Check if hostname.domain provided have IP provided
1043 # use gethostbyname to verify that
1044 # Params:
1045 #       IP
1046 #       hostname
1047 #       domain
1048 # Output
1049 #       1 IP matches host.domain
1050 #       0 not in sync
1051 #
1052 sub DyndnsServiceSync ($;$;$) {
1053
1054     my ($ip,$hostName,$domain) = @_;
1055     my @addresses;
1056
1057     #fix me no ip GROUP, what is the name ?
1058     $hostName =~ s/$General::noipprefix//;
1059     if ($hostName) { #may be empty
1060         $hostName = "$hostName.$domain";
1061         @addresses = gethostbyname($hostName);
1062     }
1063
1064     if ($addresses[0] eq '') {                  # nothing returned ?
1065         $hostName = $domain;                    # try resolving with domain only
1066         @addresses = gethostbyname($hostName);
1067     }
1068
1069     if ($addresses[0] ne '') {                  # got something ?
1070         #&General::log("name:$addresses[0], alias:$addresses[1]");
1071         # Build clear text list of IP
1072         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
1073         if (grep (/$ip/, @addresses)) {
1074             return 1;
1075         }
1076     }
1077     return 0;
1078 }
1079 #
1080 # This sub returns the red IP used to compare in DyndnsServiceSync
1081 #
1082 sub GetDyndnsRedIP {
1083     my %settings;
1084     &General::readhash("${General::swroot}/ddns/settings", \%settings);
1085
1086     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
1087     my $ip = <IP>;
1088     close(IP);
1089     chomp $ip;
1090
1091     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
1092     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
1093         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
1094         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
1095         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
1096     {
1097         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
1098             my $RealIP = &General::FetchPublicIp;
1099             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
1100         }
1101     }
1102     return $ip;
1103 }
1104
1105 # Translate ICMP code to text
1106 # ref: http://www.iana.org/assignments/icmp-parameters
1107 sub GetIcmpDescription ($) {
1108     my $index = shift;
1109     my @icmp_description = (
1110     'Echo Reply',                       #0
1111     'Unassigned',
1112     'Unassigned',
1113     'Destination Unreachable',
1114     'Source Quench',
1115     'Redirect',
1116     'Alternate Host Address',
1117     'Unassigned',
1118     'Echo',
1119     'Router Advertisement',
1120     'Router Solicitation',              #10
1121     'Time Exceeded',
1122     'Parameter Problem',
1123     'Timestamp',
1124     'Timestamp Reply',
1125     'Information Request',
1126     'Information Reply',
1127     'Address Mask Request',
1128     'Address Mask Reply',
1129     'Reserved (for Security)',
1130     'Reserved (for Robustness Experiment)', #20
1131     'Reserved',
1132     'Reserved',
1133     'Reserved',
1134     'Reserved',
1135     'Reserved',
1136     'Reserved',
1137     'Reserved',
1138     'Reserved',
1139     'Reserved',
1140     'Traceroute',                               #30
1141     'Datagram Conversion Error',
1142     'Mobile Host Redirect',
1143     'IPv6 Where-Are-You',
1144     'IPv6 I-Am-Here',
1145     'Mobile Registration Request',
1146     'Mobile Registration Reply',
1147     'Domain Name Request',
1148     'Domain Name Reply',
1149     'SKIP',
1150     'Photur',                           #40
1151     'Experimental');
1152     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1153 }
1154
1155 sub GetCoreUpdateVersion() {
1156         my $core_update;
1157
1158         open(FILE, "/opt/pakfire/db/core/mine");
1159         while (<FILE>) {
1160                 $core_update = $_;
1161                 last;
1162         }
1163         close(FILE);
1164
1165         return $core_update;
1166 }
1167
1168 sub MakeUserAgent() {
1169         my $user_agent = "IPFire/$General::version";
1170
1171         my $core_update = &GetCoreUpdateVersion();
1172         if ($core_update ne "") {
1173                 $user_agent .= "/$core_update";
1174         }
1175
1176         return $user_agent;
1177 }
1178
1179 sub RedIsWireless() {
1180         # This function checks if a network device is a wireless device.
1181
1182         my %settings = ();
1183         &readhash("${General::swroot}/ethernet/settings", \%settings);
1184
1185         # Find the name of the network device.
1186         my $device = $settings{'RED_DEV'};
1187
1188         # Exit, if no device is configured.
1189         return 0 if ($device eq "");
1190
1191         # Return 1 if the device is a wireless one.
1192         my $path = "/sys/class/net/$device/wireless";
1193         if (-d $path) {
1194                 return 1;
1195         }
1196
1197         # Otherwise return zero.
1198         return 0;
1199 }
1200
1201 # Function to read a file with UTF-8 charset.
1202 sub read_file_utf8 ($) {
1203         my ($file) = @_;
1204
1205         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1206         local $/ = undef;
1207         my $all = <$in>;
1208         close $in;
1209
1210         return $all;
1211 }
1212
1213 # Function to write a file with UTF-8 charset.
1214 sub write_file_utf8 ($) {
1215         my ($file, $content) = @_;
1216
1217         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1218         print $out $content;
1219         close $out;
1220
1221         return;
1222 }
1223
1224 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1225
1226 sub firewall_config_changed() {
1227         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1228         close FILE;
1229 }
1230
1231 sub firewall_needs_reload() {
1232         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1233                 return 1;
1234         }
1235
1236         return 0;
1237 }
1238
1239 sub firewall_reload() {
1240         &system("/usr/local/bin/firewallctrl");
1241 }
1242
1243 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1244 # if you change this also check speed.cgi that include a local copy for systemload reasons
1245 sub get_red_interface() {
1246         my $interface;
1247         my $red_iface_file = "${General::swroot}/red/iface";
1248
1249         if (-e $red_iface_file) {
1250                 open(IFACE, "$red_iface_file") or die "Could not open $red_iface_file";
1251                 $interface = <IFACE>;
1252                 close(IFACE);
1253                 chomp $interface;
1254         }
1255
1256         return $interface;
1257 }
1258
1259 sub number_cpu_cores() {
1260         open my $cpuinfo, "/proc/cpuinfo" or die "Can't open cpuinfo: $!\n";
1261         my $cores = scalar (map /^processor/, <$cpuinfo>);
1262         close $cpuinfo;
1263
1264         return $cores;
1265 }
1266
1267 # Tiny function to grab a single IP-address from a given file.
1268 sub grab_address_from_file($) {
1269         my ($file) = @_;
1270
1271         my $address;
1272
1273         # Check if the given file exists.
1274         if(-f $file) {
1275                 # Open the file for reading.
1276                 open(FILE, $file) or die "Could not read from $file. $!\n";
1277
1278                 # Read the address from the file.
1279                 $address = <FILE>;
1280
1281                 # Close filehandle.
1282                 close(FILE);
1283
1284                 # Remove newlines.
1285                 chomp($address);
1286
1287                 # Check if the obtained address is valid.
1288                 if (&validip($address)) {
1289                         # Return the address.
1290                         return $address;
1291                 }
1292         }
1293
1294         # Return nothing.
1295         return;
1296 }
1297
1298 # Function to get all configured and enabled nameservers.
1299 sub get_nameservers () {
1300         my %settings;
1301         my %servers;
1302
1303         my @nameservers;
1304
1305         # Read DNS configuration.
1306         &readhash("$General::swroot/dns/settings", \%settings);
1307
1308         # Read configured DNS servers.
1309         &readhasharray("$General::swroot/dns/servers", \%servers);
1310
1311         # Check if the ISP assigned server should be used.
1312         if ($settings{'USE_ISP_NAMESERVERS'} eq "on") {
1313                 # Assign ISP nameserver files.
1314                 my @ISP_nameserver_files = ( "/var/run/dns1", "/var/run/dns2" );
1315
1316                 # Loop through the array of ISP assigned DNS servers.
1317                 foreach my $file (@ISP_nameserver_files) {
1318                         # Grab the IP address.
1319                         my $address = &grab_address_from_file($file);
1320
1321                         # Check if an address has been grabbed.
1322                         if ($address) {
1323                                 # Add the address to the array of nameservers.
1324                                 push(@nameservers, $address);
1325                         }
1326                 }
1327         }
1328
1329         # Check if DNS servers are configured.
1330         if (%servers) {
1331                 # Loop through the hash of configured DNS servers.
1332                 foreach my $id (keys %servers) {
1333                         my $address = $servers{$id}[0];
1334                         my $status = $servers{$id}[2];
1335
1336                         # Check if the current processed server is enabled.
1337                         if ($status eq "enabled") {
1338                                 # Add the address to the array of nameservers.
1339                                 push(@nameservers, $address);
1340                         }
1341                 }
1342         }
1343
1344         # Return the array.
1345         return &uniq(@nameservers);
1346 }
1347
1348 # Function to format a string containing the amount of bytes to
1349 # something human-readable.
1350 sub formatBytes {
1351         # Private array which contains the units.
1352         my @units = qw(B KB MB GB TB PB);
1353
1354         my $bytes = shift;
1355         my $unit;
1356
1357         # Loop through the array of units.
1358         foreach my $element (@units) {
1359                 # Assign current processed element to unit.
1360                 $unit = $element;
1361
1362                 # Break loop if the bytes are less than the next unit.
1363                 last if $bytes < 1024;
1364
1365                 # Divide bytes amount with 1024.
1366                 $bytes /= 1024;
1367         }
1368
1369         # Return the divided and rounded bytes count and the unit.
1370         return sprintf("%.2f %s", $bytes, $unit);
1371 }
1372
1373 # Function to collect and generate a hash for translating protocol numbers into
1374 # their names.
1375 sub generateProtoTransHash () {
1376         # File which contains the protocol definitions.
1377         my $protocols_file = "/etc/protocols";
1378
1379         my %protocols = ();
1380
1381         # Open protocols file.
1382         open(FILE, "$protocols_file") or die "Could not open $protocols_file. $!\n";
1383
1384         # Loop through the file.
1385         while (my $line = <FILE>) {
1386                 # Skip comments.
1387                 next if ($line =~ /^\#/);
1388
1389                 # Skip blank  lines.
1390                 next if ($line =~ /^\s*$/);
1391
1392                 # Remove any newlines.
1393                 chomp($line);
1394
1395                 # Split line content.
1396                 my ($protocol_lc, $number, $protocol_uc, $comment) = split(' ', $line);
1397
1398                 # Add proto details to the hash of protocols.
1399                 $protocols{$number} = $protocol_uc;
1400         }
1401
1402         # Close file handle.
1403         close(FILE);
1404
1405         # Return the hash.
1406         return %protocols;
1407 }
1408
1409 # Cloud Stuff
1410
1411 sub running_in_cloud() {
1412         return &running_on_ec2() || &running_on_gcp();
1413 }
1414
1415 sub running_on_ec2() {
1416         if (-e "/var/run/aws-instance-id") {
1417                 return 1;
1418         }
1419
1420         return 0;
1421 }
1422
1423 sub running_on_gcp() {
1424         if (-e "/var/run/gcp-instance-id") {
1425                 return 1;
1426         }
1427
1428         return 0;
1429 }
1430
1431 1;