]> git.ipfire.org Git - people/teissler/ipfire-2.x.git/blame - config/cfgroot/general-functions.pl
projects / people / teissler / ipfire-2.x.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
openvpn.cgi: Respect if mtu-disc hasn't been configured yet.
[people/teissler/ipfire-2.x.git] / config / cfgroot / general-functions.pl
CommitLineData
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
15package General;
16
17use strict;
18use Socket;
19use IO::Socket;
c545beb1 20use Net::SSLeay;
8c877a82 21use Net::IPv4Addr qw(:all);
ac1cfefa
MT		 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		 33sub log
34{
c545beb1
MT		 35 my $tag='ipfire';
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
43sub 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
80sub 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		 106sub 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
142sub 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
159sub 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
179sub 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
196sub 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
8c877a82 214sub subtocidr
ac1cfefa 215{
8c877a82
AM		 216 #gets: Subnet in decimal (255.255.255.0)
217 #Gives: 24 (The cidr of network)
218 my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
219 my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
220 my $bin = unpack("B*", pack("N", $num));
221 my $count = ($bin =~ tr/1/1/);
222 return $count;
223}
ac1cfefa 224
8c877a82
AM		 225sub cidrtosub
226{
227 #gets: Cidr of network (20-30 for ccd)
228 #Konverts 30 to 255.255.255.252 e.g
229 my $cidr=$_[0];
230 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
231 return "$netmask";
232}
233
234sub iporsubtodec
235{
236 #Gets: Ip address or subnetmask in decimal oder CIDR
237 #Gives: What it gets only in CIDR format
238 my $subnet=$_[0];
239 my $net;
240 my $mask;
241 my $full=0;
242 if ($subnet =~ /^(.*?)\/(.*?)$/) {
243 ($net,$mask) = split (/\//,$subnet);
244 $full=1;
245 return "$subnet";
246 }else{
247 $mask=$subnet;
248 }
249 #Subnet already in decimal and valid?
250 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
251 for (my $i=8;$i<=32;$i++){
252 if (&General::cidrtosub($i) eq $mask){
253 if ($full == 0){return $mask;}else{
254 return $net."/".$mask;
255 }
256 }
257 }
258 }
259 #Subnet in binary format?
260 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
261 if($full == 0){ return &General::cidrtosub($mask);}else{
262 return $net."/".&General::cidrtosub($mask);
263 }
264 }else{
265 return 3;
266 }
267 return 3;
268}
269
270
271sub iporsubtocidr
272{
273 #gets: Ip Address or subnetmask in decimal oder CIDR
274 #Gives: What it gets only in CIDR format
275 my $subnet=$_[0];
276 my $net;
277 my $mask;
278 my $full=0;
279 if ($subnet =~ /^(.*?)\/(.*?)$/) {
280 ($net,$mask) = split (/\//,$subnet);
281 $full=1;
282 }else{
283 $mask=$subnet;
284 }
285 #Subnet in decimal and valid?
286 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
287 for (my $i=8;$i<=32;$i++){
288 if (&General::cidrtosub($i) eq $mask){
289 if ($full == 0){return &General::subtocidr($mask);}else{
290 return $net."/".&General::subtocidr($mask);
291 }
292 }
293 }
294 }
295 #Subnet already in binary format?
296 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
297 if($full == 0){ return $mask;}else{
298 return $net."/".$mask;
299 }
300 }else{
301 return 3;
302 }
303 return 3;
304}
305
306sub getnetworkip
307{
308 #Gets: IP, CIDR (10.10.10.0-255, 24)
309 #Gives: 10.10.10.0
310 my ($ccdip,$ccdsubnet) = @_;
311 my $ip_address_binary = inet_aton( $ccdip );
312 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
313 my $network_address = inet_ntoa( $ip_address_binary & $netmask_binary );
314 return $network_address;
315}
316
317sub getccdbc
318{
319 #Gets: IP in Form ("192.168.0.0/24")
320 #Gives: Broadcastaddress of network
321 my $ccdnet=$_;
322 my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
323 my $ip_address_binary = inet_aton( $ccdip );
324 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
325 my $broadcast_address = inet_ntoa( $ip_address_binary | ~$netmask_binary );
326 return $broadcast_address;
327}
328sub getnextip
329{
330 my ($byte1,$byte2,$byte3,$byte4) = split (/\./,$_[0]);
331 my $step=$_[1];
332 for (my $x=1;$x<=$step;$x++){
333 $byte4++;
334 if($byte4==255){ $byte4=0;$byte3++;}
335 if($byte3==255){$byte3=0;$byte2++;}
336 if ($byte2==255){$byte2=0;$byte1++}
337
338 }
339 return "$byte1.$byte2.$byte3.$byte4";
340}
341sub getlastip
342{
343 my ($byte1,$byte2,$byte3,$byte4) = split (/\./,$_[0]);
344 my $step=$_[1];
345 for (my $x=$step;$x>=1;$x--){
346 $byte4--;
347 if($byte4==0){ $byte4=255;$byte3--;}
348 if($byte3==0){$byte3=255;$byte2--;}
349 if ($byte2==0){$byte2=255;$byte1--}
350 }
351 return "$byte1.$byte2.$byte3.$byte4";
352}
353
354sub validipandmask
355{
356 #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
357 #Gives: True bzw 0 if success or false
358 my $ccdnet=$_[0];
359 my $subcidr;
360
361 if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
362 return 0;
363 }
364 my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
365 #IP valid?
366 if ($ccdip=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1>0 && $1<=255 && $2>=0 && $2<=255 && $3>=0 && $3<=255 && $4<=255 ))) {
367 #Subnet in decimal and valid?
368 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
369 for (my $i=8;$i<=30;$i++){
370 if (&General::cidrtosub($i) eq $ccdsubnet){
371 return 1;
372 }
373 }
374 #Subnet already in binary format?
375 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=30 && $1>=8))){
376 return 1;
377 }else{
378 return 0;
379 }
380
381 }
382 return 0;
ac1cfefa
MT		 383}
384
385sub validport
386{
387 $_ = $_[0];
388
389 if (!/^\d+$/) {
390 return 0; }
391 if (/^0./) {
392 return 0; }
393 if ($_ >= 1 && $_ <= 65535) {
394 return 1; }
395 return 0;
396}
397
d30ea451
CS		 398sub validproxyport
399{
400 $_ = $_[0];
401
402 if (!/^\d+$/) {
403 return 0; }
404 if (/^0./) {
405 return 0; }
406 if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
407 return 0; }
408 elsif ($_ >= 1 && $_ <= 65535) {
409 return 1; }
410 return 0;
411}
412
ac1cfefa
MT		 413sub validmac
414{
415 my $checkmac = $_[0];
416 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
417 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
418 {
419 return 0;
420 }
421 return 1;
422}
423
424sub validhostname
425{
426 # Checks a hostname against RFC1035
427 my $hostname = $_[0];
428
429 # Each part should be at least two characters in length
430 # but no more than 63 characters
431 if (length ($hostname) < 1 || length ($hostname) > 63) {
432 return 0;}
433 # Only valid characters are a-z, A-Z, 0-9 and -
8c877a82 434 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
ac1cfefa
MT		 435 return 0;}
436 # First character can only be a letter or a digit
437 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
438 return 0;}
439 # Last character can only be a letter or a digit
440 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
441 return 0;}
442 return 1;
443}
444
445sub validdomainname
446{
447 my $part;
448
449 # Checks a domain name against RFC1035
450 my $domainname = $_[0];
451 my @parts = split (/\./, $domainname); # Split hostname at the '.'
452
453 foreach $part (@parts) {
454 # Each part should be at least two characters in length
455 # but no more than 63 characters
456 if (length ($part) < 2 || length ($part) > 63) {
457 return 0;}
458 # Only valid characters are a-z, A-Z, 0-9 and -
459 if ($part !~ /^[a-zA-Z0-9-]*$/) {
460 return 0;}
461 # First character can only be a letter or a digit
462 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
463 return 0;}
464 # Last character can only be a letter or a digit
465 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
466 return 0;}
467 }
468 return 1;
469}
470
471sub validfqdn
472{
473 my $part;
474
475 # Checks a fully qualified domain name against RFC1035
476 my $fqdn = $_[0];
477 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
478 if (scalar(@parts) < 2) { # At least two parts should
479 return 0;} # exist in a FQDN
480 # (i.e. hostname.domain)
481 foreach $part (@parts) {
482 # Each part should be at least one character in length
483 # but no more than 63 characters
484 if (length ($part) < 1 || length ($part) > 63) {
485 return 0;}
486 # Only valid characters are a-z, A-Z, 0-9 and -
487 if ($part !~ /^[a-zA-Z0-9-]*$/) {
488 return 0;}
489 # First character can only be a letter or a digit
490 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
491 return 0;}
492 # Last character can only be a letter or a digit
493 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
494 return 0;}
495 }
496 return 1;
497}
498
499sub validportrange # used to check a port range
500{
501 my $port = $_[0]; # port values
502 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
503 my $srcdst = $_[1]; # is it a source or destination port
504
505 if (!($port =~ /^(\d+)\:(\d+)$/)) {
506
507 if (!(&validport($port))) {
508 if ($srcdst eq 'src'){
509 return $Lang::tr{'source port numbers'};
510 } else {
511 return $Lang::tr{'destination port numbers'};
512 }
513 }
514 }
515 else
516 {
517 my @ports = ($1, $2);
518 if ($1 >= $2){
519 if ($srcdst eq 'src'){
520 return $Lang::tr{'bad source range'};
521 } else {
522 return $Lang::tr{'bad destination range'};
523 }
524 }
525 foreach $_ (@ports)
526 {
527 if (!(&validport($_))) {
528 if ($srcdst eq 'src'){
529 return $Lang::tr{'source port numbers'};
530 } else {
531 return $Lang::tr{'destination port numbers'};
532 }
533 }
534 }
535 return;
536 }
537}
538
539# Test if IP is within a subnet
540# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
541# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
542# Everything in dottted notation
543# Return: TRUE/FALSE
544sub IpInSubnet
545{
546 my $ip = unpack('N', &Socket::inet_aton(shift));
547 my $start = unpack('N', &Socket::inet_aton(shift));
548 my $mask = unpack('N', &Socket::inet_aton(shift));
549 $start &= $mask; # base of subnet...
550 my $end = $start + ~$mask;
551 return (($ip >= $start) && ($ip <= $end));
552}
553
c545beb1
MT		 554#
555# Return the following IP (IP+1) in dotted notation.
556# Call: NextIP ('1.1.1.1');
557# Return: '1.1.1.2'
558#
559sub NextIP
560{
561 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
562 )
563 );
564}
8c877a82
AM		 565sub NextIP2
566{
567 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
568 )
569 );
570}
45762fc6
AF		 571sub ipcidr
572{
573 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
574 return "$ip\/$cidr";
575}
576
54fd0535
MT		 577sub ipcidr2msk
578{
579 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
580 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
581 return "$ip\/$netmask";
582}
583
584
ac1cfefa
MT		 585sub validemail {
586 my $mail = shift;
587 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
588 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
589 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
590 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
591 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
592 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
593 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
594 return 1;
595}
596
c545beb1
MT		 597#
598# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
599# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
600# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
601#
ac1cfefa
MT		 602sub readhasharray {
603 my ($filename, $hash) = @_;
604 %$hash = ();
605
606 open(FILE, $filename) or die "Unable to read file $filename";
607
608 while (<FILE>) {
609 my ($key, $rest, @temp);
610 chomp;
611 ($key, $rest) = split (/,/, $_, 2);
c545beb1 612 if ($key =~ /^[0-9]+$/) {
ac1cfefa
MT		 613 @temp = split (/,/, $rest);
614 $hash->{$key} = \@temp;
615 }
616 }
617 close FILE;
618 return;
619}
620
621sub writehasharray {
622 my ($filename, $hash) = @_;
623 my ($key, @temp, $i);
624
625 open(FILE, ">$filename") or die "Unable to write to file $filename";
626
627 foreach $key (keys %$hash) {
8c877a82
AM		 628 if ($key =~ /^[0-9]+$/) {
629 print FILE "$key";
630 foreach $i (0 .. $#{$hash->{$key}}) {
631 print FILE ",$hash->{$key}[$i]";
632 }
633 print FILE "\n";
634 }
ac1cfefa
MT		 635 }
636 close FILE;
637 return;
638}
639
640sub findhasharraykey {
641 foreach my $i (1 .. 1000000) {
642 if ( ! exists $_[0]{$i}) {
643 return $i;
644 }
645 }
646}
647
648sub srtarray
649# Darren Critchley - darrenc@telus.net - (c) 2003
650# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
651# This subroutine will take the following parameters:
652# ColumnNumber = the column which you want to sort on, starts at 1
653# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
654# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
655# ArrayToBeSorted = the array that wants sorting
656#
657# Returns an array that is sorted to your specs
658#
659# If SortOrder is greater than the elements in array, then it defaults to the first element
660#
661{
662 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
663 my @tmparray;
664 my @srtedarray;
665 my $line;
666 my $newline;
667 my $ctr;
668 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
669 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
670 return (@tobesorted);
671 }
672 my @tmp = split(/\,/,$tobesorted[0]);
673 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
674
675 # Darren Critchley - validate parameters
676 if ($colno > $ttlitems){$colno = '1';}
677 $colno--; # remove one from colno to deal with arrays starting at 0
678 if($colno < 0){$colno = '0';}
679 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
680 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
681
682 foreach $line (@tobesorted)
683 {
684 chomp($line);
685 if ($line ne '') {
686 my @temp = split(/\,/,$line);
687 # Darren Critchley - juggle the fields so that the one we want to sort on is first
688 my $tmpholder = $temp[0];
689 $temp[0] = $temp[$colno];
690 $temp[$colno] = $tmpholder;
691 $newline = "";
692 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
693 $newline=$newline . $temp[$ctr] . ",";
694 }
695 chop($newline);
696 push(@tmparray,$newline);
697 }
698 }
699 if ($alpnum eq 'n') {
700 @tmparray = sort {$a <=> $b} @tmparray;
701 } else {
702 @tmparray = (sort @tmparray);
703 }
704 foreach $line (@tmparray)
705 {
706 chomp($line);
707 if ($line ne '') {
708 my @temp = split(/\,/,$line);
709 my $tmpholder = $temp[0];
710 $temp[0] = $temp[$colno];
711 $temp[$colno] = $tmpholder;
712 $newline = "";
713 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
714 $newline=$newline . $temp[$ctr] . ",";
715 }
716 chop($newline);
717 push(@srtedarray,$newline);
718 }
719 }
720
721 if ($srtdir eq 'dsc') {
722 @tmparray = reverse(@srtedarray);
723 return (@tmparray);
724 } else {
725 return (@srtedarray);
726 }
727}
728
729sub FetchPublicIp {
730 my %proxysettings;
731 &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
732 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
733 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
734 Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
735 }
736 my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',
737 80,
738 "/",
39a7cc11 739 Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
ac1cfefa
MT		 740 );
741 if ($response =~ m%HTTP/1\.. 200 OK%) {
742 $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
743 return $1;
744 }
745 return '';
746}
747
748#
749# Check if hostname.domain provided have IP provided
750# use gethostbyname to verify that
751# Params:
752# IP
753# hostname
754# domain
755# Output
756# 1 IP matches host.domain
757# 0 not in sync
758#
759sub DyndnsServiceSync ($;$;$) {
760
761 my ($ip,$hostName,$domain) = @_;
762 my @addresses;
763
764 #fix me no ip GROUP, what is the name ?
765 $hostName =~ s/$General::noipprefix//;
766 if ($hostName) { #may be empty
767 $hostName = "$hostName.$domain";
768 @addresses = gethostbyname($hostName);
769 }
770
771 if ($addresses[0] eq '') { # nothing returned ?
772 $hostName = $domain; # try resolving with domain only
773 @addresses = gethostbyname($hostName);
774 }
775
776 if ($addresses[0] ne '') { # got something ?
777 #&General::log("name:$addresses[0], alias:$addresses[1]");
778 # Build clear text list of IP
779 @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
780 if (grep (/$ip/, @addresses)) {
781 return 1;
782 }
783 }
784 return 0;
785}
786#
787# This sub returns the red IP used to compare in DyndnsServiceSync
788#
789sub GetDyndnsRedIP {
790 my %settings;
791 &General::readhash("${General::swroot}/ddns/settings", \%settings);
792
793 open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
794 my $ip = <IP>;
795 close(IP);
796 chomp $ip;
797
798 if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
799 &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
800 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
801 {
802 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
803 my $RealIP = &General::FetchPublicIp;
804 $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
805 }
806 }
807 return $ip;
808}
c545beb1
MT		 809
810# Translate ICMP code to text
811# ref: http://www.iana.org/assignments/icmp-parameters
812sub GetIcmpDescription ($) {
813 my $index = shift;
814 my @icmp_description = (
815 'Echo Reply', #0
816 'Unassigned',
817 'Unassigned',
818 'Destination Unreachable',
819 'Source Quench',
820 'Redirect',
821 'Alternate Host Address',
822 'Unassigned',
823 'Echo',
824 'Router Advertisement',
825 'Router Solicitation', #10
826 'Time Exceeded',
827 'Parameter Problem',
828 'Timestamp',
829 'Timestamp Reply',
830 'Information Request',
831 'Information Reply',
832 'Address Mask Request',
833 'Address Mask Reply',
834 'Reserved (for Security)',
835 'Reserved (for Robustness Experiment)', #20
836 'Reserved',
837 'Reserved',
838 'Reserved',
839 'Reserved',
840 'Reserved',
841 'Reserved',
842 'Reserved',
843 'Reserved',
844 'Reserved',
845 'Traceroute', #30
846 'Datagram Conversion Error',
847 'Mobile Host Redirect',
848 'IPv6 Where-Are-You',
849 'IPv6 I-Am-Here',
850 'Mobile Registration Request',
851 'Mobile Registration Reply',
852 'Domain Name Request',
853 'Domain Name Reply',
854 'SKIP',
855 'Photur', #40
856 'Experimental');
857 if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
858}
ac1cfefa 8591;
Timo's tree of IPFire 2.x