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