config/cfgroot/general-functions.pl

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