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