[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 writehashpart
{
	# This function replaces the given hash in the original hash by keeping the old
	# content and just replacing the new content

	my $filename = $_[0];
	my $newhash = $_[1];
	my %oldhash;
	my ($var, $val);

	readhash("${filename}", \%oldhash);

	foreach $var (keys %$newhash){
		$oldhash{$var}=$newhash->{$var};
	}

	# write cgi vars to the file.
	open(FILE, ">${filename}") or die "Unable to write file $filename";
	flock FILE, 2;
	foreach $var (keys %oldhash) 
	{
		if ( $var eq "__CGI__"){next;}
		$val = $oldhash{$var};
		# Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
		# location of the mouse are submitted as well, this was being written to the settings file causing
		# some serious grief! This skips the variable.x and variable.y
		if (!($var =~ /(.x|.y)$/)) {
			if ($val =~ / /) {
				$val = "\'$val\'"; }
			if (!($var =~ /^ACTION/)) {
				print FILE "${var}=${val}\n"; }
		}
	}
	close FILE;
}

sub age
{
	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
	        $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
	my $now = time;

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