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