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