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