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