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