config/cfgroot/general-functions.pl

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