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