config/cfgroot/general-functions.pl

   1 # SmoothWall CGIs
   2 #
   3 # This code is distributed under the terms of the GPL
   4 #
   5 # (c) The SmoothWall Team
   6 # Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
   7 # Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
   8 # Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
   9 # Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
  10 # Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
  11 #
  12 # $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
  13 #
  14
  15 package General;
  16
  17 use strict;
  18 use Socket;
  19 use IO::Socket;
  20 use Net::SSLeay;
  21 use Net::IPv4Addr qw(:all);
  22 $|=1; # line buffering
  23
  24 $General::version = 'VERSION';
  25 $General::swroot = 'CONFIG_ROOT';
  26 $General::noipprefix = 'noipg-';
  27 $General::adminmanualurl = 'http://wiki.ipfire.org';
  28
  29 #
  30 # log ("message") use default 'ipcop' tag
  31 # log ("tag","message") use your tag
  32 #
  33 sub log
  34 {
  35         my $tag='ipfire';
  36         $tag = shift if (@_>1);
  37         my $logmessage = $_[0];
  38         $logmessage =~ /([\w\W]*)/;
  39         $logmessage = $1;
  40         system('logger', '-t', $tag, $logmessage);
  41 }
  42
  43 sub readhash
  44 {
  45         my $filename = $_[0];
  46         my $hash = $_[1];
  47         my ($var, $val);
  48
  49
  50         # Some ipcop code expects that readhash 'complete' the hash if new entries
  51         # are presents. Not clear it !!!
  52         #%$hash = ();
  53
  54         open(FILE, $filename) or die "Unable to read file $filename";
  55
  56         while (<FILE>)
  57         {
  58                 chop;
  59                 ($var, $val) = split /=/, $_, 2;
  60                 if ($var)
  61                 {
  62                         $val =~ s/^\'//g;
  63                         $val =~ s/\'$//g;
  64
  65                         # Untaint variables read from hash
  66                         # trim space from begin and end
  67                         $var =~ s/^\s+//;
  68                         $var =~ s/\s+$//;
  69                         $var =~ /([A-Za-z0-9_-]*)/;
  70                         $var = $1;
  71                         $val =~ /([\w\W]*)/;
  72                         $val = $1;
  73                         $hash->{$var} = $val;
  74                 }
  75         }
  76         close FILE;
  77 }
  78
  79
  80 sub writehash
  81 {
  82         my $filename = $_[0];
  83         my $hash = $_[1];
  84         my ($var, $val);
  85
  86         # write cgi vars to the file.
  87         open(FILE, ">${filename}") or die "Unable to write file $filename";
  88         flock FILE, 2;
  89         foreach $var (keys %$hash)
  90         {
  91                 if ( $var eq "__CGI__"){next;}
  92                 $val = $hash->{$var};
  93                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
  94                 # location of the mouse are submitted as well, this was being written to the settings file causing
  95                 # some serious grief! This skips the variable.x and variable.y
  96                 if (!($var =~ /(.x|.y)$/)) {
  97                         if ($val =~ / /) {
  98                                 $val = "\'$val\'"; }
  99                         if (!($var =~ /^ACTION/)) {
 100                                 print FILE "${var}=${val}\n"; }
 101                 }
 102         }
 103         close FILE;
 104 }
 105
 106 sub writehashpart
 107 {
 108         # This function replaces the given hash in the original hash by keeping the old
 109         # content and just replacing the new content
 110
 111         my $filename = $_[0];
 112         my $newhash = $_[1];
 113         my %oldhash;
 114         my ($var, $val);
 115
 116         readhash("${filename}", \%oldhash);
 117
 118         foreach $var (keys %$newhash){
 119                 $oldhash{$var}=$newhash->{$var};
 120         }
 121
 122         # write cgi vars to the file.
 123         open(FILE, ">${filename}") or die "Unable to write file $filename";
 124         flock FILE, 2;
 125         foreach $var (keys %oldhash)
 126         {
 127                 if ( $var eq "__CGI__"){next;}
 128                 $val = $oldhash{$var};
 129                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 130                 # location of the mouse are submitted as well, this was being written to the settings file causing
 131                 # some serious grief! This skips the variable.x and variable.y
 132                 if (!($var =~ /(.x|.y)$/)) {
 133                         if ($val =~ / /) {
 134                                 $val = "\'$val\'"; }
 135                         if (!($var =~ /^ACTION/)) {
 136                                 print FILE "${var}=${val}\n"; }
 137                 }
 138         }
 139         close FILE;
 140 }
 141
 142 sub age
 143 {
 144         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 145                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 146         my $now = time;
 147
 148         my $totalsecs = $now - $mtime;
 149         my $days = int($totalsecs / 86400);
 150         my $totalhours = int($totalsecs / 3600);
 151         my $hours = $totalhours % 24;
 152         my $totalmins = int($totalsecs / 60);
 153         my $mins = $totalmins % 60;
 154         my $secs = $totalsecs % 60;
 155
 156         return "${days}d ${hours}h ${mins}m ${secs}s";
 157 }
 158
 159 sub validip
 160 {
 161         my $ip = $_[0];
 162
 163         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 164                 return 0; }
 165         else
 166         {
 167                 my @octets = ($1, $2, $3, $4);
 168                 foreach $_ (@octets)
 169                 {
 170                         if (/^0./) {
 171                                 return 0; }
 172                         if ($_ < 0 || $_ > 255) {
 173                                 return 0; }
 174                 }
 175                 return 1;
 176         }
 177 }
 178
 179 sub validmask
 180 {
 181         my $mask = $_[0];
 182
 183         # secord part an ip?
 184         if (&validip($mask)) {
 185                 return 1; }
 186         # second part a number?
 187         if (/^0/) {
 188                 return 0; }
 189         if (!($mask =~ /^\d+$/)) {
 190                 return 0; }
 191         if ($mask >= 0 && $mask <= 32) {
 192                 return 1; }
 193         return 0;
 194 }
 195
 196 sub validipormask
 197 {
 198         my $ipormask = $_[0];
 199
 200         # see if it is a IP only.
 201         if (&validip($ipormask)) {
 202                 return 1; }
 203         # split it into number and mask.
 204         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 205                 return 0; }
 206         my $ip = $1;
 207         my $mask = $2;
 208         # first part not a ip?
 209         if (!(&validip($ip))) {
 210                 return 0; }
 211         return &validmask($mask);
 212 }
 213
 214 sub subtocidr
 215 {
 216         #gets: Subnet in decimal (255.255.255.0)
 217         #Gives: 24 (The cidr of network)
 218         my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
 219         my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
 220         my $bin = unpack("B*", pack("N", $num));
 221         my $count = ($bin =~ tr/1/1/);
 222         return $count;
 223 }
 224
 225 sub cidrtosub
 226 {
 227         #gets: Cidr of network (20-30 for ccd)
 228         #Konverts 30 to 255.255.255.252 e.g
 229         my $cidr=$_[0];
 230     my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 231     return "$netmask";
 232 }
 233
 234 sub iporsubtodec
 235 {
 236         #Gets: Ip address or subnetmask in decimal oder CIDR
 237         #Gives: What it gets only in CIDR format
 238         my $subnet=$_[0];
 239         my $net;
 240         my $mask;
 241         my $full=0;
 242         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 243                 ($net,$mask) = split (/\//,$subnet);
 244                 $full=1;
 245                 return "$subnet";
 246         }else{
 247                 $mask=$subnet;
 248         }
 249         #Subnet already in decimal and valid?
 250         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 251                 for (my $i=8;$i<=32;$i++){
 252                         if (&General::cidrtosub($i) eq $mask){
 253                                 if ($full == 0){return $mask;}else{
 254                                                          return $net."/".$mask;
 255                                 }
 256                         }
 257                 }
 258         }
 259         #Subnet in binary format?
 260         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 261                         if($full == 0){ return &General::cidrtosub($mask);}else{
 262                                                  return $net."/".&General::cidrtosub($mask);
 263                         }
 264         }else{
 265                         return 3;
 266         }
 267         return 3;
 268 }
 269
 270
 271 sub iporsubtocidr
 272 {
 273         #gets: Ip Address  or subnetmask in decimal oder CIDR
 274         #Gives: What it gets only in CIDR format
 275         my $subnet=$_[0];
 276         my $net;
 277         my $mask;
 278         my $full=0;
 279         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 280                 ($net,$mask) = split (/\//,$subnet);
 281                 $full=1;
 282         }else{
 283                 $mask=$subnet;
 284         }
 285         #Subnet in decimal and valid?
 286         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 287                 for (my $i=8;$i<=32;$i++){
 288                         if (&General::cidrtosub($i) eq $mask){
 289                                 if ($full == 0){return &General::subtocidr($mask);}else{
 290                                                          return $net."/".&General::subtocidr($mask);
 291                                 }
 292                         }
 293                 }
 294         }
 295         #Subnet already in binary format?
 296         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 297                         if($full == 0){ return $mask;}else{
 298                                                  return $net."/".$mask;
 299                         }
 300         }else{
 301                         return 3;
 302         }
 303         return 3;
 304 }
 305
 306 sub getnetworkip
 307 {
 308         #Gets:  IP, CIDR    (10.10.10.0-255, 24)
 309         #Gives:  10.10.10.0
 310         my ($ccdip,$ccdsubnet) = @_;
 311         my $ip_address_binary = inet_aton( $ccdip );
 312         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 313         my $network_address    = inet_ntoa( $ip_address_binary & $netmask_binary );
 314         return $network_address;
 315 }
 316
 317 sub getccdbc
 318 {
 319         #Gets: IP in Form ("192.168.0.0/24")
 320         #Gives: Broadcastaddress of network
 321         my $ccdnet=$_;
 322         my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
 323         my $ip_address_binary = inet_aton( $ccdip );
 324         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 325         my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
 326         return $broadcast_address;
 327 }
 328
 329 sub ip2dec
 330 {
 331     my $ip_num;
 332     my $ip=$_[0];
 333     if ( $ip =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
 334         $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
 335     } else {
 336         $ip_num = -1;
 337     }
 338     $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
 339     return($ip_num);
 340 }
 341
 342 sub dec2ip
 343 {
 344     my $ip;
 345     my $ip_num=$_[0];
 346         my $o1=$ip_num%256;
 347         $ip_num=int($ip_num/256);
 348         my $o2=$ip_num%256;
 349         $ip_num=int($ip_num/256);
 350         my $o3=$ip_num%256;
 351         $ip_num=int($ip_num/256);
 352         my $o4=$ip_num%256;
 353         $ip="$o4.$o3.$o2.$o1";
 354     return ($ip);
 355 }
 356
 357 sub getnextip
 358 {
 359         my $decip=&ip2dec($_[0]);
 360         $decip=$decip+4;
 361         return &dec2ip($decip);
 362 }
 363
 364 sub getlastip
 365 {
 366         my $decip=&ip2dec($_[0]);
 367         $decip--;
 368         return &dec2ip($decip);
 369 }
 370
 371 sub validipandmask
 372 {
 373         #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
 374         #Gives: True bzw 0 if success or false
 375         my $ccdnet=$_[0];
 376         my $subcidr;
 377
 378         if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
 379                 return 0;
 380         }
 381         my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
 382         #IP valid?
 383         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 ))) {
 384                 #Subnet in decimal and valid?
 385                 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
 386                         for (my $i=8;$i<=32;$i++){
 387                                 if (&General::cidrtosub($i) eq $ccdsubnet){
 388                                         return 1;
 389                                 }
 390                         }
 391                 #Subnet already in binary format?
 392                 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 393                         return 1;
 394                 }else{
 395                         return 0;
 396                 }
 397
 398         }
 399         return 0;
 400 }
 401
 402 sub validport
 403 {
 404         $_ = $_[0];
 405
 406         if (!/^\d+$/) {
 407                 return 0; }
 408         if (/^0./) {
 409                 return 0; }
 410         if ($_ >= 1 && $_ <= 65535) {
 411                 return 1; }
 412         return 0;
 413 }
 414
 415 sub validproxyport
 416 {
 417         $_ = $_[0];
 418
 419         if (!/^\d+$/) {
 420                 return 0; }
 421         if (/^0./) {
 422                 return 0; }
 423         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 424                 return 0; }
 425         elsif ($_ >= 1 && $_ <= 65535) {
 426                 return 1; }
 427         return 0;
 428 }
 429
 430 sub validmac
 431 {
 432         my $checkmac = $_[0];
 433         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 434         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 435         {
 436                 return 0;
 437         }
 438         return 1;
 439 }
 440
 441 sub validhostname
 442 {
 443         # Checks a hostname against RFC1035
 444         my $hostname = $_[0];
 445
 446         # Each part should be at least two characters in length
 447         # but no more than 63 characters
 448         if (length ($hostname) < 1 || length ($hostname) > 63) {
 449                 return 0;}
 450         # Only valid characters are a-z, A-Z, 0-9 and -
 451         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 452                 return 0;}
 453         # First character can only be a letter or a digit
 454         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 455                 return 0;}
 456         # Last character can only be a letter or a digit
 457         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 458                 return 0;}
 459         return 1;
 460 }
 461
 462 sub validdomainname
 463 {
 464         my $part;
 465
 466         # Checks a domain name against RFC1035
 467         my $domainname = $_[0];
 468         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 469
 470         foreach $part (@parts) {
 471                 # Each part should be at least two characters in length
 472                 # but no more than 63 characters
 473                 if (length ($part) < 2 || length ($part) > 63) {
 474                         return 0;}
 475                 # Only valid characters are a-z, A-Z, 0-9 and -
 476                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 477                         return 0;}
 478                 # First character can only be a letter or a digit
 479                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 480                         return 0;}
 481                 # Last character can only be a letter or a digit
 482                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 483                         return 0;}
 484         }
 485         return 1;
 486 }
 487
 488 sub validfqdn
 489 {
 490         my $part;
 491
 492         # Checks a fully qualified domain name against RFC1035
 493         my $fqdn = $_[0];
 494         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 495         if (scalar(@parts) < 2) {               # At least two parts should
 496                 return 0;}                      # exist in a FQDN
 497                                                 # (i.e. hostname.domain)
 498         foreach $part (@parts) {
 499                 # Each part should be at least one character in length
 500                 # but no more than 63 characters
 501                 if (length ($part) < 1 || length ($part) > 63) {
 502                         return 0;}
 503                 # Only valid characters are a-z, A-Z, 0-9 and -
 504                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 505                         return 0;}
 506                 # First character can only be a letter or a digit
 507                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 508                         return 0;}
 509                 # Last character can only be a letter or a digit
 510                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 511                         return 0;}
 512         }
 513         return 1;
 514 }
 515
 516 sub validportrange # used to check a port range
 517 {
 518         my $port = $_[0]; # port values
 519         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 520         my $srcdst = $_[1]; # is it a source or destination port
 521
 522         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 523
 524                 if (!(&validport($port))) {
 525                         if ($srcdst eq 'src'){
 526                                 return $Lang::tr{'source port numbers'};
 527                         } else  {
 528                                 return $Lang::tr{'destination port numbers'};
 529                         }
 530                 }
 531         }
 532         else
 533         {
 534                 my @ports = ($1, $2);
 535                 if ($1 >= $2){
 536                         if ($srcdst eq 'src'){
 537                                 return $Lang::tr{'bad source range'};
 538                         } else  {
 539                                 return $Lang::tr{'bad destination range'};
 540                         }
 541                 }
 542                 foreach $_ (@ports)
 543                 {
 544                         if (!(&validport($_))) {
 545                                 if ($srcdst eq 'src'){
 546                                         return $Lang::tr{'source port numbers'};
 547                                 } else  {
 548                                         return $Lang::tr{'destination port numbers'};
 549                                 }
 550                         }
 551                 }
 552                 return;
 553         }
 554 }
 555
 556 # Test if IP is within a subnet
 557 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 558 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 559 #       Everything in dottted notation
 560 # Return: TRUE/FALSE
 561 sub IpInSubnet
 562 {
 563     my $ip = unpack('N', &Socket::inet_aton(shift));
 564     my $start = unpack('N', &Socket::inet_aton(shift));
 565     my $mask  = unpack('N', &Socket::inet_aton(shift));
 566        $start &= $mask;  # base of subnet...
 567     my $end   = $start + ~$mask;
 568     return (($ip >= $start) && ($ip <= $end));
 569 }
 570
 571 #
 572 # Return the following IP (IP+1) in dotted notation.
 573 # Call: NextIP ('1.1.1.1');
 574 # Return: '1.1.1.2'
 575 #
 576 sub NextIP
 577 {
 578     return &Socket::inet_ntoa( pack("N", 1 +  unpack('N', &Socket::inet_aton(shift))
 579                                    )
 580                              );
 581 }
 582 sub NextIP2
 583 {
 584     return &Socket::inet_ntoa( pack("N", 4 +  unpack('N', &Socket::inet_aton(shift))
 585                                    )
 586                              );
 587 }
 588 sub ipcidr
 589 {
 590         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 591         return "$ip\/$cidr";
 592 }
 593
 594 sub ipcidr2msk
 595 {
 596        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 597        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 598        return "$ip\/$netmask";
 599 }
 600
 601
 602 sub validemail {
 603     my $mail = shift;
 604     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 605     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 606     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 607     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 608     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 609     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 610     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 611     return 1;
 612 }
 613
 614 #
 615 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 616 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 617 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 618 #
 619 sub readhasharray {
 620     my ($filename, $hash) = @_;
 621     %$hash = ();
 622
 623     open(FILE, $filename) or die "Unable to read file $filename";
 624
 625     while (<FILE>) {
 626         my ($key, $rest, @temp);
 627         chomp;
 628         ($key, $rest) = split (/,/, $_, 2);
 629         if ($key =~ /^[0-9]+$/) {
 630             @temp = split (/,/, $rest);
 631             $hash->{$key} = \@temp;
 632         }
 633     }
 634     close FILE;
 635     return;
 636 }
 637
 638 sub writehasharray {
 639     my ($filename, $hash) = @_;
 640     my ($key, @temp, $i);
 641
 642     open(FILE, ">$filename") or die "Unable to write to file $filename";
 643
 644     foreach $key (keys %$hash) {
 645                 if ($key =~ /^[0-9]+$/) {
 646                         print FILE "$key";
 647                         foreach $i (0 .. $#{$hash->{$key}}) {
 648                                 print FILE ",$hash->{$key}[$i]";
 649                         }
 650                         print FILE "\n";
 651                 }
 652     }
 653     close FILE;
 654     return;
 655 }
 656
 657 sub findhasharraykey {
 658     foreach my $i (1 .. 1000000) {
 659         if ( ! exists $_[0]{$i}) {
 660              return $i;
 661         }
 662     }
 663 }
 664
 665 sub srtarray
 666 # Darren Critchley - darrenc@telus.net - (c) 2003
 667 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 668 # This subroutine will take the following parameters:
 669 #   ColumnNumber = the column which you want to sort on, starts at 1
 670 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 671 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 672 #   ArrayToBeSorted = the array that wants sorting
 673 #
 674 #   Returns an array that is sorted to your specs
 675 #
 676 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 677 #
 678 {
 679         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 680         my @tmparray;
 681         my @srtedarray;
 682         my $line;
 683         my $newline;
 684         my $ctr;
 685         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 686         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 687                 return (@tobesorted);
 688         }
 689         my @tmp = split(/\,/,$tobesorted[0]);
 690         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 691
 692         # Darren Critchley - validate parameters
 693         if ($colno > $ttlitems){$colno = '1';}
 694         $colno--; # remove one from colno to deal with arrays starting at 0
 695         if($colno < 0){$colno = '0';}
 696         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 697         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 698
 699         foreach $line (@tobesorted)
 700         {
 701                 chomp($line);
 702                 if ($line ne '') {
 703                         my @temp = split(/\,/,$line);
 704                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 705                         my $tmpholder = $temp[0];
 706                         $temp[0] = $temp[$colno];
 707                         $temp[$colno] = $tmpholder;
 708                         $newline = "";
 709                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 710                                 $newline=$newline . $temp[$ctr] . ",";
 711                         }
 712                         chop($newline);
 713                         push(@tmparray,$newline);
 714                 }
 715         }
 716         if ($alpnum eq 'n') {
 717                 @tmparray = sort {$a <=> $b} @tmparray;
 718         } else {
 719                 @tmparray = (sort @tmparray);
 720         }
 721         foreach $line (@tmparray)
 722         {
 723                 chomp($line);
 724                 if ($line ne '') {
 725                         my @temp = split(/\,/,$line);
 726                         my $tmpholder = $temp[0];
 727                         $temp[0] = $temp[$colno];
 728                         $temp[$colno] = $tmpholder;
 729                         $newline = "";
 730                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 731                                 $newline=$newline . $temp[$ctr] . ",";
 732                         }
 733                         chop($newline);
 734                         push(@srtedarray,$newline);
 735                 }
 736         }
 737
 738         if ($srtdir eq 'dsc') {
 739                 @tmparray = reverse(@srtedarray);
 740                 return (@tmparray);
 741         } else {
 742                 return (@srtedarray);
 743         }
 744 }
 745
 746 sub FetchPublicIp {
 747     my %proxysettings;
 748     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 749     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 750         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 751         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 752     }
 753     my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
 754                                                     80,
 755                                                     "/",
 756                                                     Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
 757                                                 );
 758     if ($response =~ m%HTTP/1\.. 200 OK%) {
 759         $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
 760         return $1;
 761     }
 762     return '';
 763 }
 764
 765 #
 766 # Check if hostname.domain provided have IP provided
 767 # use gethostbyname to verify that
 768 # Params:
 769 #       IP
 770 #       hostname
 771 #       domain
 772 # Output
 773 #       1 IP matches host.domain
 774 #       0 not in sync
 775 #
 776 sub DyndnsServiceSync ($;$;$) {
 777
 778     my ($ip,$hostName,$domain) = @_;
 779     my @addresses;
 780
 781     #fix me no ip GROUP, what is the name ?
 782     $hostName =~ s/$General::noipprefix//;
 783     if ($hostName) { #may be empty
 784         $hostName = "$hostName.$domain";
 785         @addresses = gethostbyname($hostName);
 786     }
 787
 788     if ($addresses[0] eq '') {                  # nothing returned ?
 789         $hostName = $domain;                    # try resolving with domain only
 790         @addresses = gethostbyname($hostName);
 791     }
 792
 793     if ($addresses[0] ne '') {                  # got something ?
 794         #&General::log("name:$addresses[0], alias:$addresses[1]");
 795         # Build clear text list of IP
 796         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 797         if (grep (/$ip/, @addresses)) {
 798             return 1;
 799         }
 800     }
 801     return 0;
 802 }
 803 #
 804 # This sub returns the red IP used to compare in DyndnsServiceSync
 805 #
 806 sub GetDyndnsRedIP {
 807     my %settings;
 808     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 809
 810     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 811     my $ip = <IP>;
 812     close(IP);
 813     chomp $ip;
 814
 815     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 816         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 817         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
 818     {
 819         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 820             my $RealIP = &General::FetchPublicIp;
 821             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 822         }
 823     }
 824     return $ip;
 825 }
 826
 827 # Translate ICMP code to text
 828 # ref: http://www.iana.org/assignments/icmp-parameters
 829 sub GetIcmpDescription ($) {
 830     my $index = shift;
 831     my @icmp_description = (
 832     'Echo Reply',                       #0
 833     'Unassigned',
 834     'Unassigned',
 835     'Destination Unreachable',
 836     'Source Quench',
 837     'Redirect',
 838     'Alternate Host Address',
 839     'Unassigned',
 840     'Echo',
 841     'Router Advertisement',
 842     'Router Solicitation',              #10
 843     'Time Exceeded',
 844     'Parameter Problem',
 845     'Timestamp',
 846     'Timestamp Reply',
 847     'Information Request',
 848     'Information Reply',
 849     'Address Mask Request',
 850     'Address Mask Reply',
 851     'Reserved (for Security)',
 852     'Reserved (for Robustness Experiment)', #20
 853     'Reserved',
 854     'Reserved',
 855     'Reserved',
 856     'Reserved',
 857     'Reserved',
 858     'Reserved',
 859     'Reserved',
 860     'Reserved',
 861     'Reserved',
 862     'Traceroute',                               #30
 863     'Datagram Conversion Error',
 864     'Mobile Host Redirect',
 865     'IPv6 Where-Are-You',
 866     'IPv6 I-Am-Here',
 867     'Mobile Registration Request',
 868     'Mobile Registration Reply',
 869     'Domain Name Request',
 870     'Domain Name Reply',
 871     'SKIP',
 872     'Photur',                           #40
 873     'Experimental');
 874     if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
 875 }
 876 1;