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

# 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;

$|=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 age
{
	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
	        $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
	my $now = time;

	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;

	return "${days}d ${hours}h ${mins}m ${secs}s";
}

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 validipandmask
{
	my $ipandmask = $_[0];

	# split it into number and mask.
	if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
		return 0; }
	my $ip = $1;
	my $mask = $2;
	# first part not a ip?
	if (!(&validip($ip))) {
		return 0; }
	return &validmask($mask);
}

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-]*$/) {
		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 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 ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
                				    80,
        					    "/",
						    Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
						);
    if ($response =~ m%HTTP/1\.. 200 OK%) {
	$out =~ /Current IP Address: (\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;

    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'))
    {
	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]};
}
1;
Commit	Line	Data
ac1cfefa MT	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;
c545beb1	20	use Net::SSLeay;
ac1cfefa MT	21
	22	$\|=1; # line buffering
	23
	24	$General::version = 'VERSION';
	25	$General::swroot = 'CONFIG_ROOT';
	26	$General::noipprefix = 'noipg-';
c545beb1	27	$General::adminmanualurl = 'http://wiki.ipfire.org';
ac1cfefa	28
c545beb1 MT	29	#
	30	# log ("message") use default 'ipcop' tag
	31	# log ("tag","message") use your tag
	32	#
ac1cfefa MT	33	sub log
ac1cfefa MT	34	{
c545beb1 MT	35	my $tag='ipfire';
c545beb1 MT	36	$tag = shift if (@_>1);
ac1cfefa MT	37	my $logmessage = $_[0];
	38	$logmessage =~ /([\w\W]*)/;
	39	$logmessage = $1;
77007ce5	40	system('logger', '-t', $tag, $logmessage);
ac1cfefa MT	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
77007ce5 MT	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;
ac1cfefa MT	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	{
ad60e3ea	91	if ( $var eq "__CGI__"){next;}
ac1cfefa MT	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
	107	sub age
	108	{
	109	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
	110	$atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
	111	my $now = time;
	112
	113	my $totalsecs = $now - $mtime;
	114	my $days = int($totalsecs / 86400);
	115	my $totalhours = int($totalsecs / 3600);
	116	my $hours = $totalhours % 24;
	117	my $totalmins = int($totalsecs / 60);
	118	my $mins = $totalmins % 60;
	119	my $secs = $totalsecs % 60;
	120
	121	return "${days}d ${hours}h ${mins}m ${secs}s";
	122	}
	123
	124	sub validip
	125	{
	126	my $ip = $_[0];
	127
	128	if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
	129	return 0; }
	130	else
	131	{
	132	my @octets = ($1, $2, $3, $4);
	133	foreach $_ (@octets)
	134	{
	135	if (/^0./) {
	136	return 0; }
	137	if ($_ < 0 \|\| $_ > 255) {
	138	return 0; }
	139	}
	140	return 1;
	141	}
	142	}
	143
	144	sub validmask
	145	{
	146	my $mask = $_[0];
	147
	148	# secord part an ip?
	149	if (&validip($mask)) {
	150	return 1; }
	151	# second part a number?
	152	if (/^0/) {
	153	return 0; }
	154	if (!($mask =~ /^\d+$/)) {
	155	return 0; }
156	if ($mask >= 0 && $mask <= 32) {
157	return 1; }
158	return 0;
159	}
160
161	sub validipormask
162	{
163	my $ipormask = $_[0];
164
165	# see if it is a IP only.
166	if (&validip($ipormask)) {
167	return 1; }
168	# split it into number and mask.
169	if (!($ipormask =~ /^(.?)\/(.?)$/)) {
170	return 0; }
171	my $ip = $1;
172	my $mask = $2;
173	# first part not a ip?
174	if (!(&validip($ip))) {
175	return 0; }
176	return &validmask($mask);
177	}
178
179	sub validipandmask
180	{
181	my $ipandmask = $_[0];
182
183	# split it into number and mask.
184	if (!($ipandmask =~ /^(.?)\/(.?)$/)) {
185	return 0; }
186	my $ip = $1;
187	my $mask = $2;
188	# first part not a ip?
189	if (!(&validip($ip))) {
190	return 0; }
191	return &validmask($mask);
192	}
193
194	sub validport
195	{
196	$_ = $_[0];
197
198	if (!/^\d+$/) {
199	return 0; }
200	if (/^0./) {
201	return 0; }
202	if ($_ >= 1 && $_ <= 65535) {
203	return 1; }
204	return 0;
205	}
206
d30ea451 CS	207	sub validproxyport
	208	{
	209	$_ = $_[0];
	210
	211	if (!/^\d+$/) {
	212	return 0; }
	213	if (/^0./) {
	214	return 0; }
	215	if ($_ == 53 \|\| $_ == 222 \|\| $_ == 444 \|\| $_ == 81 ) {
	216	return 0; }
	217	elsif ($_ >= 1 && $_ <= 65535) {
	218	return 1; }
	219	return 0;
	220	}
	221
ac1cfefa MT	222	sub validmac
	223	{
	224	my $checkmac = $_[0];
	225	my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
	226	if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
	227	{
	228	return 0;
	229	}
	230	return 1;
	231	}
	232
	233	sub validhostname
	234	{
	235	# Checks a hostname against RFC1035
	236	my $hostname = $_[0];
	237
	238	# Each part should be at least two characters in length
	239	# but no more than 63 characters
	240	if (length ($hostname) < 1 \|\| length ($hostname) > 63) {
	241	return 0;}
	242	# Only valid characters are a-z, A-Z, 0-9 and -
	243	if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
	244	return 0;}
	245	# First character can only be a letter or a digit
	246	if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
	247	return 0;}
	248	# Last character can only be a letter or a digit
	249	if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
	250	return 0;}
	251	return 1;
	252	}
	253
	254	sub validdomainname
	255	{
	256	my $part;
	257
	258	# Checks a domain name against RFC1035
	259	my $domainname = $_[0];
	260	my @parts = split (/\./, $domainname); # Split hostname at the '.'
	261
	262	foreach $part (@parts) {
	263	# Each part should be at least two characters in length
	264	# but no more than 63 characters
	265	if (length ($part) < 2 \|\| length ($part) > 63) {
	266	return 0;}
	267	# Only valid characters are a-z, A-Z, 0-9 and -
	268	if ($part !~ /^[a-zA-Z0-9-]*$/) {
	269	return 0;}
	270	# First character can only be a letter or a digit
	271	if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
	272	return 0;}
	273	# Last character can only be a letter or a digit
	274	if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
	275	return 0;}
	276	}
	277	return 1;
	278	}
	279
	280	sub validfqdn
	281	{
	282	my $part;
	283
	284	# Checks a fully qualified domain name against RFC1035
	285	my $fqdn = $_[0];
286	my @parts = split (/\./, $fqdn); # Split hostname at the '.'
287	if (scalar(@parts) < 2) { # At least two parts should
288	return 0;} # exist in a FQDN
289	# (i.e. hostname.domain)
290	foreach $part (@parts) {
291	# Each part should be at least one character in length
292	# but no more than 63 characters
293	if (length ($part) < 1 \|\| length ($part) > 63) {
294	return 0;}
295	# Only valid characters are a-z, A-Z, 0-9 and -
296	if ($part !~ /^[a-zA-Z0-9-]*$/) {
297	return 0;}
298	# First character can only be a letter or a digit
299	if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
300	return 0;}
301	# Last character can only be a letter or a digit
302	if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
303	return 0;}
304	}
305	return 1;
306	}
307
308	sub validportrange # used to check a port range
309	{
310	my $port = $_[0]; # port values
311	$port =~ tr/-/:/; # replace all - with colons just in case someone used -
312	my $srcdst = $_[1]; # is it a source or destination port
313
314	if (!($port =~ /^(\d+)\:(\d+)$/)) {
315
316	if (!(&validport($port))) {
317	if ($srcdst eq 'src'){
318	return $Lang::tr{'source port numbers'};
319	} else {
320	return $Lang::tr{'destination port numbers'};
321	}
322	}
323	}
324	else
325	{
326	my @ports = ($1, $2);
327	if ($1 >= $2){
328	if ($srcdst eq 'src'){
329	return $Lang::tr{'bad source range'};
330	} else {
331	return $Lang::tr{'bad destination range'};
332	}
333	}
334	foreach $_ (@ports)
335	{
336	if (!(&validport($_))) {
337	if ($srcdst eq 'src'){
338	return $Lang::tr{'source port numbers'};
339	} else {
340	return $Lang::tr{'destination port numbers'};
341	}
342	}
343	}
344	return;
345	}
346	}
347
348	# Test if IP is within a subnet
349	# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
350	# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
351	# Everything in dottted notation
352	# Return: TRUE/FALSE
353	sub IpInSubnet
354	{
355	my $ip = unpack('N', &Socket::inet_aton(shift));
356	my $start = unpack('N', &Socket::inet_aton(shift));
357	my $mask = unpack('N', &Socket::inet_aton(shift));
358	$start &= $mask; # base of subnet...
359	my $end = $start + ~$mask;
360	return (($ip >= $start) && ($ip <= $end));
361	}
362
c545beb1 MT	363	#
	364	# Return the following IP (IP+1) in dotted notation.
	365	# Call: NextIP ('1.1.1.1');
	366	# Return: '1.1.1.2'
	367	#
	368	sub NextIP
	369	{
	370	return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
	371	)
	372	);
	373	}
	374
