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