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 at least two characters in length
 631                 # but no more than 63 characters
 632                 if (length ($part) < 2 || length ($part) > 63) {
 633                         return 0;}
 634                 # Only valid characters are a-z, A-Z, 0-9 and -
 635                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 636                         return 0;}
 637                 # First character can only be a letter or a digit
 638                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 639                         return 0;}
 640                 # Last character can only be a letter or a digit
 641                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 642                         return 0;}
 643         }
 644         return 1;
 645 }
 646
 647 sub validfqdn
 648 {
 649         my $part;
 650
 651         # Checks a fully qualified domain name against RFC1035
 652         my $fqdn = $_[0];
 653         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 654         if (scalar(@parts) < 2) {               # At least two parts should
 655                 return 0;}                      # exist in a FQDN
 656                                                 # (i.e. hostname.domain)
 657         foreach $part (@parts) {
 658                 # Each part should be at least one character in length
 659                 # but no more than 63 characters
 660                 if (length ($part) < 1 || length ($part) > 63) {
 661                         return 0;}
 662                 # Only valid characters are a-z, A-Z, 0-9 and -
 663                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 664                         return 0;}
 665                 # First character can only be a letter or a digit
 666                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 667                         return 0;}
 668                 # Last character can only be a letter or a digit
 669                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 670                         return 0;}
 671         }
 672         return 1;
 673 }
 674
 675 sub validportrange # used to check a port range
 676 {
 677         my $port = $_[0]; # port values
 678         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 679         my $srcdst = $_[1]; # is it a source or destination port
 680
 681         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 682
 683                 if (!(&validport($port))) {
 684                         if ($srcdst eq 'src'){
 685                                 return $Lang::tr{'source port numbers'};
 686                         } else  {
 687                                 return $Lang::tr{'destination port numbers'};
 688                         }
 689                 }
 690         }
 691         else
 692         {
 693                 my @ports = ($1, $2);
 694                 if ($1 >= $2){
 695                         if ($srcdst eq 'src'){
 696                                 return $Lang::tr{'bad source range'};
 697                         } else  {
 698                                 return $Lang::tr{'bad destination range'};
 699                         }
 700                 }
 701                 foreach $_ (@ports)
 702                 {
 703                         if (!(&validport($_))) {
 704                                 if ($srcdst eq 'src'){
 705                                         return $Lang::tr{'source port numbers'};
 706                                 } else  {
 707                                         return $Lang::tr{'destination port numbers'};
 708                                 }
 709                         }
 710                 }
 711                 return;
 712         }
 713 }
 714
 715 sub IpInSubnet {
 716         my $addr = shift;
 717         my $network = shift;
 718         my $netmask = shift;
 719
 720         return &Network::ip_address_in_network($addr, "$network/$netmask");
 721 }
 722
 723 #
 724 # Return the following IP (IP+1) in dotted notation.
 725 # Call: NextIP ('1.1.1.1');
 726 # Return: '1.1.1.2'
 727 #
 728 sub NextIP {
 729         return &Network::find_next_ip_address(shift, 1);
 730 }
 731
 732 sub NextIP2 {
 733         return &Network::find_next_ip_address(shift, 4);
 734 }
 735
 736 sub ipcidr {
 737         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 738         return "$ip\/$cidr";
 739 }
 740
 741 sub ipcidr2msk {
 742        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 743        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 744        return "$ip\/$netmask";
 745 }
 746
 747 sub validemail {
 748     my $mail = shift;
 749     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 750     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 751     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 752     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 753     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 754     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 755     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 756     return 1;
 757 }
 758
 759 #
 760 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 761 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 762 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 763 #
 764 sub readhasharray {
 765     my ($filename, $hash) = @_;
 766     %$hash = ();
 767
 768     open(FILE, $filename) or die "Unable to read file $filename";
 769
 770     while (<FILE>) {
 771         my ($key, $rest, @temp);
 772         chomp;
 773         ($key, $rest) = split (/,/, $_, 2);
 774         if ($key =~ /^[0-9]+$/) {
 775             @temp = split (/,/, $rest);
 776             $hash->{$key} = \@temp;
 777         }
 778     }
 779     close FILE;
 780     return;
 781 }
 782
 783 sub writehasharray {
 784     my ($filename, $hash) = @_;
 785     my ($key, @temp, $i);
 786
 787     open(FILE, ">$filename") or die "Unable to write to file $filename";
 788
 789     foreach $key (keys %$hash) {
 790                 if ($key =~ /^[0-9]+$/) {
 791                         print FILE "$key";
 792                         foreach $i (0 .. $#{$hash->{$key}}) {
 793                                 print FILE ",$hash->{$key}[$i]";
 794                         }
 795                         print FILE "\n";
 796                 }
 797     }
 798     close FILE;
 799     return;
 800 }
 801
 802 sub findhasharraykey {
 803     foreach my $i (1 .. 1000000) {
 804         if ( ! exists $_[0]{$i}) {
 805              return $i;
 806         }
 807     }
 808 }
 809
 810 sub srtarray
 811 # Darren Critchley - darrenc@telus.net - (c) 2003
 812 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 813 # This subroutine will take the following parameters:
 814 #   ColumnNumber = the column which you want to sort on, starts at 1
 815 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 816 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 817 #   ArrayToBeSorted = the array that wants sorting
 818 #
 819 #   Returns an array that is sorted to your specs
 820 #
 821 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 822 #
 823 {
 824         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 825         my @tmparray;
 826         my @srtedarray;
 827         my $line;
 828         my $newline;
 829         my $ctr;
 830         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 831         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 832                 return (@tobesorted);
 833         }
 834         my @tmp = split(/\,/,$tobesorted[0]);
 835         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 836
 837         # Darren Critchley - validate parameters
 838         if ($colno > $ttlitems){$colno = '1';}
 839         $colno--; # remove one from colno to deal with arrays starting at 0
 840         if($colno < 0){$colno = '0';}
 841         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 842         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 843
 844         foreach $line (@tobesorted)
 845         {
 846                 chomp($line);
 847                 if ($line ne '') {
 848                         my @temp = split(/\,/,$line);
 849                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 850                         my $tmpholder = $temp[0];
 851                         $temp[0] = $temp[$colno];
 852                         $temp[$colno] = $tmpholder;
 853                         $newline = "";
 854                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 855                                 $newline=$newline . $temp[$ctr] . ",";
 856                         }
 857                         chop($newline);
 858                         push(@tmparray,$newline);
 859                 }
 860         }
 861         if ($alpnum eq 'n') {
 862                 @tmparray = sort {$a <=> $b} @tmparray;
 863         } else {
 864                 @tmparray = (sort @tmparray);
 865         }
 866         foreach $line (@tmparray)
 867         {
 868                 chomp($line);
 869                 if ($line ne '') {
 870                         my @temp = split(/\,/,$line);
 871                         my $tmpholder = $temp[0];
 872                         $temp[0] = $temp[$colno];
 873                         $temp[$colno] = $tmpholder;
 874                         $newline = "";
 875                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 876                                 $newline=$newline . $temp[$ctr] . ",";
 877                         }
 878                         chop($newline);
 879                         push(@srtedarray,$newline);
 880                 }
 881         }
 882
 883         if ($srtdir eq 'dsc') {
 884                 @tmparray = reverse(@srtedarray);
 885                 return (@tmparray);
 886         } else {
 887                 return (@srtedarray);
 888         }
 889 }
 890
 891 sub FetchPublicIp {
 892     my %proxysettings;
 893     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 894     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 895         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 896         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 897     }
 898     my $user_agent = &MakeUserAgent();
 899     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
 900                                                     80,
 901                                                     "/",
 902                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
 903                                                 );
 904     if ($response =~ m%HTTP/1\.. 200 OK%) {
 905         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
 906         return $1;
 907     }
 908     return '';
 909 }
 910
 911 #
 912 # Check if hostname.domain provided have IP provided
 913 # use gethostbyname to verify that
 914 # Params:
 915 #       IP
 916 #       hostname
 917 #       domain
 918 # Output
 919 #       1 IP matches host.domain
 920 #       0 not in sync
 921 #
 922 sub DyndnsServiceSync ($;$;$) {
 923
 924     my ($ip,$hostName,$domain) = @_;
 925     my @addresses;
 926
 927     #fix me no ip GROUP, what is the name ?
 928     $hostName =~ s/$General::noipprefix//;
 929     if ($hostName) { #may be empty
 930         $hostName = "$hostName.$domain";
 931         @addresses = gethostbyname($hostName);
 932     }
 933
 934     if ($addresses[0] eq '') {                  # nothing returned ?
 935         $hostName = $domain;                    # try resolving with domain only
 936         @addresses = gethostbyname($hostName);
 937     }
 938
 939     if ($addresses[0] ne '') {                  # got something ?
 940         #&General::log("name:$addresses[0], alias:$addresses[1]");
 941         # Build clear text list of IP
 942         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 943         if (grep (/$ip/, @addresses)) {
 944             return 1;
 945         }
 946     }
 947     return 0;
 948 }
 949 #
 950 # This sub returns the red IP used to compare in DyndnsServiceSync
 951 #
 952 sub GetDyndnsRedIP {
 953     my %settings;
 954     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 955
 956     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 957     my $ip = <IP>;
 958     close(IP);
 959     chomp $ip;
 960
 961     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
 962     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 963         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 964         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
 965         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
 966     {
 967         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 968             my $RealIP = &General::FetchPublicIp;
 969             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 970         }
 971     }
 972     return $ip;
 973 }
 974
 975 # Translate ICMP code to text
 976 # ref: http://www.iana.org/assignments/icmp-parameters
 977 sub GetIcmpDescription ($) {
 978     my $index = shift;
 979     my @icmp_description = (
 980     'Echo Reply',                       #0
 981     'Unassigned',
 982     'Unassigned',
 983     'Destination Unreachable',
 984     'Source Quench',
 985     'Redirect',
 986     'Alternate Host Address',
 987     'Unassigned',
 988     'Echo',
 989     'Router Advertisement',
 990     'Router Solicitation',              #10
 991     'Time Exceeded',
 992     'Parameter Problem',
 993     'Timestamp',
 994     'Timestamp Reply',
 995     'Information Request',
 996     'Information Reply',
 997     'Address Mask Request',
 998     'Address Mask Reply',
 999     'Reserved (for Security)',
1000     'Reserved (for Robustness Experiment)', #20
1001     'Reserved',
1002     'Reserved',
1003     'Reserved',
1004     'Reserved',
1005     'Reserved',
1006     'Reserved',
1007     'Reserved',
1008     'Reserved',
1009     'Reserved',
1010     'Traceroute',                               #30
1011     'Datagram Conversion Error',
1012     'Mobile Host Redirect',
1013     'IPv6 Where-Are-You',
1014     'IPv6 I-Am-Here',
1015     'Mobile Registration Request',
1016     'Mobile Registration Reply',
1017     'Domain Name Request',
1018     'Domain Name Reply',
1019     'SKIP',
1020     'Photur',                           #40
1021     'Experimental');
1022     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1023 }
1024
1025 sub GetCoreUpdateVersion() {
1026         my $core_update;
1027
1028         open(FILE, "/opt/pakfire/db/core/mine");
1029         while (<FILE>) {
1030                 $core_update = $_;
1031                 last;
1032         }
1033         close(FILE);
1034
1035         return $core_update;
1036 }
1037
1038 sub MakeUserAgent() {
1039         my $user_agent = "IPFire/$General::version";
1040
1041         my $core_update = &GetCoreUpdateVersion();
1042         if ($core_update ne "") {
1043                 $user_agent .= "/$core_update";
1044         }
1045
1046         return $user_agent;
1047 }
1048
1049 sub RedIsWireless() {
1050         # This function checks if a network device is a wireless device.
1051
1052         my %settings = ();
1053         &readhash("${General::swroot}/ethernet/settings", \%settings);
1054
1055         # Find the name of the network device.
1056         my $device = $settings{'RED_DEV'};
1057
1058         # Exit, if no device is configured.
1059         return 0 if ($device eq "");
1060
1061         # Return 1 if the device is a wireless one.
1062         my $path = "/sys/class/net/$device/wireless";
1063         if (-d $path) {
1064                 return 1;
1065         }
1066
1067         # Otherwise return zero.
1068         return 0;
1069 }
1070
1071 # Function to read a file with UTF-8 charset.
1072 sub read_file_utf8 ($) {
1073         my ($file) = @_;
1074
1075         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1076         local $/ = undef;
1077         my $all = <$in>;
1078         close $in;
1079
1080         return $all;
1081 }
1082
1083 # Function to write a file with UTF-8 charset.
1084 sub write_file_utf8 ($) {
1085         my ($file, $content) = @_;
1086
1087         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1088         print $out $content;
1089         close $out;
1090
1091         return;
1092 }
1093
1094 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1095
1096 sub firewall_config_changed() {
1097         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1098         close FILE;
1099 }
1100
1101 sub firewall_needs_reload() {
1102         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1103                 return 1;
1104         }
1105
1106         return 0;
1107 }
1108
1109 sub firewall_reload() {
1110         system("/usr/local/bin/firewallctrl");
1111 }
1112
1113 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1114 sub get_red_interface() {
1115
1116         open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
1117
1118         my $interface = <IFACE>;
1119         close(IFACE);
1120         chomp $interface;
1121
1122         return $interface;
1123 }
1124
1125 1;