]>
git.ipfire.org Git - ipfire-2.x.git/blob - config/cfgroot/general-functions.pl
3 # This code is distributed under the terms of the GPL
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()
12 # $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
21 $|=1; # line buffering
23 $General::version
= 'VERSION';
24 $General::swroot
= 'CONFIG_ROOT';
25 $General::noipprefix
= 'noipg-';
26 $General::adminmanualurl
= 'http://users.ipfire.eu';
30 my $logmessage = $_[0];
31 $logmessage =~ /([\w\W]*)/;
33 system('/usr/bin/logger', '-t', 'ipfire', $logmessage);
43 # Some ipcop code expects that readhash 'complete' the hash if new entries
44 # are presents. Not clear it !!!
47 open(FILE
, $filename) or die "Unable to read file $filename";
52 ($var, $val) = split /=/, $_, 2;
58 # Untaint variables read from hash
59 $var =~ /([A-Za-z0-9_-]*)/; $var = $1;
60 $val =~ /([\w\W]*)/; $val = $1;
74 # write cgi vars to the file.
75 open(FILE
, ">${filename}") or die "Unable to write file $filename";
77 foreach $var (keys %$hash)
80 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
81 # location of the mouse are submitted as well, this was being written to the settings file causing
82 # some serious grief! This skips the variable.x and variable.y
83 if (!($var =~ /(.x|.y)$/)) {
86 if (!($var =~ /^ACTION/)) {
87 print FILE
"${var}=${val}\n"; }
96 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
97 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
100 my $totalsecs = $now - $mtime;
101 my $days = int($totalsecs / 86400);
102 my $totalhours = int($totalsecs / 3600);
103 my $hours = $totalhours % 24;
104 my $totalmins = int($totalsecs / 60);
105 my $mins = $totalmins % 60;
106 my $secs = $totalsecs % 60;
108 return "${days}d ${hours}h ${mins}m ${secs}s";
115 if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
119 my @octets = ($1, $2, $3, $4);
124 if ($_ < 0 || $_ > 255) {
136 if (&validip
($mask)) {
138 # second part a number?
141 if (!($mask =~ /^\d+$/)) {
143 if ($mask >= 0 && $mask <= 32) {
150 my $ipormask = $_[0];
152 # see if it is a IP only.
153 if (&validip
($ipormask)) {
155 # split it into number and mask.
156 if (!($ipormask =~ /^(.*?)\/(.*?
)$/)) {
160 # first part not a ip?
161 if (!(&validip
($ip))) {
163 return &validmask
($mask);
168 my $ipandmask = $_[0];
170 # split it into number and mask.
171 if (!($ipandmask =~ /^(.*?)\/(.*?
)$/)) {
175 # first part not a ip?
176 if (!(&validip
($ip))) {
178 return &validmask
($mask);
189 if ($_ >= 1 && $_ <= 65535) {
196 my $checkmac = $_[0];
197 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
198 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
207 # Checks a hostname against RFC1035
208 my $hostname = $_[0];
210 # Each part should be at least two characters in length
211 # but no more than 63 characters
212 if (length ($hostname) < 1 || length ($hostname) > 63) {
214 # Only valid characters are a-z, A-Z, 0-9 and -
215 if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
217 # First character can only be a letter or a digit
218 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
220 # Last character can only be a letter or a digit
221 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
230 # Checks a domain name against RFC1035
231 my $domainname = $_[0];
232 my @parts = split (/\./, $domainname); # Split hostname at the '.'
234 foreach $part (@parts) {
235 # Each part should be at least two characters in length
236 # but no more than 63 characters
237 if (length ($part) < 2 || length ($part) > 63) {
239 # Only valid characters are a-z, A-Z, 0-9 and -
240 if ($part !~ /^[a-zA-Z0-9-]*$/) {
242 # First character can only be a letter or a digit
243 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
245 # Last character can only be a letter or a digit
246 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
256 # Checks a fully qualified domain name against RFC1035
258 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
259 if (scalar(@parts) < 2) { # At least two parts should
260 return 0;} # exist in a FQDN
261 # (i.e. hostname.domain)
262 foreach $part (@parts) {
263 # Each part should be at least one character in length
264 # but no more than 63 characters
265 if (length ($part) < 1 || length ($part) > 63) {
267 # Only valid characters are a-z, A-Z, 0-9 and -
268 if ($part !~ /^[a-zA-Z0-9-]*$/) {
270 # First character can only be a letter or a digit
271 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
273 # Last character can only be a letter or a digit
274 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
280 sub validportrange
# used to check a port range
282 my $port = $_[0]; # port values
283 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
284 my $srcdst = $_[1]; # is it a source or destination port
286 if (!($port =~ /^(\d+)\:(\d+)$/)) {
288 if (!(&validport
($port))) {
289 if ($srcdst eq 'src'){
290 return $Lang::tr
{'source port numbers'};
292 return $Lang::tr
{'destination port numbers'};
298 my @ports = ($1, $2);
300 if ($srcdst eq 'src'){
301 return $Lang::tr
{'bad source range'};
303 return $Lang::tr
{'bad destination range'};
308 if (!(&validport
($_))) {
309 if ($srcdst eq 'src'){
310 return $Lang::tr
{'source port numbers'};
312 return $Lang::tr
{'destination port numbers'};
320 # Test if IP is within a subnet
321 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
322 # Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
323 # Everything in dottted notation
327 my $ip = unpack('N', &Socket
::inet_aton
(shift));
328 my $start = unpack('N', &Socket
::inet_aton
(shift));
329 my $mask = unpack('N', &Socket
::inet_aton
(shift));
330 $start &= $mask; # base of subnet...
331 my $end = $start + ~$mask;
332 return (($ip >= $start) && ($ip <= $end));
337 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
338 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
339 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
340 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
341 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
342 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
343 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
348 my ($filename, $hash) = @_;
351 open(FILE
, $filename) or die "Unable to read file $filename";
354 my ($key, $rest, @temp);
356 ($key, $rest) = split (/,/, $_, 2);
357 if ($key =~ /^[0-9]+$/ && $rest) {
358 @temp = split (/,/, $rest);
359 $hash->{$key} = \
@temp;
367 my ($filename, $hash) = @_;
368 my ($key, @temp, $i);
370 open(FILE
, ">$filename") or die "Unable to write to file $filename";
372 foreach $key (keys %$hash) {
373 if ( $hash->{$key} ) {
375 foreach $i (0 .. $#{$hash->{$key}}) {
376 print FILE
",$hash->{$key}[$i]";
385 sub findhasharraykey
{
386 foreach my $i (1 .. 1000000) {
387 if ( ! exists $_[0]{$i}) {
394 # Darren Critchley - darrenc@telus.net - (c) 2003
395 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
396 # This subroutine will take the following parameters:
397 # ColumnNumber = the column which you want to sort on, starts at 1
398 # AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
399 # SortDirection = asc or dsc (lowercase) Ascending or Descending sort
400 # ArrayToBeSorted = the array that wants sorting
402 # Returns an array that is sorted to your specs
404 # If SortOrder is greater than the elements in array, then it defaults to the first element
407 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
413 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
414 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
415 return (@tobesorted);
417 my @tmp = split(/\,/,$tobesorted[0]);
418 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
420 # Darren Critchley - validate parameters
421 if ($colno > $ttlitems){$colno = '1';}
422 $colno--; # remove one from colno to deal with arrays starting at 0
423 if($colno < 0){$colno = '0';}
424 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
425 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
427 foreach $line (@tobesorted)
431 my @temp = split(/\,/,$line);
432 # Darren Critchley - juggle the fields so that the one we want to sort on is first
433 my $tmpholder = $temp[0];
434 $temp[0] = $temp[$colno];
435 $temp[$colno] = $tmpholder;
437 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
438 $newline=$newline . $temp[$ctr] . ",";
441 push(@tmparray,$newline);
444 if ($alpnum eq 'n') {
445 @tmparray = sort {$a <=> $b} @tmparray;
447 @tmparray = (sort @tmparray);
449 foreach $line (@tmparray)
453 my @temp = split(/\,/,$line);
454 my $tmpholder = $temp[0];
455 $temp[0] = $temp[$colno];
456 $temp[$colno] = $tmpholder;
458 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
459 $newline=$newline . $temp[$ctr] . ",";
462 push(@srtedarray,$newline);
466 if ($srtdir eq 'dsc') {
467 @tmparray = reverse(@srtedarray);
470 return (@srtedarray);
476 &General
::readhash
("${General::swroot}/proxy/settings", \
%proxysettings);
477 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
478 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\
/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?
)?
$/);
479 Net
::SSLeay
::set_proxy
($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
481 my ($out, $response) = Net
::SSLeay
::get_http
( 'checkip.dyndns.org',
484 Net
::SSLeay
::make_headers
('User-Agent' => 'IPFire' )
486 if ($response =~ m
%HTTP/1\
.. 200 OK
%) {
487 $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
494 # Check if hostname.domain provided have IP provided
495 # use gethostbyname to verify that
501 # 1 IP matches host.domain
504 sub DyndnsServiceSync
($;$;$) {
506 my ($ip,$hostName,$domain) = @_;
509 #fix me no ip GROUP, what is the name ?
510 $hostName =~ s/$General::noipprefix//;
511 if ($hostName) { #may be empty
512 $hostName = "$hostName.$domain";
513 @addresses = gethostbyname($hostName);
516 if ($addresses[0] eq '') { # nothing returned ?
517 $hostName = $domain; # try resolving with domain only
518 @addresses = gethostbyname($hostName);
521 if ($addresses[0] ne '') { # got something ?
522 #&General::log("name:$addresses[0], alias:$addresses[1]");
523 # Build clear text list of IP
524 @addresses = map ( &Socket
::inet_ntoa
($_), @addresses[4..$#addresses]);
525 if (grep (/$ip/, @addresses)) {
532 # This sub returns the red IP used to compare in DyndnsServiceSync
536 &General
::readhash
("${General::swroot}/ddns/settings", \
%settings);
538 open(IP
, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
543 if (&General
::IpInSubnet
($ip,'10.0.0.0','255.0.0.0') ||
544 &General
::IpInSubnet
($ip,'172.16.0.0.','255.240.0.0') ||
545 &General
::IpInSubnet
($ip,'192.168.0.0','255.255.0.0'))
547 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
548 my $RealIP = &General
::FetchPublicIp
;
549 $ip = (&General
::validip
($RealIP) ?
$RealIP : 'unavailable');