config/cfgroot/general-functions.pl

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