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) || &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         my $arg = join("/", @_);
 392
 393         return &Network::get_netaddress($arg);
 394 }
 395
 396 sub getccdbc
 397 {
 398         #Gets: IP in Form ("192.168.0.0/24")
 399         #Gives: Broadcastaddress of network
 400         my $ccdnet=$_;
 401         my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
 402         my $ip_address_binary = inet_aton( $ccdip );
 403         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 404         my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
 405         return $broadcast_address;
 406 }
 407
 408 sub ip2dec  {
 409         return &Network::ip2bin(shift);
 410 }
 411
 412 sub dec2ip  {
 413         return &Network::bin2ip(shift);
 414 }
 415
 416 sub getnextip {
 417         return &Network::find_next_ip_address(shift, 4);
 418 }
 419
 420 sub getlastip {
 421         return &Network::find_next_ip_address(shift, -1);
 422 }
 423
 424 sub validipandmask
 425 {
 426         #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
 427         #Gives: True bzw 0 if success or false
 428         my $ccdnet=$_[0];
 429         my $subcidr;
 430
 431         if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
 432                 return 0;
 433         }
 434         my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
 435         #IP valid?
 436         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 ))) {
 437                 #Subnet in decimal and valid?
 438                 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
 439                         for (my $i=0;$i<=32;$i++){
 440                                 if (&General::cidrtosub($i) eq $ccdsubnet){
 441                                         return 1;
 442                                 }
 443                         }
 444                 #Subnet already in binary format?
 445                 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 446                         return 1;
 447                 }else{
 448                         return 0;
 449                 }
 450
 451         }
 452         return 0;
 453 }
 454
 455 sub checksubnets
 456 {
 457         my %ccdconfhash=();
 458         my %ovpnconfhash=();
 459         my %vpnconf=();
 460         my %ipsecconf=();
 461         my %ownnet=();
 462         my %ovpnconf=();
 463         my @ccdconf=();
 464         my $ccdname=$_[0];
 465         my $ccdnet=$_[1];
 466         my $ownnet=$_[2];
 467         my $errormessage;
 468         my ($ip,$cidr)=split(/\//,$ccdnet);
 469         $cidr=&iporsubtocidr($cidr);
 470
 471         #get OVPN-Subnet (dynamic range)
 472         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 473         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 474         $ovpncidr=&iporsubtocidr($ovpncidr);
 475
 476         #check if we try to use same network as ovpn server
 477         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 478                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 479                         return $errormessage;
 480         }
 481
 482         #check if we try to use same network as another ovpn N2N
 483         if($ownnet ne 'ovpn'){
 484                 &readhasharray("${General::swroot}/ovpn/ovpnconfig", \%ovpnconfhash);
 485                 foreach my $key (keys %ovpnconfhash) {
 486                         if ($ovpnconfhash{$key}[3] eq 'net'){
 487                                 my @ovpnnet=split (/\//,$ovpnconfhash{$key}[11]);
 488                                 if (&IpInSubnet($ip,$ovpnnet[0],&iporsubtodec($ovpnnet[1]))){
 489                                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnn2n'}." $ovpnconfhash{$key}[1] <br>";
 490                                         return $errormessage;
 491                                 }
 492                         }
 493                 }
 494         }
 495
 496         #check if we use a network-name/subnet (static-ovpn) that already exists
 497         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 498         foreach my $key (keys %ccdconfhash) {
 499                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 500                 if ($ccdname eq $ccdconfhash{$key}[0])
 501                 {
 502                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 503                         return $errormessage;
 504                 }
 505                 my ($newip,$newsub) = split(/\//,$ccdnet);
 506                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 507                 {
 508                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
 509                         return $errormessage;
 510                 }
 511         }
 512
 513         #check if we use a ipsec right network which is already defined
 514         if($ownnet ne 'ipsec'){
 515                 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 516                 foreach my $key (keys %ipsecconf){
 517                         if ($ipsecconf{$key}[11] ne ''){
 518                                 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
 519                                 $ipsecsub=&iporsubtodec($ipsecsub);
 520                                 if($ipsecconf{$key}[1] ne $ccdname){
 521                                         if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 522                                                 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
 523                                                 return $errormessage;
 524                                         }
 525                                 }
 526                         }
 527                 }
 528         }
 529
 530         #check if we use the ipsec RW Network (if defined)
 531         &readhash("${General::swroot}/vpn/settings", \%vpnconf);
 532         if ($vpnconf{'RW_NET'} ne ''){
 533                 my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
 534                 if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
 535                 {
 536                         $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
 537                         return $errormessage;
 538                 }
 539         }
 540
 541         #check if we use one of ipfire's networks (green,orange,blue)
 542         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 543         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;}
 544         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;}
 545         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;}
 546         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;}
 547 }
 548
 549 sub check_net_internal{
 550         my $network=shift;
 551         my ($ip,$cidr)=split(/\//,$network);
 552         my %ownnet=();
 553         my $errormessage;
 554         $cidr=&iporsubtocidr($cidr);
 555         #check if we use one of ipfire's networks (green,orange,blue)
 556         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 557         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;}
 558         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;}
 559         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;}
 560         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;}
 561 }
 562
 563 sub validport
 564 {
 565         $_ = $_[0];
 566
 567         if (!/^\d+$/) {
 568                 return 0; }
 569         if (/^0./) {
 570                 return 0; }
 571         if ($_ >= 1 && $_ <= 65535) {
 572                 return 1; }
 573         return 0;
 574 }
 575
 576 sub validproxyport
 577 {
 578         $_ = $_[0];
 579
 580         if (!/^\d+$/) {
 581                 return 0; }
 582         if (/^0./) {
 583                 return 0; }
 584         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 585                 return 0; }
 586         elsif ($_ >= 1 && $_ <= 65535) {
 587                 return 1; }
 588         return 0;
 589 }
 590
 591 sub validmac
 592 {
 593         my $checkmac = $_[0];
 594         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 595         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 596         {
 597                 return 0;
 598         }
 599         return 1;
 600 }
 601
 602 sub validhostname
 603 {
 604         # Checks a hostname against RFC1035
 605         my $hostname = $_[0];
 606
 607         # Each part should be at least two characters in length
 608         # but no more than 63 characters
 609         if (length ($hostname) < 1 || length ($hostname) > 63) {
 610                 return 0;}
 611         # Only valid characters are a-z, A-Z, 0-9 and -
 612         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 613                 return 0;}
 614         # First character can only be a letter or a digit
 615         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 616                 return 0;}
 617         # Last character can only be a letter or a digit
 618         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 619                 return 0;}
 620         return 1;
 621 }
 622
 623 sub validdomainname
 624 {
 625         my $part;
 626
 627         # Checks a domain name against RFC1035
 628         my $domainname = $_[0];
 629         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 630
 631         foreach $part (@parts) {
 632                 # Each part should be no more than 63 characters in length
 633                 if (length ($part) < 1 || length ($part) > 63) {
 634                         return 0;}
 635                 # Only valid characters are a-z, A-Z, 0-9 and -
 636                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 637                         return 0;}
 638                 # First character can only be a letter or a digit
 639                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 640                         return 0;}
 641                 # Last character can only be a letter or a digit
 642                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 643                         return 0;}
 644         }
 645         return 1;
 646 }
 647
 648 sub validfqdn
 649 {
 650         my $part;
 651
 652         # Checks a fully qualified domain name against RFC1035
 653         my $fqdn = $_[0];
 654         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 655         if (scalar(@parts) < 2) {               # At least two parts should
 656                 return 0;}                      # exist in a FQDN
 657                                                 # (i.e. hostname.domain)
 658         foreach $part (@parts) {
 659                 # Each part should be at least one character in length
 660                 # but no more than 63 characters
 661                 if (length ($part) < 1 || length ($part) > 63) {
 662                         return 0;}
 663                 # Only valid characters are a-z, A-Z, 0-9 and -
 664                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 665                         return 0;}
 666                 # First character can only be a letter or a digit
 667                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 668                         return 0;}
 669                 # Last character can only be a letter or a digit
 670                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 671                         return 0;}
 672         }
 673         return 1;
 674 }
 675
 676 sub validportrange # used to check a port range
 677 {
 678         my $port = $_[0]; # port values
 679         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 680         my $srcdst = $_[1]; # is it a source or destination port
 681
 682         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 683
 684                 if (!(&validport($port))) {
 685                         if ($srcdst eq 'src'){
 686                                 return $Lang::tr{'source port numbers'};
 687                         } else  {
 688                                 return $Lang::tr{'destination port numbers'};
 689                         }
 690                 }
 691         }
 692         else
 693         {
 694                 my @ports = ($1, $2);
 695                 if ($1 >= $2){
 696                         if ($srcdst eq 'src'){
 697                                 return $Lang::tr{'bad source range'};
 698                         } else  {
 699                                 return $Lang::tr{'bad destination range'};
 700                         }
 701                 }
 702                 foreach $_ (@ports)
 703                 {
 704                         if (!(&validport($_))) {
 705                                 if ($srcdst eq 'src'){
 706                                         return $Lang::tr{'source port numbers'};
 707                                 } else  {
 708                                         return $Lang::tr{'destination port numbers'};
 709                                 }
 710                         }
 711                 }
 712                 return;
 713         }
 714 }
 715
 716 sub IpInSubnet {
 717         my $addr = shift;
 718         my $network = shift;
 719         my $netmask = shift;
 720
 721         return &Network::ip_address_in_network($addr, "$network/$netmask");
 722 }
 723
 724 #
 725 # Return the following IP (IP+1) in dotted notation.
 726 # Call: NextIP ('1.1.1.1');
 727 # Return: '1.1.1.2'
 728 #
 729 sub NextIP {
 730         return &Network::find_next_ip_address(shift, 1);
 731 }
 732
 733 sub NextIP2 {
 734         return &Network::find_next_ip_address(shift, 4);
 735 }
 736
 737 sub ipcidr {
 738         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 739         return "$ip\/$cidr";
 740 }
 741
 742 sub ipcidr2msk {
 743        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 744        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 745        return "$ip\/$netmask";
 746 }
 747
 748 sub validemail {
 749     my $mail = shift;
 750     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 751     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 752     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 753     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 754     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 755     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 756     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 757     return 1;
 758 }
 759
 760 #
 761 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 762 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 763 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 764 #
 765 sub readhasharray {
 766     my ($filename, $hash) = @_;
 767     %$hash = ();
 768
 769     open(FILE, $filename) or die "Unable to read file $filename";
 770
 771     while (<FILE>) {
 772         my ($key, $rest, @temp);
 773         chomp;
 774         ($key, $rest) = split (/,/, $_, 2);
 775         if ($key =~ /^[0-9]+$/) {
 776             @temp = split (/,/, $rest);
 777             $hash->{$key} = \@temp;
 778         }
 779     }
 780     close FILE;
 781     return;
 782 }
 783
 784 sub writehasharray {
 785     my ($filename, $hash) = @_;
 786     my ($key, @temp, $i);
 787
 788     open(FILE, ">$filename") or die "Unable to write to file $filename";
 789
 790     foreach $key (keys %$hash) {
 791                 if ($key =~ /^[0-9]+$/) {
 792                         print FILE "$key";
 793                         foreach $i (0 .. $#{$hash->{$key}}) {
 794                                 print FILE ",$hash->{$key}[$i]";
 795                         }
 796                         print FILE "\n";
 797                 }
 798     }
 799     close FILE;
 800     return;
 801 }
 802
 803 sub findhasharraykey {
 804     foreach my $i (1 .. 1000000) {
 805         if ( ! exists $_[0]{$i}) {
 806              return $i;
 807         }
 808     }
 809 }
 810
 811 sub srtarray
 812 # Darren Critchley - darrenc@telus.net - (c) 2003
 813 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 814 # This subroutine will take the following parameters:
 815 #   ColumnNumber = the column which you want to sort on, starts at 1
 816 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 817 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 818 #   ArrayToBeSorted = the array that wants sorting
 819 #
 820 #   Returns an array that is sorted to your specs
 821 #
 822 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 823 #
 824 {
 825         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 826         my @tmparray;
 827         my @srtedarray;
 828         my $line;
 829         my $newline;
 830         my $ctr;
 831         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 832         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 833                 return (@tobesorted);
 834         }
 835         my @tmp = split(/\,/,$tobesorted[0]);
 836         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 837
 838         # Darren Critchley - validate parameters
 839         if ($colno > $ttlitems){$colno = '1';}
 840         $colno--; # remove one from colno to deal with arrays starting at 0
 841         if($colno < 0){$colno = '0';}
 842         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 843         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 844
 845         foreach $line (@tobesorted)
 846         {
 847                 chomp($line);
 848                 if ($line ne '') {
 849                         my @temp = split(/\,/,$line);
 850                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 851                         my $tmpholder = $temp[0];
 852                         $temp[0] = $temp[$colno];
 853                         $temp[$colno] = $tmpholder;
 854                         $newline = "";
 855                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 856                                 $newline=$newline . $temp[$ctr] . ",";
 857                         }
 858                         chop($newline);
 859                         push(@tmparray,$newline);
 860                 }
 861         }
 862         if ($alpnum eq 'n') {
 863                 @tmparray = sort {$a <=> $b} @tmparray;
 864         } else {
 865                 @tmparray = (sort @tmparray);
 866         }
 867         foreach $line (@tmparray)
 868         {
 869                 chomp($line);
 870                 if ($line ne '') {
 871                         my @temp = split(/\,/,$line);
 872                         my $tmpholder = $temp[0];
 873                         $temp[0] = $temp[$colno];
 874                         $temp[$colno] = $tmpholder;
 875                         $newline = "";
 876                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 877                                 $newline=$newline . $temp[$ctr] . ",";
 878                         }
 879                         chop($newline);
 880                         push(@srtedarray,$newline);
 881                 }
 882         }
 883
 884         if ($srtdir eq 'dsc') {
 885                 @tmparray = reverse(@srtedarray);
 886                 return (@tmparray);
 887         } else {
 888                 return (@srtedarray);
 889         }
 890 }
 891
 892 sub FetchPublicIp {
 893     my %proxysettings;
 894     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 895     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 896         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 897         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 898     }
 899     my $user_agent = &MakeUserAgent();
 900     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
 901                                                     80,
 902                                                     "/",
 903                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
 904                                                 );
 905     if ($response =~ m%HTTP/1\.. 200 OK%) {
 906         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
 907         return $1;
 908     }
 909     return '';
 910 }
 911
 912 #
 913 # Check if hostname.domain provided have IP provided
 914 # use gethostbyname to verify that
 915 # Params:
 916 #       IP
 917 #       hostname
 918 #       domain
 919 # Output
 920 #       1 IP matches host.domain
 921 #       0 not in sync
 922 #
 923 sub DyndnsServiceSync ($;$;$) {
 924
 925     my ($ip,$hostName,$domain) = @_;
 926     my @addresses;
 927
 928     #fix me no ip GROUP, what is the name ?
 929     $hostName =~ s/$General::noipprefix//;
 930     if ($hostName) { #may be empty
 931         $hostName = "$hostName.$domain";
 932         @addresses = gethostbyname($hostName);
 933     }
 934
 935     if ($addresses[0] eq '') {                  # nothing returned ?
 936         $hostName = $domain;                    # try resolving with domain only
 937         @addresses = gethostbyname($hostName);
 938     }
 939
 940     if ($addresses[0] ne '') {                  # got something ?
 941         #&General::log("name:$addresses[0], alias:$addresses[1]");
 942         # Build clear text list of IP
 943         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 944         if (grep (/$ip/, @addresses)) {
 945             return 1;
 946         }
 947     }
 948     return 0;
 949 }
 950 #
 951 # This sub returns the red IP used to compare in DyndnsServiceSync
 952 #
 953 sub GetDyndnsRedIP {
 954     my %settings;
 955     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 956
 957     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 958     my $ip = <IP>;
 959     close(IP);
 960     chomp $ip;
 961
 962     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
 963     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 964         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 965         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
 966         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
 967     {
 968         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 969             my $RealIP = &General::FetchPublicIp;
 970             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 971         }
 972     }
 973     return $ip;
 974 }
 975
 976 # Translate ICMP code to text
 977 # ref: http://www.iana.org/assignments/icmp-parameters
 978 sub GetIcmpDescription ($) {
 979     my $index = shift;
 980     my @icmp_description = (
 981     'Echo Reply',                       #0
 982     'Unassigned',
 983     'Unassigned',
 984     'Destination Unreachable',
 985     'Source Quench',
 986     'Redirect',
 987     'Alternate Host Address',
 988     'Unassigned',
 989     'Echo',
 990     'Router Advertisement',
 991     'Router Solicitation',              #10
 992     'Time Exceeded',
 993     'Parameter Problem',
 994     'Timestamp',
 995     'Timestamp Reply',
 996     'Information Request',
 997     'Information Reply',
 998     'Address Mask Request',
 999     'Address Mask Reply',
1000     'Reserved (for Security)',
1001     'Reserved (for Robustness Experiment)', #20
1002     'Reserved',
1003     'Reserved',
1004     'Reserved',
1005     'Reserved',
1006     'Reserved',
1007     'Reserved',
1008     'Reserved',
1009     'Reserved',
1010     'Reserved',
1011     'Traceroute',                               #30
1012     'Datagram Conversion Error',
1013     'Mobile Host Redirect',
1014     'IPv6 Where-Are-You',
1015     'IPv6 I-Am-Here',
1016     'Mobile Registration Request',
1017     'Mobile Registration Reply',
1018     'Domain Name Request',
1019     'Domain Name Reply',
1020     'SKIP',
1021     'Photur',                           #40
1022     'Experimental');
1023     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1024 }
1025
1026 sub GetCoreUpdateVersion() {
1027         my $core_update;
1028
1029         open(FILE, "/opt/pakfire/db/core/mine");
1030         while (<FILE>) {
1031                 $core_update = $_;
1032                 last;
1033         }
1034         close(FILE);
1035
1036         return $core_update;
1037 }
1038
1039 sub MakeUserAgent() {
1040         my $user_agent = "IPFire/$General::version";
1041
1042         my $core_update = &GetCoreUpdateVersion();
1043         if ($core_update ne "") {
1044                 $user_agent .= "/$core_update";
1045         }
1046
1047         return $user_agent;
1048 }
1049
1050 sub RedIsWireless() {
1051         # This function checks if a network device is a wireless device.
1052
1053         my %settings = ();
1054         &readhash("${General::swroot}/ethernet/settings", \%settings);
1055
1056         # Find the name of the network device.
1057         my $device = $settings{'RED_DEV'};
1058
1059         # Exit, if no device is configured.
1060         return 0 if ($device eq "");
1061
1062         # Return 1 if the device is a wireless one.
1063         my $path = "/sys/class/net/$device/wireless";
1064         if (-d $path) {
1065                 return 1;
1066         }
1067
1068         # Otherwise return zero.
1069         return 0;
1070 }
1071
1072 # Function to read a file with UTF-8 charset.
1073 sub read_file_utf8 ($) {
1074         my ($file) = @_;
1075
1076         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1077         local $/ = undef;
1078         my $all = <$in>;
1079         close $in;
1080
1081         return $all;
1082 }
1083
1084 # Function to write a file with UTF-8 charset.
1085 sub write_file_utf8 ($) {
1086         my ($file, $content) = @_;
1087
1088         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1089         print $out $content;
1090         close $out;
1091
1092         return;
1093 }
1094
1095 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1096
1097 sub firewall_config_changed() {
1098         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1099         close FILE;
1100 }
1101
1102 sub firewall_needs_reload() {
1103         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1104                 return 1;
1105         }
1106
1107         return 0;
1108 }
1109
1110 sub firewall_reload() {
1111         system("/usr/local/bin/firewallctrl");
1112 }
1113
1114 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1115 sub get_red_interface() {
1116
1117         open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
1118
1119         my $interface = <IFACE>;
1120         close(IFACE);
1121         chomp $interface;
1122
1123         return $interface;
1124 }
1125
1126 1;