-# SmoothWall CGIs\r
-#\r
-# This code is distributed under the terms of the GPL\r
-#\r
-# (c) The SmoothWall Team\r
-# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r
-# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r
-# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r
-# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r
-# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r
-#\r
-# $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $\r
-#\r
-\r
-package General;\r
-\r
-use strict;\r
-use Socket;\r
-use IO::Socket;\r
-\r
-$|=1; # line buffering\r
-\r
-$General::version = 'VERSION';\r
-$General::swroot = 'CONFIG_ROOT';\r
-$General::noipprefix = 'noipg-';\r
-$General::adminmanualurl = 'http://www.ipcop.org/1.4.0/en/admin/html';\r
-\r
-sub log\r
-{\r
- my $logmessage = $_[0];\r
- $logmessage =~ /([\w\W]*)/;\r
- $logmessage = $1;\r
- system('/usr/bin/logger', '-t', 'ipcop', $logmessage);\r
-}\r
-\r
-sub readhash\r
-{\r
- my $filename = $_[0];\r
- my $hash = $_[1];\r
- my ($var, $val);\r
- \r
- \r
- # Some ipcop code expects that readhash 'complete' the hash if new entries\r
- # are presents. Not clear it !!!\r
- #%$hash = ();\r
-\r
- open(FILE, $filename) or die "Unable to read file $filename";\r
- \r
- while (<FILE>)\r
- {\r
- chop;\r
- ($var, $val) = split /=/, $_, 2;\r
- if ($var)\r
- {\r
- $val =~ s/^\'//g;\r
- $val =~ s/\'$//g;\r
-\r
- # Untaint variables read from hash\r
- $var =~ /([A-Za-z0-9_-]*)/; $var = $1;\r
- $val =~ /([\w\W]*)/; $val = $1;\r
- $hash->{$var} = $val;\r
- }\r
- }\r
- close FILE;\r
-}\r
-\r
-\r
-sub writehash\r
-{\r
- my $filename = $_[0];\r
- my $hash = $_[1];\r
- my ($var, $val);\r
- \r
- # write cgi vars to the file.\r
- open(FILE, ">${filename}") or die "Unable to write file $filename";\r
- flock FILE, 2;\r
- foreach $var (keys %$hash) \r
- {\r
- $val = $hash->{$var};\r
- # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y\r
- # location of the mouse are submitted as well, this was being written to the settings file causing\r
- # some serious grief! This skips the variable.x and variable.y\r
- if (!($var =~ /(.x|.y)$/)) {\r
- if ($val =~ / /) {\r
- $val = "\'$val\'"; }\r
- if (!($var =~ /^ACTION/)) {\r
- print FILE "${var}=${val}\n"; }\r
- }\r
- }\r
- close FILE;\r
-}\r
-\r
-\r
-sub age\r
-{\r
- my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,\r
- $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];\r
- my $now = time;\r
-\r
- my $totalsecs = $now - $mtime;\r
- my $days = int($totalsecs / 86400);\r
- my $totalhours = int($totalsecs / 3600);\r
- my $hours = $totalhours % 24;\r
- my $totalmins = int($totalsecs / 60);\r
- my $mins = $totalmins % 60;\r
- my $secs = $totalsecs % 60;\r
-\r
- return "${days}d ${hours}h ${mins}m ${secs}s";\r
-}\r
-\r
-sub validip\r
-{\r
- my $ip = $_[0];\r
-\r
- if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {\r
- return 0; }\r
- else \r
- {\r
- my @octets = ($1, $2, $3, $4);\r
- foreach $_ (@octets)\r
- {\r
- if (/^0./) {\r
- return 0; }\r
- if ($_ < 0 || $_ > 255) {\r
- return 0; }\r
- }\r
- return 1;\r
- }\r
-}\r
-\r
-sub validmask\r
-{\r
- my $mask = $_[0];\r
-\r
- # secord part an ip?\r
- if (&validip($mask)) {\r
- return 1; }\r
- # second part a number?\r
- if (/^0/) {\r
- return 0; }\r
- if (!($mask =~ /^\d+$/)) {\r
- return 0; }\r
- if ($mask >= 0 && $mask <= 32) {\r
- return 1; }\r
- return 0;\r
-}\r
-\r
-sub validipormask\r
-{\r
- my $ipormask = $_[0];\r
-\r
- # see if it is a IP only.\r
- if (&validip($ipormask)) {\r
- return 1; }\r
- # split it into number and mask.\r
- if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {\r
- return 0; }\r
- my $ip = $1;\r
- my $mask = $2;\r
- # first part not a ip?\r
- if (!(&validip($ip))) {\r
- return 0; }\r
- return &validmask($mask);\r
-}\r
-\r
-sub validipandmask\r
-{\r
- my $ipandmask = $_[0];\r
-\r
- # split it into number and mask.\r
- if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {\r
- return 0; }\r
- my $ip = $1;\r
- my $mask = $2;\r
- # first part not a ip?\r
- if (!(&validip($ip))) {\r
- return 0; }\r
- return &validmask($mask);\r
-}\r
-\r
-sub validport\r
-{\r
- $_ = $_[0];\r
-\r
- if (!/^\d+$/) {\r
- return 0; }\r
- if (/^0./) {\r
- return 0; }\r
- if ($_ >= 1 && $_ <= 65535) {\r
- return 1; }\r
- return 0;\r
-}\r
-\r
-sub validmac\r
-{\r
- my $checkmac = $_[0];\r
- my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)\r
- if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)\r
- {\r
- return 0;\r
- }\r
- return 1;\r
-}\r
-\r
-sub validhostname\r
-{\r
- # Checks a hostname against RFC1035\r
- my $hostname = $_[0];\r
-\r
- # Each part should be at least two characters in length\r
- # but no more than 63 characters\r
- if (length ($hostname) < 1 || length ($hostname) > 63) {\r
- return 0;}\r
- # Only valid characters are a-z, A-Z, 0-9 and -\r
- if ($hostname !~ /^[a-zA-Z0-9-]*$/) {\r
- return 0;}\r
- # First character can only be a letter or a digit\r
- if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- # Last character can only be a letter or a digit\r
- if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- return 1;\r
-}\r
-\r
-sub validdomainname\r
-{\r
- my $part;\r
-\r
- # Checks a domain name against RFC1035\r
- my $domainname = $_[0];\r
- my @parts = split (/\./, $domainname); # Split hostname at the '.'\r
-\r
- foreach $part (@parts) {\r
- # Each part should be at least two characters in length\r
- # but no more than 63 characters\r
- if (length ($part) < 2 || length ($part) > 63) {\r
- return 0;}\r
- # Only valid characters are a-z, A-Z, 0-9 and -\r
- if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
- return 0;}\r
- # First character can only be a letter or a digit\r
- if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- # Last character can only be a letter or a digit\r
- if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- }\r
- return 1;\r
-}\r
-\r
-sub validfqdn\r
-{\r
- my $part;\r
-\r
- # Checks a fully qualified domain name against RFC1035\r
- my $fqdn = $_[0];\r
- my @parts = split (/\./, $fqdn); # Split hostname at the '.'\r
- if (scalar(@parts) < 2) { # At least two parts should\r
- return 0;} # exist in a FQDN\r
- # (i.e. hostname.domain)\r
- foreach $part (@parts) {\r
- # Each part should be at least one character in length\r
- # but no more than 63 characters\r
- if (length ($part) < 1 || length ($part) > 63) {\r
- return 0;}\r
- # Only valid characters are a-z, A-Z, 0-9 and -\r
- if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
- return 0;}\r
- # First character can only be a letter or a digit\r
- if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- # Last character can only be a letter or a digit\r
- if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
- return 0;}\r
- }\r
- return 1;\r
-}\r
-\r
-sub validportrange # used to check a port range \r
-{\r
- my $port = $_[0]; # port values\r
- $port =~ tr/-/:/; # replace all - with colons just in case someone used -\r
- my $srcdst = $_[1]; # is it a source or destination port\r
-\r
- if (!($port =~ /^(\d+)\:(\d+)$/)) {\r
- \r
- if (!(&validport($port))) { \r
- if ($srcdst eq 'src'){\r
- return $Lang::tr{'source port numbers'};\r
- } else {\r
- return $Lang::tr{'destination port numbers'};\r
- } \r
- }\r
- }\r
- else \r
- {\r
- my @ports = ($1, $2);\r
- if ($1 >= $2){\r
- if ($srcdst eq 'src'){\r
- return $Lang::tr{'bad source range'};\r
- } else {\r
- return $Lang::tr{'bad destination range'};\r
- } \r
- }\r
- foreach $_ (@ports)\r
- {\r
- if (!(&validport($_))) {\r
- if ($srcdst eq 'src'){\r
- return $Lang::tr{'source port numbers'}; \r
- } else {\r
- return $Lang::tr{'destination port numbers'};\r
- } \r
- }\r
- }\r
- return;\r
- }\r
-}\r
-\r
-# Test if IP is within a subnet\r
-# Call: IpInSubnet (Addr, Subnet, Subnet Mask)\r
-# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1\r
-# Everything in dottted notation\r
-# Return: TRUE/FALSE\r
-sub IpInSubnet\r
-{\r
- my $ip = unpack('N', &Socket::inet_aton(shift));\r
- my $start = unpack('N', &Socket::inet_aton(shift));\r
- my $mask = unpack('N', &Socket::inet_aton(shift));\r
- $start &= $mask; # base of subnet...\r
- my $end = $start + ~$mask;\r
- return (($ip >= $start) && ($ip <= $end));\r
-}\r
-\r
-sub validemail {\r
- my $mail = shift;\r
- return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );\r
- return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);\r
- return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );\r
- return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );\r
- return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );\r
- return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );\r
- return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );\r
- return 1;\r
-}\r
-\r
-sub readhasharray {\r
- my ($filename, $hash) = @_;\r
- %$hash = ();\r
-\r
- open(FILE, $filename) or die "Unable to read file $filename";\r
-\r
- while (<FILE>) {\r
- my ($key, $rest, @temp);\r
- chomp;\r
- ($key, $rest) = split (/,/, $_, 2);\r
- if ($key =~ /^[0-9]+$/ && $rest) {\r
- @temp = split (/,/, $rest);\r
- $hash->{$key} = \@temp;\r
- }\r
- }\r
- close FILE;\r
- return;\r
-}\r
-\r
-sub writehasharray {\r
- my ($filename, $hash) = @_;\r
- my ($key, @temp, $i);\r
-\r
- open(FILE, ">$filename") or die "Unable to write to file $filename";\r
-\r
- foreach $key (keys %$hash) {\r
- if ( $hash->{$key} ) {\r
- print FILE "$key";\r
- foreach $i (0 .. $#{$hash->{$key}}) {\r
- print FILE ",$hash->{$key}[$i]";\r
- }\r
- }\r
- print FILE "\n";\r
- }\r
- close FILE;\r
- return;\r
-}\r
-\r
-sub findhasharraykey {\r
- foreach my $i (1 .. 1000000) {\r
- if ( ! exists $_[0]{$i}) {\r
- return $i;\r
- }\r
- }\r
-}\r
-\r
-sub srtarray \r
-# Darren Critchley - darrenc@telus.net - (c) 2003\r
-# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)\r
-# This subroutine will take the following parameters:\r
-# ColumnNumber = the column which you want to sort on, starts at 1\r
-# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic\r
-# SortDirection = asc or dsc (lowercase) Ascending or Descending sort\r
-# ArrayToBeSorted = the array that wants sorting\r
-#\r
-# Returns an array that is sorted to your specs\r
-#\r
-# If SortOrder is greater than the elements in array, then it defaults to the first element\r
-# \r
-{\r
- my ($colno, $alpnum, $srtdir, @tobesorted) = @_;\r
- my @tmparray;\r
- my @srtedarray;\r
- my $line;\r
- my $newline;\r
- my $ctr;\r
- my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array\r
- if ($ttlitems < 1){ # if no items, don't waste our time lets leave\r
- return (@tobesorted);\r
- }\r
- my @tmp = split(/\,/,$tobesorted[0]);\r
- $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array\r
-\r
- # Darren Critchley - validate parameters\r
- if ($colno > $ttlitems){$colno = '1';}\r
- $colno--; # remove one from colno to deal with arrays starting at 0\r
- if($colno < 0){$colno = '0';}\r
- if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }\r
- if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }\r
-\r
- foreach $line (@tobesorted)\r
- {\r
- chomp($line);\r
- if ($line ne '') {\r
- my @temp = split(/\,/,$line);\r
- # Darren Critchley - juggle the fields so that the one we want to sort on is first\r
- my $tmpholder = $temp[0];\r
- $temp[0] = $temp[$colno];\r
- $temp[$colno] = $tmpholder;\r
- $newline = "";\r
- for ($ctr=0; $ctr < $ttlitems ; $ctr++) {\r
- $newline=$newline . $temp[$ctr] . ",";\r
- }\r
- chop($newline);\r
- push(@tmparray,$newline);\r
- }\r
- }\r
- if ($alpnum eq 'n') {\r
- @tmparray = sort {$a <=> $b} @tmparray;\r
- } else {\r
- @tmparray = (sort @tmparray);\r
- }\r
- foreach $line (@tmparray)\r
- {\r
- chomp($line);\r
- if ($line ne '') {\r
- my @temp = split(/\,/,$line);\r
- my $tmpholder = $temp[0];\r
- $temp[0] = $temp[$colno];\r
- $temp[$colno] = $tmpholder;\r
- $newline = "";\r
- for ($ctr=0; $ctr < $ttlitems ; $ctr++){\r
- $newline=$newline . $temp[$ctr] . ",";\r
- }\r
- chop($newline);\r
- push(@srtedarray,$newline);\r
- }\r
- }\r
-\r
- if ($srtdir eq 'dsc') {\r
- @tmparray = reverse(@srtedarray);\r
- return (@tmparray);\r
- } else {\r
- return (@srtedarray);\r
- }\r
-}\r
-\r
-sub FetchPublicIp {\r
- my %proxysettings;\r
- &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);\r
- if ($_=$proxysettings{'UPSTREAM_PROXY'}) {\r
- my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);\r
- Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );\r
- }\r
- my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',\r
- 80,\r
- "/",\r
- Net::SSLeay::make_headers('User-Agent' => 'Ipcop' )\r
- );\r
- if ($response =~ m%HTTP/1\.. 200 OK%) {\r
- $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;\r
- return $1;\r
- }\r
- return '';\r
-}\r
-\r
-#\r
-# Check if hostname.domain provided have IP provided\r
-# use gethostbyname to verify that\r
-# Params:\r
-# IP\r
-# hostname\r
-# domain\r
-# Output \r
-# 1 IP matches host.domain\r
-# 0 not in sync\r
-#\r
-sub DyndnsServiceSync ($;$;$) {\r
- \r
- my ($ip,$hostName,$domain) = @_;\r
- my @addresses;\r
-\r
- #fix me no ip GROUP, what is the name ?\r
- $hostName =~ s/$General::noipprefix//;\r
- if ($hostName) { #may be empty\r
- $hostName = "$hostName.$domain";\r
- @addresses = gethostbyname($hostName);\r
- }\r
-\r
- if ($addresses[0] eq '') { # nothing returned ?\r
- $hostName = $domain; # try resolving with domain only\r
- @addresses = gethostbyname($hostName);\r
- }\r
-\r
- if ($addresses[0] ne '') { # got something ?\r
- #&General::log("name:$addresses[0], alias:$addresses[1]"); \r
- # Build clear text list of IP\r
- @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);\r
- if (grep (/$ip/, @addresses)) {\r
- return 1;\r
- }\r
- }\r
- return 0;\r
-}\r
-#\r
-# This sub returns the red IP used to compare in DyndnsServiceSync\r
-#\r
-sub GetDyndnsRedIP {\r
- my %settings;\r
- &General::readhash("${General::swroot}/ddns/settings", \%settings);\r
-\r
- open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';\r
- my $ip = <IP>;\r
- close(IP);\r
- chomp $ip;\r
-\r
- if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||\r
- &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||\r
- &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))\r
- {\r
- if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {\r
- my $RealIP = &General::FetchPublicIp;\r
- $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');\r
- }\r
- }\r
- return $ip;\r
-}\r
-1;\r
+# SmoothWall CGIs
+#
+# This code is distributed under the terms of the GPL
+#
+# (c) The SmoothWall Team
+# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
+# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
+# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
+# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
+# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
+#
+# $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
+#
+
+package General;
+
+use strict;
+use Socket;
+use IO::Socket;
+use Net::SSLeay;
+use Net::IPv4Addr qw(:all);
+$|=1; # line buffering
+
+$General::version = 'VERSION';
+$General::swroot = 'CONFIG_ROOT';
+$General::noipprefix = 'noipg-';
+$General::adminmanualurl = 'http://wiki.ipfire.org';
+
+#
+# log ("message") use default 'ipcop' tag
+# log ("tag","message") use your tag
+#
+sub log
+{
+ my $tag='ipfire';
+ $tag = shift if (@_>1);
+ my $logmessage = $_[0];
+ $logmessage =~ /([\w\W]*)/;
+ $logmessage = $1;
+ system('logger', '-t', $tag, $logmessage);
+}
+
+sub readhash
+{
+ my $filename = $_[0];
+ my $hash = $_[1];
+ my ($var, $val);
+
+
+ # Some ipcop code expects that readhash 'complete' the hash if new entries
+ # are presents. Not clear it !!!
+ #%$hash = ();
+
+ open(FILE, $filename) or die "Unable to read file $filename";
+
+ while (<FILE>)
+ {
+ chop;
+ ($var, $val) = split /=/, $_, 2;
+ if ($var)
+ {
+ $val =~ s/^\'//g;
+ $val =~ s/\'$//g;
+
+ # Untaint variables read from hash
+ # trim space from begin and end
+ $var =~ s/^\s+//;
+ $var =~ s/\s+$//;
+ $var =~ /([A-Za-z0-9_-]*)/;
+ $var = $1;
+ $val =~ /([\w\W]*)/;
+ $val = $1;
+ $hash->{$var} = $val;
+ }
+ }
+ close FILE;
+}
+
+
+sub writehash
+{
+ my $filename = $_[0];
+ my $hash = $_[1];
+ my ($var, $val);
+
+ # write cgi vars to the file.
+ open(FILE, ">${filename}") or die "Unable to write file $filename";
+ flock FILE, 2;
+ foreach $var (keys %$hash)
+ {
+ if ( $var eq "__CGI__"){next;}
+ $val = $hash->{$var};
+ # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
+ # location of the mouse are submitted as well, this was being written to the settings file causing
+ # some serious grief! This skips the variable.x and variable.y
+ if (!($var =~ /(.x|.y)$/)) {
+ if ($val =~ / /) {
+ $val = "\'$val\'"; }
+ if (!($var =~ /^ACTION/)) {
+ print FILE "${var}=${val}\n"; }
+ }
+ }
+ close FILE;
+}
+
+sub writehashpart
+{
+ # This function replaces the given hash in the original hash by keeping the old
+ # content and just replacing the new content
+
+ my $filename = $_[0];
+ my $newhash = $_[1];
+ my %oldhash;
+ my ($var, $val);
+
+ readhash("${filename}", \%oldhash);
+
+ foreach $var (keys %$newhash){
+ $oldhash{$var}=$newhash->{$var};
+ }
+
+ # write cgi vars to the file.
+ open(FILE, ">${filename}") or die "Unable to write file $filename";
+ flock FILE, 2;
+ foreach $var (keys %oldhash)
+ {
+ if ( $var eq "__CGI__"){next;}
+ $val = $oldhash{$var};
+ # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
+ # location of the mouse are submitted as well, this was being written to the settings file causing
+ # some serious grief! This skips the variable.x and variable.y
+ if (!($var =~ /(.x|.y)$/)) {
+ if ($val =~ / /) {
+ $val = "\'$val\'"; }
+ if (!($var =~ /^ACTION/)) {
+ print FILE "${var}=${val}\n"; }
+ }
+ }
+ close FILE;
+}
+
+sub age
+{
+ my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
+ $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
+ my $now = time;
+ my $timestring = '';
+ my $dset = 0; # Day is set, when > 0
+ my $hset = 0; # Hour is set, when > 0
+ my $mset = 0; # Minute is set, when > 0
+
+ my $totalsecs = $now - $mtime;
+ my $days = int($totalsecs / 86400);
+ my $totalhours = int($totalsecs / 3600);
+ my $hours = $totalhours % 24;
+ my $totalmins = int($totalsecs / 60);
+ my $mins = $totalmins % 60;
+ my $secs = $totalsecs % 60;
+
+ if ($days > 1) {
+ ${timestring} .= ${days}.' '.$Lang::tr{'days'}.', ';
+ $dset = 1;
+ }
+ elsif ($days == 1) {
+ ${timestring} .= ${days}.' '.$Lang::tr{'day'}.', ';
+ $dset = 1;
+ }
+
+ if (($hours > 1) && !($dset)) {
+ ${timestring} .= ${hours}.' '.$Lang::tr{'hours'}.', ';
+ $hset = 1;
+ }
+ elsif (($hours == 1) && !($dset)) {
+ ${timestring} .= ${hours}.' '.$Lang::tr{'hour'}.', ';
+ $hset = 1;
+ }
+ elsif ($dset) {
+ ${timestring} .= ${hours}.' '.$Lang::tr{'age shour'}.', ';
+ $hset = 1;
+ }
+
+ if ((($mins > 1) || ($mins == 0)) && !($dset || $hset)) {
+ ${timestring} .= ${mins}.' '.$Lang::tr{'minutes'}.', ';
+ $mset = 1;
+ }
+ elsif (($mins == 1) && !($dset || $hset)) {
+ ${timestring} .= ${mins}.' '.$Lang::tr{'minute'}.', ';
+ $mset = 1;
+ }
+ else {
+ ${timestring} .= ${mins}.' '.$Lang::tr{'age sminute'}.', ';
+ $mset = 1;
+ }
+
+ if ((($secs > 1) || ($secs == 0)) && !($dset || $hset || $mset)) {
+ ${timestring} .= ${secs}.' '.$Lang::tr{'age seconds'};
+ }
+ elsif (($secs == 1) && !($dset || $hset || $mset)) {
+ ${timestring} .= $secs.' '.$Lang::tr{'age second'};
+ }
+ else { ${timestring} .= $secs.' '.$Lang::tr{'age ssecond'}; }
+
+ return ${timestring};
+}
+
+sub validip
+{
+ my $ip = $_[0];
+
+ if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
+ return 0; }
+ else
+ {
+ my @octets = ($1, $2, $3, $4);
+ foreach $_ (@octets)
+ {
+ if (/^0./) {
+ return 0; }
+ if ($_ < 0 || $_ > 255) {
+ return 0; }
+ }
+ return 1;
+ }
+}
+
+sub validmask
+{
+ my $mask = $_[0];
+
+ # secord part an ip?
+ if (&validip($mask)) {
+ return 1; }
+ # second part a number?
+ if (/^0/) {
+ return 0; }
+ if (!($mask =~ /^\d+$/)) {
+ return 0; }
+ if ($mask >= 0 && $mask <= 32) {
+ return 1; }
+ return 0;
+}
+
+sub validipormask
+{
+ my $ipormask = $_[0];
+
+ # see if it is a IP only.
+ if (&validip($ipormask)) {
+ return 1; }
+ # split it into number and mask.
+ if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
+ return 0; }
+ my $ip = $1;
+ my $mask = $2;
+ # first part not a ip?
+ if (!(&validip($ip))) {
+ return 0; }
+ return &validmask($mask);
+}
+
+sub subtocidr
+{
+ #gets: Subnet in decimal (255.255.255.0)
+ #Gives: 24 (The cidr of network)
+ my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
+ my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
+ my $bin = unpack("B*", pack("N", $num));
+ my $count = ($bin =~ tr/1/1/);
+ return $count;
+}
+
+sub cidrtosub
+{
+ #gets: Cidr of network (20-30 for ccd)
+ #Konverts 30 to 255.255.255.252 e.g
+ my $cidr=$_[0];
+ my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
+ return "$netmask";
+}
+
+sub iporsubtodec
+{
+ #Gets: Ip address or subnetmask in decimal oder CIDR
+ #Gives: What it gets only in CIDR format
+ my $subnet=$_[0];
+ my $net;
+ my $mask;
+ my $full=0;
+ if ($subnet =~ /^(.*?)\/(.*?)$/) {
+ ($net,$mask) = split (/\//,$subnet);
+ $full=1;
+ return "$subnet";
+ }else{
+ $mask=$subnet;
+ }
+ #Subnet already in decimal and valid?
+ if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
+ for (my $i=8;$i<=32;$i++){
+ if (&General::cidrtosub($i) eq $mask){
+ if ($full == 0){return $mask;}else{
+ return $net."/".$mask;
+ }
+ }
+ }
+ }
+ #Subnet in binary format?
+ if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
+ if($full == 0){ return &General::cidrtosub($mask);}else{
+ return $net."/".&General::cidrtosub($mask);
+ }
+ }else{
+ return 3;
+ }
+ return 3;
+}
+
+
+sub iporsubtocidr
+{
+ #gets: Ip Address or subnetmask in decimal oder CIDR
+ #Gives: What it gets only in CIDR format
+ my $subnet=$_[0];
+ my $net;
+ my $mask;
+ my $full=0;
+ if ($subnet =~ /^(.*?)\/(.*?)$/) {
+ ($net,$mask) = split (/\//,$subnet);
+ $full=1;
+ }else{
+ $mask=$subnet;
+ }
+ #Subnet in decimal and valid?
+ if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
+ for (my $i=8;$i<=32;$i++){
+ if (&General::cidrtosub($i) eq $mask){
+ if ($full == 0){return &General::subtocidr($mask);}else{
+ return $net."/".&General::subtocidr($mask);
+ }
+ }
+ }
+ }
+ #Subnet already in binary format?
+ if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
+ if($full == 0){ return $mask;}else{
+ return $net."/".$mask;
+ }
+ }else{
+ return 3;
+ }
+ return 3;
+}
+
+sub getnetworkip
+{
+ #Gets: IP, CIDR (10.10.10.0-255, 24)
+ #Gives: 10.10.10.0
+ my ($ccdip,$ccdsubnet) = @_;
+ my $ip_address_binary = inet_aton( $ccdip );
+ my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
+ my $network_address = inet_ntoa( $ip_address_binary & $netmask_binary );
+ return $network_address;
+}
+
+sub getccdbc
+{
+ #Gets: IP in Form ("192.168.0.0/24")
+ #Gives: Broadcastaddress of network
+ my $ccdnet=$_;
+ my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
+ my $ip_address_binary = inet_aton( $ccdip );
+ my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
+ my $broadcast_address = inet_ntoa( $ip_address_binary | ~$netmask_binary );
+ return $broadcast_address;
+}
+
+sub ip2dec
+{
+ my $ip_num;
+ my $ip=$_[0];
+ if ( $ip =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
+ $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
+ } else {
+ $ip_num = -1;
+ }
+ $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
+ return($ip_num);
+}
+
+sub dec2ip
+{
+ my $ip;
+ my $ip_num=$_[0];
+ my $o1=$ip_num%256;
+ $ip_num=int($ip_num/256);
+ my $o2=$ip_num%256;
+ $ip_num=int($ip_num/256);
+ my $o3=$ip_num%256;
+ $ip_num=int($ip_num/256);
+ my $o4=$ip_num%256;
+ $ip="$o4.$o3.$o2.$o1";
+ return ($ip);
+}
+
+sub getnextip
+{
+ my $decip=&ip2dec($_[0]);
+ $decip=$decip+4;
+ return &dec2ip($decip);
+}
+
+sub getlastip
+{
+ my $decip=&ip2dec($_[0]);
+ $decip--;
+ return &dec2ip($decip);
+}
+
+sub validipandmask
+{
+ #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
+ #Gives: True bzw 0 if success or false
+ my $ccdnet=$_[0];
+ my $subcidr;
+
+ if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
+ return 0;
+ }
+ my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
+ #IP valid?
+ 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 ))) {
+ #Subnet in decimal and valid?
+ if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
+ for (my $i=8;$i<=32;$i++){
+ if (&General::cidrtosub($i) eq $ccdsubnet){
+ return 1;
+ }
+ }
+ #Subnet already in binary format?
+ }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
+ return 1;
+ }else{
+ return 0;
+ }
+
+ }
+ return 0;
+}
+
+sub checksubnets
+{
+ my %ccdconfhash=();
+ my @ccdconf=();
+ my $ccdname=$_[0];
+ my $ccdnet=$_[1];
+ my $errormessage;
+ my ($ip,$cidr)=split(/\//,$ccdnet);
+ $cidr=&iporsubtocidr($cidr);
+ #get OVPN-Subnet (dynamic range)
+ my %ovpnconf=();
+ &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
+ my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
+ $ovpncidr=&iporsubtocidr($ovpncidr);
+ #check if we try to use same network as ovpn server
+ if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
+ $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
+ return $errormessage;
+ }
+ #check if we use a network-name/subnet that already exists
+ &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
+ foreach my $key (keys %ccdconfhash) {
+ @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
+ if ($ccdname eq $ccdconfhash{$key}[0])
+ {
+ $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
+ return $errormessage;
+ }
+ my ($newip,$newsub) = split(/\//,$ccdnet);
+ if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
+ {
+ $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
+ return $errormessage;
+ }
+ }
+ #check if we use a ipsec right network which is already defined
+ my %ipsecconf=();
+ &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
+ foreach my $key (keys %ipsecconf){
+ if ($ipsecconf{$key}[11] ne ''){
+ my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
+ $ipsecsub=&iporsubtodec($ipsecsub);
+ if($ipsecconf{$key}[1] ne $ccdname){
+ if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
+ $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[1]";
+ return $errormessage;
+ }
+ }
+ }
+ }
+ #check if we use one of ipfire's networks (green,orange,blue)
+ my %ownnet=();
+ &readhash("${General::swroot}/ethernet/settings", \%ownnet);
+ if (($ownnet{'GREEN_NETADDRESS'} ne '' && $ownnet{'GREEN_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'GREEN_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
+ if (($ownnet{'ORANGE_NETADDRESS'} ne '' && $ownnet{'ORANGE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'ORANGE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
+ if (($ownnet{'BLUE_NETADDRESS'} ne '' && $ownnet{'BLUE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'BLUE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
+ if (($ownnet{'RED_NETADDRESS'} ne '' && $ownnet{'RED_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'RED_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
+}
+
+
+sub validport
+{
+ $_ = $_[0];
+
+ if (!/^\d+$/) {
+ return 0; }
+ if (/^0./) {
+ return 0; }
+ if ($_ >= 1 && $_ <= 65535) {
+ return 1; }
+ return 0;
+}
+
+sub validproxyport
+{
+ $_ = $_[0];
+
+ if (!/^\d+$/) {
+ return 0; }
+ if (/^0./) {
+ return 0; }
+ if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
+ return 0; }
+ elsif ($_ >= 1 && $_ <= 65535) {
+ return 1; }
+ return 0;
+}
+
+sub validmac
+{
+ my $checkmac = $_[0];
+ my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
+ if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
+ {
+ return 0;
+ }
+ return 1;
+}
+
+sub validhostname
+{
+ # Checks a hostname against RFC1035
+ my $hostname = $_[0];
+
+ # Each part should be at least two characters in length
+ # but no more than 63 characters
+ if (length ($hostname) < 1 || length ($hostname) > 63) {
+ return 0;}
+ # Only valid characters are a-z, A-Z, 0-9 and -
+ if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
+ return 0;}
+ # First character can only be a letter or a digit
+ if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ # Last character can only be a letter or a digit
+ if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ return 1;
+}
+
+sub validdomainname
+{
+ my $part;
+
+ # Checks a domain name against RFC1035
+ my $domainname = $_[0];
+ my @parts = split (/\./, $domainname); # Split hostname at the '.'
+
+ foreach $part (@parts) {
+ # Each part should be at least two characters in length
+ # but no more than 63 characters
+ if (length ($part) < 2 || length ($part) > 63) {
+ return 0;}
+ # Only valid characters are a-z, A-Z, 0-9 and -
+ if ($part !~ /^[a-zA-Z0-9-]*$/) {
+ return 0;}
+ # First character can only be a letter or a digit
+ if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ # Last character can only be a letter or a digit
+ if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ }
+ return 1;
+}
+
+sub validfqdn
+{
+ my $part;
+
+ # Checks a fully qualified domain name against RFC1035
+ my $fqdn = $_[0];
+ my @parts = split (/\./, $fqdn); # Split hostname at the '.'
+ if (scalar(@parts) < 2) { # At least two parts should
+ return 0;} # exist in a FQDN
+ # (i.e. hostname.domain)
+ foreach $part (@parts) {
+ # Each part should be at least one character in length
+ # but no more than 63 characters
+ if (length ($part) < 1 || length ($part) > 63) {
+ return 0;}
+ # Only valid characters are a-z, A-Z, 0-9 and -
+ if ($part !~ /^[a-zA-Z0-9-]*$/) {
+ return 0;}
+ # First character can only be a letter or a digit
+ if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ # Last character can only be a letter or a digit
+ if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ }
+ return 1;
+}
+
+sub validportrange # used to check a port range
+{
+ my $port = $_[0]; # port values
+ $port =~ tr/-/:/; # replace all - with colons just in case someone used -
+ my $srcdst = $_[1]; # is it a source or destination port
+
+ if (!($port =~ /^(\d+)\:(\d+)$/)) {
+
+ if (!(&validport($port))) {
+ if ($srcdst eq 'src'){
+ return $Lang::tr{'source port numbers'};
+ } else {
+ return $Lang::tr{'destination port numbers'};
+ }
+ }
+ }
+ else
+ {
+ my @ports = ($1, $2);
+ if ($1 >= $2){
+ if ($srcdst eq 'src'){
+ return $Lang::tr{'bad source range'};
+ } else {
+ return $Lang::tr{'bad destination range'};
+ }
+ }
+ foreach $_ (@ports)
+ {
+ if (!(&validport($_))) {
+ if ($srcdst eq 'src'){
+ return $Lang::tr{'source port numbers'};
+ } else {
+ return $Lang::tr{'destination port numbers'};
+ }
+ }
+ }
+ return;
+ }
+}
+
+# Test if IP is within a subnet
+# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
+# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
+# Everything in dottted notation
+# Return: TRUE/FALSE
+sub IpInSubnet
+{
+ my $ip = unpack('N', &Socket::inet_aton(shift));
+ my $start = unpack('N', &Socket::inet_aton(shift));
+ my $mask = unpack('N', &Socket::inet_aton(shift));
+ $start &= $mask; # base of subnet...
+ my $end = $start + ~$mask;
+ return (($ip >= $start) && ($ip <= $end));
+}
+
+#
+# Return the following IP (IP+1) in dotted notation.
+# Call: NextIP ('1.1.1.1');
+# Return: '1.1.1.2'
+#
+sub NextIP
+{
+ return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
+ )
+ );
+}
+sub NextIP2
+{
+ return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
+ )
+ );
+}
+sub ipcidr
+{
+ my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
+ return "$ip\/$cidr";
+}
+
+sub ipcidr2msk
+{
+ my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
+ my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
+ return "$ip\/$netmask";
+}
+
+
+sub validemail {
+ my $mail = shift;
+ return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
+ return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
+ return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
+ return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
+ return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
+ return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
+ return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
+ return 1;
+}
+
+#
+# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
+# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
+# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
+#
+sub readhasharray {
+ my ($filename, $hash) = @_;
+ %$hash = ();
+
+ open(FILE, $filename) or die "Unable to read file $filename";
+
+ while (<FILE>) {
+ my ($key, $rest, @temp);
+ chomp;
+ ($key, $rest) = split (/,/, $_, 2);
+ if ($key =~ /^[0-9]+$/) {
+ @temp = split (/,/, $rest);
+ $hash->{$key} = \@temp;
+ }
+ }
+ close FILE;
+ return;
+}
+
+sub writehasharray {
+ my ($filename, $hash) = @_;
+ my ($key, @temp, $i);
+
+ open(FILE, ">$filename") or die "Unable to write to file $filename";
+
+ foreach $key (keys %$hash) {
+ if ($key =~ /^[0-9]+$/) {
+ print FILE "$key";
+ foreach $i (0 .. $#{$hash->{$key}}) {
+ print FILE ",$hash->{$key}[$i]";
+ }
+ print FILE "\n";
+ }
+ }
+ close FILE;
+ return;
+}
+
+sub findhasharraykey {
+ foreach my $i (1 .. 1000000) {
+ if ( ! exists $_[0]{$i}) {
+ return $i;
+ }
+ }
+}
+
+sub srtarray
+# Darren Critchley - darrenc@telus.net - (c) 2003
+# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
+# This subroutine will take the following parameters:
+# ColumnNumber = the column which you want to sort on, starts at 1
+# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
+# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
+# ArrayToBeSorted = the array that wants sorting
+#
+# Returns an array that is sorted to your specs
+#
+# If SortOrder is greater than the elements in array, then it defaults to the first element
+#
+{
+ my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
+ my @tmparray;
+ my @srtedarray;
+ my $line;
+ my $newline;
+ my $ctr;
+ my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
+ if ($ttlitems < 1){ # if no items, don't waste our time lets leave
+ return (@tobesorted);
+ }
+ my @tmp = split(/\,/,$tobesorted[0]);
+ $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
+
+ # Darren Critchley - validate parameters
+ if ($colno > $ttlitems){$colno = '1';}
+ $colno--; # remove one from colno to deal with arrays starting at 0
+ if($colno < 0){$colno = '0';}
+ if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
+ if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
+
+ foreach $line (@tobesorted)
+ {
+ chomp($line);
+ if ($line ne '') {
+ my @temp = split(/\,/,$line);
+ # Darren Critchley - juggle the fields so that the one we want to sort on is first
+ my $tmpholder = $temp[0];
+ $temp[0] = $temp[$colno];
+ $temp[$colno] = $tmpholder;
+ $newline = "";
+ for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
+ $newline=$newline . $temp[$ctr] . ",";
+ }
+ chop($newline);
+ push(@tmparray,$newline);
+ }
+ }
+ if ($alpnum eq 'n') {
+ @tmparray = sort {$a <=> $b} @tmparray;
+ } else {
+ @tmparray = (sort @tmparray);
+ }
+ foreach $line (@tmparray)
+ {
+ chomp($line);
+ if ($line ne '') {
+ my @temp = split(/\,/,$line);
+ my $tmpholder = $temp[0];
+ $temp[0] = $temp[$colno];
+ $temp[$colno] = $tmpholder;
+ $newline = "";
+ for ($ctr=0; $ctr < $ttlitems ; $ctr++){
+ $newline=$newline . $temp[$ctr] . ",";
+ }
+ chop($newline);
+ push(@srtedarray,$newline);
+ }
+ }
+
+ if ($srtdir eq 'dsc') {
+ @tmparray = reverse(@srtedarray);
+ return (@tmparray);
+ } else {
+ return (@srtedarray);
+ }
+}
+
+sub FetchPublicIp {
+ my %proxysettings;
+ &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
+ if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
+ my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
+ Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
+ }
+ my $user_agent = &MakeUserAgent();
+ my ($out, $response) = Net::SSLeay::get_http( 'checkip4.dns.lightningwirelabs.com',
+ 80,
+ "/",
+ Net::SSLeay::make_headers('User-Agent' => $user_agent )
+ );
+ if ($response =~ m%HTTP/1\.. 200 OK%) {
+ $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
+ return $1;
+ }
+ return '';
+}
+
+#
+# Check if hostname.domain provided have IP provided
+# use gethostbyname to verify that
+# Params:
+# IP
+# hostname
+# domain
+# Output
+# 1 IP matches host.domain
+# 0 not in sync
+#
+sub DyndnsServiceSync ($;$;$) {
+
+ my ($ip,$hostName,$domain) = @_;
+ my @addresses;
+
+ #fix me no ip GROUP, what is the name ?
+ $hostName =~ s/$General::noipprefix//;
+ if ($hostName) { #may be empty
+ $hostName = "$hostName.$domain";
+ @addresses = gethostbyname($hostName);
+ }
+
+ if ($addresses[0] eq '') { # nothing returned ?
+ $hostName = $domain; # try resolving with domain only
+ @addresses = gethostbyname($hostName);
+ }
+
+ if ($addresses[0] ne '') { # got something ?
+ #&General::log("name:$addresses[0], alias:$addresses[1]");
+ # Build clear text list of IP
+ @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
+ if (grep (/$ip/, @addresses)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+#
+# This sub returns the red IP used to compare in DyndnsServiceSync
+#
+sub GetDyndnsRedIP {
+ my %settings;
+ &General::readhash("${General::swroot}/ddns/settings", \%settings);
+
+ open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
+ my $ip = <IP>;
+ close(IP);
+ chomp $ip;
+
+ # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
+ if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
+ &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
+ &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
+ &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
+ {
+ if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
+ my $RealIP = &General::FetchPublicIp;
+ $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
+ }
+ }
+ return $ip;
+}
+
+# Translate ICMP code to text
+# ref: http://www.iana.org/assignments/icmp-parameters
+sub GetIcmpDescription ($) {
+ my $index = shift;
+ my @icmp_description = (
+ 'Echo Reply', #0
+ 'Unassigned',
+ 'Unassigned',
+ 'Destination Unreachable',
+ 'Source Quench',
+ 'Redirect',
+ 'Alternate Host Address',
+ 'Unassigned',
+ 'Echo',
+ 'Router Advertisement',
+ 'Router Solicitation', #10
+ 'Time Exceeded',
+ 'Parameter Problem',
+ 'Timestamp',
+ 'Timestamp Reply',
+ 'Information Request',
+ 'Information Reply',
+ 'Address Mask Request',
+ 'Address Mask Reply',
+ 'Reserved (for Security)',
+ 'Reserved (for Robustness Experiment)', #20
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Reserved',
+ 'Traceroute', #30
+ 'Datagram Conversion Error',
+ 'Mobile Host Redirect',
+ 'IPv6 Where-Are-You',
+ 'IPv6 I-Am-Here',
+ 'Mobile Registration Request',
+ 'Mobile Registration Reply',
+ 'Domain Name Request',
+ 'Domain Name Reply',
+ 'SKIP',
+ 'Photur', #40
+ 'Experimental');
+ if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
+}
+
+sub GetCoreUpdateVersion() {
+ my $core_update;
+
+ open(FILE, "/opt/pakfire/db/core/mine");
+ while (<FILE>) {
+ $core_update = $_;
+ last;
+ }
+ close(FILE);
+
+ return $core_update;
+}
+
+sub MakeUserAgent() {
+ my $user_agent = "IPFire/$General::version";
+
+ my $core_update = &GetCoreUpdateVersion();
+ if ($core_update ne "") {
+ $user_agent .= "/$core_update";
+ }
+
+ return $user_agent;
+}
+
+sub RedIsWireless() {
+ # This function checks if a network device is a wireless device.
+
+ my %settings = ();
+ &readhash("${General::swroot}/ethernet/settings", \%settings);
+
+ # Find the name of the network device.
+ my $device = $settings{'RED_DEV'};
+
+ # Exit, if no device is configured.
+ return 0 if ($device eq "");
+
+ # Return 1 if the device is a wireless one.
+ my $path = "/sys/class/net/$device/wireless";
+ if (-d $path) {
+ return 1;
+ }
+
+ # Otherwise return zero.
+ return 0;
+}
+
+1;
projects / people / teissler / ipfire-2.x.git / blobdiff