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