ac1cfefa MT	375	sub validemail {
	376	my $mail = shift;
	377	return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
	378	return 0 if ( $mail =~ /^[^0-9a-zA-Z]\|[^0-9a-zA-Z]$/);
	379	return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
	380	return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
	381	return 0 if ( $mail =~ /.\.\-.\|.\-\..\|.\.\..\|.\-\-./g );
	382	return 0 if ( $mail =~ /.\.\_.\|.\-\_.\|.\_\..\|.\_\-.\|.\_\_./g );
	383	return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
	384	return 1;
	385	}
	386
c545beb1 MT	387	#
	388	# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
	389	# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
	390	# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
	391	#
ac1cfefa MT	392	sub readhasharray {
	393	my ($filename, $hash) = @_;
	394	%$hash = ();
	395
	396	open(FILE, $filename) or die "Unable to read file $filename";
	397
	398	while (<FILE>) {
	399	my ($key, $rest, @temp);
	400	chomp;
	401	($key, $rest) = split (/,/, $_, 2);
c545beb1	402	if ($key =~ /^[0-9]+$/) {
ac1cfefa MT	403	@temp = split (/,/, $rest);
	404	$hash->{$key} = \@temp;
	405	}
	406	}
	407	close FILE;
	408	return;
	409	}
	410
	411	sub writehasharray {
	412	my ($filename, $hash) = @_;
	413	my ($key, @temp, $i);
	414
	415	open(FILE, ">$filename") or die "Unable to write to file $filename";
	416
	417	foreach $key (keys %$hash) {
c545beb1	418	if ($key =~ /^[0-9]+$/) {
ac1cfefa MT	419	print FILE "$key";
	420	foreach $i (0 .. $#{$hash->{$key}}) {
	421	print FILE ",$hash->{$key}[$i]";
	422	}
c545beb1	423	print FILE "\n";
ac1cfefa	424	}
ac1cfefa MT	425	}
	426	close FILE;
	427	return;
	428	}
	429
	430	sub findhasharraykey {
	431	foreach my $i (1 .. 1000000) {
	432	if ( ! exists $_[0]{$i}) {
	433	return $i;
	434	}
	435	}
	436	}
	437
	438	sub srtarray
	439	# Darren Critchley - darrenc@telus.net - (c) 2003
	440	# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
	441	# This subroutine will take the following parameters:
	442	# ColumnNumber = the column which you want to sort on, starts at 1
	443	# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
	444	# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
	445	# ArrayToBeSorted = the array that wants sorting
	446	#
	447	# Returns an array that is sorted to your specs
	448	#
	449	# If SortOrder is greater than the elements in array, then it defaults to the first element
	450	#
	451	{
	452	my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
	453	my @tmparray;
	454	my @srtedarray;
	455	my $line;
	456	my $newline;
	457	my $ctr;
	458	my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
	459	if ($ttlitems < 1){ # if no items, don't waste our time lets leave
	460	return (@tobesorted);
	461	}
	462	my @tmp = split(/\,/,$tobesorted[0]);
	463	$ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
	464
	465	# Darren Critchley - validate parameters
	466	if ($colno > $ttlitems){$colno = '1';}
	467	$colno--; # remove one from colno to deal with arrays starting at 0
	468	if($colno < 0){$colno = '0';}
	469	if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
	470	if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
	471
	472	foreach $line (@tobesorted)
	473	{
	474	chomp($line);
	475	if ($line ne '') {
	476	my @temp = split(/\,/,$line);
	477	# Darren Critchley - juggle the fields so that the one we want to sort on is first
	478	my $tmpholder = $temp[0];
	479	$temp[0] = $temp[$colno];
	480	$temp[$colno] = $tmpholder;
	481	$newline = "";
	482	for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
	483	$newline=$newline . $temp[$ctr] . ",";
	484	}
	485	chop($newline);
	486	push(@tmparray,$newline);
	487	}
	488	}
