OpenVPN: Add CCD configuration GUI.
[people/teissler/ipfire-2.x.git] / config / cfgroot / general-functions.pl
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;
20 use Net::SSLeay;
21 use Net::IPv4Addr qw(:all);
22 $|=1; # line buffering
23
24 $General::version = 'VERSION';
25 $General::swroot = 'CONFIG_ROOT';
26 $General::noipprefix = 'noipg-';
27 $General::adminmanualurl = 'http://wiki.ipfire.org';
28
29 #
30 # log ("message") use default 'ipcop' tag
31 # log ("tag","message") use your tag
32 #
33 sub log
34 {
35 my $tag='ipfire';
36 $tag = shift if (@_>1);
37 my $logmessage = $_[0];
38 $logmessage =~ /([\w\W]*)/;
39 $logmessage = $1;
40 system('logger', '-t', $tag, $logmessage);
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
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;
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 if ( $var eq "__CGI__"){next;}
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
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 }
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 subtocidr
215 {
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 }
224
225 sub 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
234 sub 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
271 sub 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
306 sub 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
317 sub 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 }
328 sub 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 }
341 sub 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
354 sub 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;
383 }
384
385 sub 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
398 sub 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
413 sub 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
424 sub 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 -
434 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
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
445 sub 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
471 sub 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
499 sub 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
544 sub 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
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 #
559 sub NextIP
560 {
561 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
562 )
563 );
564 }
565 sub NextIP2
566 {
567 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
568 )
569 );
570 }
571 sub ipcidr
572 {
573 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
574 return "$ip\/$cidr";
575 }
576
577 sub 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
585 sub 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
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 #
602 sub 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);
612 if ($key =~ /^[0-9]+$/) {
613 @temp = split (/,/, $rest);
614 $hash->{$key} = \@temp;
615 }
616 }
617 close FILE;
618 return;
619 }
620
621 sub 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) {
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 }
635 }
636 close FILE;
637 return;
638 }
639
640 sub findhasharraykey {
641 foreach my $i (1 .. 1000000) {
642 if ( ! exists $_[0]{$i}) {
643 return $i;
644 }
645 }
646 }
647
648 sub 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
729 sub 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 "/",
739 Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
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 #
759 sub 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 #
789 sub 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 }
809
810 # Translate ICMP code to text
811 # ref: http://www.iana.org/assignments/icmp-parameters
812 sub 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 }
859 1;