config/cfgroot/general-functions.pl

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