489	if ($alpnum eq 'n') {
490	@tmparray = sort {$a <=> $b} @tmparray;
491	} else {
492	@tmparray = (sort @tmparray);
493	}
494	foreach $line (@tmparray)
495	{
496	chomp($line);
497	if ($line ne '') {
498	my @temp = split(/\,/,$line);
499	my $tmpholder = $temp[0];
500	$temp[0] = $temp[$colno];
501	$temp[$colno] = $tmpholder;
502	$newline = "";
503	for ($ctr=0; $ctr < $ttlitems ; $ctr++){
504	$newline=$newline . $temp[$ctr] . ",";
505	}
506	chop($newline);
507	push(@srtedarray,$newline);
508	}
509	}
510
511	if ($srtdir eq 'dsc') {
512	@tmparray = reverse(@srtedarray);
513	return (@tmparray);
514	} else {
515	return (@srtedarray);
516	}
517	}
518
519	sub FetchPublicIp {
520	my %proxysettings;
521	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
522	if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
523	my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]?(?:\:[A-Za-z0-9\_\.\-]?)?\@)?([a-zA-Z0-9\.\_\-]?)(?:\:([0-9]{1,5}))?(?:\/.?)?$/);
524	Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
525	}
526	my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',
527	80,
528	"/",
39a7cc11	529	Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
ac1cfefa MT	530	);
	531	if ($response =~ m%HTTP/1\.. 200 OK%) {
	532	$out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
	533	return $1;
	534	}
	535	return '';
	536	}
	537
	538	#
	539	# Check if hostname.domain provided have IP provided
	540	# use gethostbyname to verify that
	541	# Params:
	542	# IP
	543	# hostname
	544	# domain
	545	# Output
	546	# 1 IP matches host.domain
	547	# 0 not in sync
	548	#
	549	sub DyndnsServiceSync ($;$;$) {
	550
	551	my ($ip,$hostName,$domain) = @_;
	552	my @addresses;
	553
	554	#fix me no ip GROUP, what is the name ?
	555	$hostName =~ s/$General::noipprefix//;
	556	if ($hostName) { #may be empty
	557	$hostName = "$hostName.$domain";
	558	@addresses = gethostbyname($hostName);
	559	}
	560
	561	if ($addresses[0] eq '') { # nothing returned ?
	562	$hostName = $domain; # try resolving with domain only
	563	@addresses = gethostbyname($hostName);
	564	}
	565
	566	if ($addresses[0] ne '') { # got something ?
	567	#&General::log("name:$addresses[0], alias:$addresses[1]");
	568	# Build clear text list of IP
	569	@addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
	570	if (grep (/$ip/, @addresses)) {
	571	return 1;
	572	}
	573	}
	574	return 0;
	575	}
	576	#
	577	# This sub returns the red IP used to compare in DyndnsServiceSync
	578	#
	579	sub GetDyndnsRedIP {
	580	my %settings;
	581	&General::readhash("${General::swroot}/ddns/settings", \%settings);
	582
	583	open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
	584	my $ip = <IP>;
	585	close(IP);
	586	chomp $ip;
	587
	588	if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') \|\|
	589	&General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') \|\|
	590	&General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
	591	{
	592	if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
	593	my $RealIP = &General::FetchPublicIp;
594	$ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
595	}
596	}
597	return $ip;
598	}
c545beb1 MT	599
	600	# Translate ICMP code to text
	601	# ref: http://www.iana.org/assignments/icmp-parameters
	602	sub GetIcmpDescription ($) {
	603	my $index = shift;
	604	my @icmp_description = (
	605	'Echo Reply', #0
	606	'Unassigned',
	607	'Unassigned',
	608	'Destination Unreachable',
	609	'Source Quench',
	610	'Redirect',
	611	'Alternate Host Address',
	612	'Unassigned',
	613	'Echo',
	614	'Router Advertisement',
	615	'Router Solicitation', #10
	616	'Time Exceeded',
	617	'Parameter Problem',
	618	'Timestamp',
	619	'Timestamp Reply',
	620	'Information Request',
	621	'Information Reply',
	622	'Address Mask Request',
	623	'Address Mask Reply',
	624	'Reserved (for Security)',
	625	'Reserved (for Robustness Experiment)', #20
	626	'Reserved',
	627	'Reserved',
	628	'Reserved',
	629	'Reserved',
	630	'Reserved',
	631	'Reserved',
	632	'Reserved',
	633	'Reserved',
	634	'Reserved',
	635	'Traceroute', #30
	636	'Datagram Conversion Error',
	637	'Mobile Host Redirect',
	638	'IPv6 Where-Are-You',
	639	'IPv6 I-Am-Here',
	640	'Mobile Registration Request',
	641	'Mobile Registration Reply',
	642	'Domain Name Request',
	643	'Domain Name Reply',
	644	'SKIP',
	645	'Photur', #40
	646	'Experimental');
	647	if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
	648	}
ac1cfefa	649	1;