[ipfire-2.x.git] / config / cfgroot / general-functions.pl

# 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
Commit	Line	Data
cd1a2927 MT	1	# SmoothWall CGIs\r
	2	#\r
	3	# This code is distributed under the terms of the GPL\r
	4	#\r
	5	# (c) The SmoothWall Team\r
	6	# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r
	7	# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r
	8	# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r
	9	# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r
	10	# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r
	11	#\r
	12	# $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $\r
	13	#\r
	14	\r
	15	package General;\r
	16	\r
	17	use strict;\r
	18	use Socket;\r
	19	use IO::Socket;\r
	20	\r
	21	$\|=1; # line buffering\r
	22	\r
	23	$General::version = 'VERSION';\r
	24	$General::swroot = 'CONFIG_ROOT';\r
	25	$General::noipprefix = 'noipg-';\r
	26	$General::adminmanualurl = 'http://www.ipcop.org/1.4.0/en/admin/html';\r
	27	\r
	28	sub log\r
	29	{\r
	30	my $logmessage = $_[0];\r
	31	$logmessage =~ /([\w\W]*)/;\r
	32	$logmessage = $1;\r
	33	system('/usr/bin/logger', '-t', 'ipcop', $logmessage);\r
	34	}\r
	35	\r
	36	sub readhash\r
	37	{\r
	38	my $filename = $_[0];\r
	39	my $hash = $_[1];\r
	40	my ($var, $val);\r
	41	\r
	42	\r
	43	# Some ipcop code expects that readhash 'complete' the hash if new entries\r
	44	# are presents. Not clear it !!!\r
	45	#%$hash = ();\r
	46	\r
	47	open(FILE, $filename) or die "Unable to read file $filename";\r
	48	\r
	49	while (<FILE>)\r
	50	{\r
	51	chop;\r
	52	($var, $val) = split /=/, $_, 2;\r
	53	if ($var)\r
	54	{\r
	55	$val =~ s/^\'//g;\r
	56	$val =~ s/\'$//g;\r
	57	\r
	58	# Untaint variables read from hash\r
	59	$var =~ /([A-Za-z0-9_-]*)/; $var = $1;\r
	60	$val =~ /([\w\W]*)/; $val = $1;\r
	61	$hash->{$var} = $val;\r
	62	}\r
	63	}\r
	64	close FILE;\r
65	}\r
66	\r
67	\r
68	sub writehash\r
69	{\r
70	my $filename = $_[0];\r
71	my $hash = $_[1];\r
72	my ($var, $val);\r
73	\r
74	# write cgi vars to the file.\r
75	open(FILE, ">${filename}") or die "Unable to write file $filename";\r
76	flock FILE, 2;\r
77	foreach $var (keys %$hash) \r
78	{\r
79	$val = $hash->{$var};\r
80	# Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y\r
81	# location of the mouse are submitted as well, this was being written to the settings file causing\r
82	# some serious grief! This skips the variable.x and variable.y\r
83	if (!($var =~ /(.x\|.y)$/)) {\r
84	if ($val =~ / /) {\r
85	$val = "\'$val\'"; }\r
86	if (!($var =~ /^ACTION/)) {\r
87	print FILE "${var}=${val}\n"; }\r
88	}\r
89	}\r
90	close FILE;\r
91	}\r
92	\r
93	\r
94	sub age\r
95	{\r
96	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,\r
97	$atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];\r
98	my $now = time;\r
99	\r
100	my $totalsecs = $now - $mtime;\r
101	my $days = int($totalsecs / 86400);\r
102	my $totalhours = int($totalsecs / 3600);\r
103	my $hours = $totalhours % 24;\r
104	my $totalmins = int($totalsecs / 60);\r
105	my $mins = $totalmins % 60;\r
106	my $secs = $totalsecs % 60;\r
107	\r
108	return "${days}d ${hours}h ${mins}m ${secs}s";\r
109	}\r
110	\r
111	sub validip\r
112	{\r
113	my $ip = $_[0];\r
114	\r
115	if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {\r
116	return 0; }\r
117	else \r
118	{\r
119	my @octets = ($1, $2, $3, $4);\r
120	foreach $_ (@octets)\r
121	{\r
122	if (/^0./) {\r
123	return 0; }\r
124	if ($_ < 0 \|\| $_ > 255) {\r
125	return 0; }\r
126	}\r
127	return 1;\r
128	}\r
129	}\r
130	\r
131	sub validmask\r
132	{\r
133	my $mask = $_[0];\r
134	\r
135	# secord part an ip?\r
136	if (&validip($mask)) {\r
137	return 1; }\r
138	# second part a number?\r
139	if (/^0/) {\r
140	return 0; }\r
141	if (!($mask =~ /^\d+$/)) {\r
142	return 0; }\r
143	if ($mask >= 0 && $mask <= 32) {\r
144	return 1; }\r
145	return 0;\r
146	}\r
147	\r
148	sub validipormask\r
149	{\r
150	my $ipormask = $_[0];\r
151	\r
152	# see if it is a IP only.\r
153	if (&validip($ipormask)) {\r
154	return 1; }\r
155	# split it into number and mask.\r
156	if (!($ipormask =~ /^(.?)\/(.?)$/)) {\r
157	return 0; }\r
158	my $ip = $1;\r
159	my $mask = $2;\r
160	# first part not a ip?\r
161	if (!(&validip($ip))) {\r
162	return 0; }\r
163	return &validmask($mask);\r
164	}\r
165	\r
166	sub validipandmask\r
167	{\r
168	my $ipandmask = $_[0];\r
169	\r
170	# split it into number and mask.\r
171	if (!($ipandmask =~ /^(.?)\/(.?)$/)) {\r
172	return 0; }\r
173	my $ip = $1;\r
174	my $mask = $2;\r
175	# first part not a ip?\r
176	if (!(&validip($ip))) {\r
177	return 0; }\r
178	return &validmask($mask);\r
179	}\r
180	\r
181	sub validport\r
182	{\r
183	$_ = $_[0];\r
184	\r
185	if (!/^\d+$/) {\r
186	return 0; }\r
187	if (/^0./) {\r
188	return 0; }\r
189	if ($_ >= 1 && $_ <= 65535) {\r
190	return 1; }\r
191	return 0;\r
192	}\r
193	\r
194	sub validmac\r
195	{\r
196	my $checkmac = $_[0];\r
197	my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)\r
198	if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)\r
199	{\r
200	return 0;\r
201	}\r
202	return 1;\r
203	}\r
204	\r
205	sub validhostname\r
206	{\r
207	# Checks a hostname against RFC1035\r
208	my $hostname = $_[0];\r
209	\r
210	# Each part should be at least two characters in length\r
211	# but no more than 63 characters\r
212	if (length ($hostname) < 1 \|\| length ($hostname) > 63) {\r
213	return 0;}\r
214	# Only valid characters are a-z, A-Z, 0-9 and -\r
215	if ($hostname !~ /^[a-zA-Z0-9-]*$/) {\r
216	return 0;}\r
217	# First character can only be a letter or a digit\r
218	if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
219	return 0;}\r
220	# Last character can only be a letter or a digit\r
221	if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
222	return 0;}\r
223	return 1;\r
224	}\r
225	\r
226	sub validdomainname\r
227	{\r
228	my $part;\r
229	\r
230	# Checks a domain name against RFC1035\r
231	my $domainname = $_[0];\r
232	my @parts = split (/\./, $domainname); # Split hostname at the '.'\r
233	\r
234	foreach $part (@parts) {\r
235	# Each part should be at least two characters in length\r
236	# but no more than 63 characters\r
237	if (length ($part) < 2 \|\| length ($part) > 63) {\r
238	return 0;}\r
239	# Only valid characters are a-z, A-Z, 0-9 and -\r
240	if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
241	return 0;}\r
242	# First character can only be a letter or a digit\r
243	if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
244	return 0;}\r
245	# Last character can only be a letter or a digit\r
246	if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
247	return 0;}\r
248	}\r
249	return 1;\r
250	}\r
251	\r
252	sub validfqdn\r
253	{\r
254	my $part;\r
255	\r
256	# Checks a fully qualified domain name against RFC1035\r
257	my $fqdn = $_[0];\r
258	my @parts = split (/\./, $fqdn); # Split hostname at the '.'\r
259	if (scalar(@parts) < 2) { # At least two parts should\r
260	return 0;} # exist in a FQDN\r
261	# (i.e. hostname.domain)\r
262	foreach $part (@parts) {\r
263	# Each part should be at least one character in length\r
264	# but no more than 63 characters\r
265	if (length ($part) < 1 \|\| length ($part) > 63) {\r
266	return 0;}\r
267	# Only valid characters are a-z, A-Z, 0-9 and -\r
268	if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
269	return 0;}\r
270	# First character can only be a letter or a digit\r
271	if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
272	return 0;}\r
273	# Last character can only be a letter or a digit\r
274	if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
275	return 0;}\r
276	}\r
277	return 1;\r
278	}\r
279	\r
280	sub validportrange # used to check a port range \r
281	{\r
282	my $port = $_[0]; # port values\r
283	$port =~ tr/-/:/; # replace all - with colons just in case someone used -\r
284	my $srcdst = $_[1]; # is it a source or destination port\r
285	\r
286	if (!($port =~ /^(\d+)\:(\d+)$/)) {\r
287	\r
288	if (!(&validport($port))) { \r
289	if ($srcdst eq 'src'){\r
290	return $Lang::tr{'source port numbers'};\r
291	} else {\r
292	return $Lang::tr{'destination port numbers'};\r
293	} \r
294	}\r
295	}\r
296	else \r
297	{\r
298	my @ports = ($1, $2);\r
299	if ($1 >= $2){\r
300	if ($srcdst eq 'src'){\r
301	return $Lang::tr{'bad source range'};\r
302	} else {\r
303	return $Lang::tr{'bad destination range'};\r
304	} \r
305	}\r
306	foreach $_ (@ports)\r
307	{\r
308	if (!(&validport($_))) {\r
309	if ($srcdst eq 'src'){\r
310	return $Lang::tr{'source port numbers'}; \r
311	} else {\r
312	return $Lang::tr{'destination port numbers'};\r
313	} \r
314	}\r
315	}\r
316	return;\r
317	}\r
318	}\r
319	\r
320	# Test if IP is within a subnet\r
321	# Call: IpInSubnet (Addr, Subnet, Subnet Mask)\r
322	# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1\r
323	# Everything in dottted notation\r
324	# Return: TRUE/FALSE\r
325	sub IpInSubnet\r
326	{\r
327	my $ip = unpack('N', &Socket::inet_aton(shift));\r
328	my $start = unpack('N', &Socket::inet_aton(shift));\r
329	my $mask = unpack('N', &Socket::inet_aton(shift));\r
330	$start &= $mask; # base of subnet...\r
331	my $end = $start + ~$mask;\r
332	return (($ip >= $start) && ($ip <= $end));\r
333	}\r
334	\r
335	sub validemail {\r
336	my $mail = shift;\r
337	return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );\r
338	return 0 if ( $mail =~ /^[^0-9a-zA-Z]\|[^0-9a-zA-Z]$/);\r
339	return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );\r
340	return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );\r
341	return 0 if ( $mail =~ /.\.\-.\|.\-\..\|.\.\..\|.\-\-./g );\r
342	return 0 if ( $mail =~ /.\.\_.\|.\-\_.\|.\_\..\|.\_\-.\|.\_\_./g );\r
343	return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );\r
344	return 1;\r
345	}\r
346	\r
347	sub readhasharray {\r
348	my ($filename, $hash) = @_;\r
349	%$hash = ();\r
350	\r
351	open(FILE, $filename) or die "Unable to read file $filename";\r
352	\r
353	while (<FILE>) {\r
354	my ($key, $rest, @temp);\r
355	chomp;\r
356	($key, $rest) = split (/,/, $_, 2);\r
357	if ($key =~ /^[0-9]+$/ && $rest) {\r
358	@temp = split (/,/, $rest);\r
359	$hash->{$key} = \@temp;\r
360	}\r
361	}\r
362	close FILE;\r
363	return;\r
364	}\r
365	\r
366	sub writehasharray {\r
367	my ($filename, $hash) = @_;\r
368	my ($key, @temp, $i);\r
369	\r
370	open(FILE, ">$filename") or die "Unable to write to file $filename";\r
371	\r
372	foreach $key (keys %$hash) {\r
373	if ( $hash->{$key} ) {\r
374	print FILE "$key";\r
375	foreach $i (0 .. $#{$hash->{$key}}) {\r
376	print FILE ",$hash->{$key}[$i]";\r
377	}\r
378	}\r
379	print FILE "\n";\r
380	}\r
381	close FILE;\r
382	return;\r
383	}\r
384	\r
385	sub findhasharraykey {\r
386	foreach my $i (1 .. 1000000) {\r
387	if ( ! exists $_[0]{$i}) {\r
388	return $i;\r
389	}\r
390	}\r
391	}\r
392	\r
393	sub srtarray \r
394	# Darren Critchley - darrenc@telus.net - (c) 2003\r
395	# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)\r
396	# This subroutine will take the following parameters:\r
397	# ColumnNumber = the column which you want to sort on, starts at 1\r
398	# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic\r
399	# SortDirection = asc or dsc (lowercase) Ascending or Descending sort\r
400	# ArrayToBeSorted = the array that wants sorting\r
401	#\r
402	# Returns an array that is sorted to your specs\r
403	#\r
404	# If SortOrder is greater than the elements in array, then it defaults to the first element\r
405	# \r
406	{\r
407	my ($colno, $alpnum, $srtdir, @tobesorted) = @_;\r
408	my @tmparray;\r
409	my @srtedarray;\r
410	my $line;\r
411	my $newline;\r
412	my $ctr;\r
413	my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array\r
414	if ($ttlitems < 1){ # if no items, don't waste our time lets leave\r
415	return (@tobesorted);\r
416	}\r
417	my @tmp = split(/\,/,$tobesorted[0]);\r
418	$ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array\r
419	\r
420	# Darren Critchley - validate parameters\r
421	if ($colno > $ttlitems){$colno = '1';}\r
422	$colno--; # remove one from colno to deal with arrays starting at 0\r
423	if($colno < 0){$colno = '0';}\r
424	if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }\r
425	if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }\r
426	\r
427	foreach $line (@tobesorted)\r
428	{\r
429	chomp($line);\r
430	if ($line ne '') {\r
431	my @temp = split(/\,/,$line);\r
432	# Darren Critchley - juggle the fields so that the one we want to sort on is first\r
433	my $tmpholder = $temp[0];\r
434	$temp[0] = $temp[$colno];\r
435	$temp[$colno] = $tmpholder;\r
436	$newline = "";\r
437	for ($ctr=0; $ctr < $ttlitems ; $ctr++) {\r
438	$newline=$newline . $temp[$ctr] . ",";\r
439	}\r
440	chop($newline);\r
441	push(@tmparray,$newline);\r
442	}\r
443	}\r
444	if ($alpnum eq 'n') {\r
445	@tmparray = sort {$a <=> $b} @tmparray;\r
446	} else {\r
447	@tmparray = (sort @tmparray);\r
448	}\r
449	foreach $line (@tmparray)\r
450	{\r
451	chomp($line);\r
452	if ($line ne '') {\r
453	my @temp = split(/\,/,$line);\r
454	my $tmpholder = $temp[0];\r
455	$temp[0] = $temp[$colno];\r
456	$temp[$colno] = $tmpholder;\r
457	$newline = "";\r
458	for ($ctr=0; $ctr < $ttlitems ; $ctr++){\r
459	$newline=$newline . $temp[$ctr] . ",";\r
460	}\r
461	chop($newline);\r
462	push(@srtedarray,$newline);\r
463	}\r
464	}\r
465	\r
466	if ($srtdir eq 'dsc') {\r
467	@tmparray = reverse(@srtedarray);\r
468	return (@tmparray);\r
469	} else {\r
470	return (@srtedarray);\r
471	}\r
472	}\r
473	\r
474	sub FetchPublicIp {\r
475	my %proxysettings;\r
476	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);\r
477	if ($_=$proxysettings{'UPSTREAM_PROXY'}) {\r
478	my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]?(?:\:[A-Za-z0-9\_\.\-]?)?\@)?([a-zA-Z0-9\.\_\-]?)(?:\:([0-9]{1,5}))?(?:\/.?)?$/);\r
479	Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );\r
480	}\r
481	my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',\r
482	80,\r
483	"/",\r
484	Net::SSLeay::make_headers('User-Agent' => 'Ipcop' )\r
485	);\r
486	if ($response =~ m%HTTP/1\.. 200 OK%) {\r
487	$out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;\r
488	return $1;\r
489	}\r
490	return '';\r
491	}\r
492	\r
493	#\r
494	# Check if hostname.domain provided have IP provided\r
495	# use gethostbyname to verify that\r
496	# Params:\r
497	# IP\r
498	# hostname\r
499	# domain\r
500	# Output \r
501	# 1 IP matches host.domain\r
502	# 0 not in sync\r
503	#\r
504	sub DyndnsServiceSync ($;$;$) {\r
505	\r
506	my ($ip,$hostName,$domain) = @_;\r
507	my @addresses;\r
508	\r
509	#fix me no ip GROUP, what is the name ?\r
510	$hostName =~ s/$General::noipprefix//;\r
511	if ($hostName) { #may be empty\r
512	$hostName = "$hostName.$domain";\r
513	@addresses = gethostbyname($hostName);\r
514	}\r
515	\r
516	if ($addresses[0] eq '') { # nothing returned ?\r
517	$hostName = $domain; # try resolving with domain only\r
518	@addresses = gethostbyname($hostName);\r
519	}\r
520	\r
521	if ($addresses[0] ne '') { # got something ?\r
522	#&General::log("name:$addresses[0], alias:$addresses[1]"); \r
523	# Build clear text list of IP\r
524	@addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);\r
525	if (grep (/$ip/, @addresses)) {\r
526	return 1;\r
527	}\r
528	}\r
529	return 0;\r
530	}\r
531	#\r
532	# This sub returns the red IP used to compare in DyndnsServiceSync\r
533	#\r
534	sub GetDyndnsRedIP {\r
535	my %settings;\r
536	&General::readhash("${General::swroot}/ddns/settings", \%settings);\r
537	\r
538	open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';\r
539	my $ip = <IP>;\r
540	close(IP);\r
541	chomp $ip;\r
542	\r
543	if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') \|\|\r
544	&General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') \|\|\r
545	&General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))\r
546	{\r
547	if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {\r
548	my $RealIP = &General::FetchPublicIp;\r
549	$ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');\r
550	}\r
551	}\r
552	return $ip;\r
553	}\r
554	1;\r