Merge remote-tracking branch 'stevee/wlan-client' into next
[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 my $timestring = '';
148 my $dset = 0; # Day is set, when > 0
149 my $hset = 0; # Hour is set, when > 0
150 my $mset = 0; # Minute is set, when > 0
151
152 my $totalsecs = $now - $mtime;
153 my $days = int($totalsecs / 86400);
154 my $totalhours = int($totalsecs / 3600);
155 my $hours = $totalhours % 24;
156 my $totalmins = int($totalsecs / 60);
157 my $mins = $totalmins % 60;
158 my $secs = $totalsecs % 60;
159
160 if ($days > 1) {
161 ${timestring} .= ${days}.' '.$Lang::tr{'days'}.', ';
162 $dset = 1;
163 }
164 elsif ($days == 1) {
165 ${timestring} .= ${days}.' '.$Lang::tr{'day'}.', ';
166 $dset = 1;
167 }
168
169 if (($hours > 1) && !($dset)) {
170 ${timestring} .= ${hours}.' '.$Lang::tr{'hours'}.', ';
171 $hset = 1;
172 }
173 elsif (($hours == 1) && !($dset)) {
174 ${timestring} .= ${hours}.' '.$Lang::tr{'hour'}.', ';
175 $hset = 1;
176 }
177 elsif ($dset) {
178 ${timestring} .= ${hours}.' '.$Lang::tr{'age shour'}.', ';
179 $hset = 1;
180 }
181
182 if ((($mins > 1) || ($mins == 0)) && !($dset || $hset)) {
183 ${timestring} .= ${mins}.' '.$Lang::tr{'minutes'}.', ';
184 $mset = 1;
185 }
186 elsif (($mins == 1) && !($dset || $hset)) {
187 ${timestring} .= ${mins}.' '.$Lang::tr{'minute'}.', ';
188 $mset = 1;
189 }
190 else {
191 ${timestring} .= ${mins}.' '.$Lang::tr{'age sminute'}.', ';
192 $mset = 1;
193 }
194
195 if ((($secs > 1) || ($secs == 0)) && !($dset || $hset || $mset)) {
196 ${timestring} .= ${secs}.' '.$Lang::tr{'age seconds'};
197 }
198 elsif (($secs == 1) && !($dset || $hset || $mset)) {
199 ${timestring} .= $secs.' '.$Lang::tr{'age second'};
200 }
201 else { ${timestring} .= $secs.' '.$Lang::tr{'age ssecond'}; }
202
203 return ${timestring};
204 }
205
206 sub validip
207 {
208 my $ip = $_[0];
209
210 if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
211 return 0; }
212 else
213 {
214 my @octets = ($1, $2, $3, $4);
215 foreach $_ (@octets)
216 {
217 if (/^0./) {
218 return 0; }
219 if ($_ < 0 || $_ > 255) {
220 return 0; }
221 }
222 return 1;
223 }
224 }
225
226 sub validmask
227 {
228 my $mask = $_[0];
229
230 # secord part an ip?
231 if (&validip($mask)) {
232 return 1; }
233 # second part a number?
234 if (/^0/) {
235 return 0; }
236 if (!($mask =~ /^\d+$/)) {
237 return 0; }
238 if ($mask >= 0 && $mask <= 32) {
239 return 1; }
240 return 0;
241 }
242
243 sub validipormask
244 {
245 my $ipormask = $_[0];
246
247 # see if it is a IP only.
248 if (&validip($ipormask)) {
249 return 1; }
250 # split it into number and mask.
251 if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
252 return 0; }
253 my $ip = $1;
254 my $mask = $2;
255 # first part not a ip?
256 if (!(&validip($ip))) {
257 return 0; }
258 return &validmask($mask);
259 }
260
261 sub subtocidr
262 {
263 #gets: Subnet in decimal (255.255.255.0)
264 #Gives: 24 (The cidr of network)
265 my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
266 my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
267 my $bin = unpack("B*", pack("N", $num));
268 my $count = ($bin =~ tr/1/1/);
269 return $count;
270 }
271
272 sub cidrtosub
273 {
274 #gets: Cidr of network (20-30 for ccd)
275 #Konverts 30 to 255.255.255.252 e.g
276 my $cidr=$_[0];
277 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
278 return "$netmask";
279 }
280
281 sub iporsubtodec
282 {
283 #Gets: Ip address or subnetmask in decimal oder CIDR
284 #Gives: What it gets only in CIDR format
285 my $subnet=$_[0];
286 my $net;
287 my $mask;
288 my $full=0;
289 if ($subnet =~ /^(.*?)\/(.*?)$/) {
290 ($net,$mask) = split (/\//,$subnet);
291 $full=1;
292 return "$subnet";
293 }else{
294 $mask=$subnet;
295 }
296 #Subnet already in decimal and valid?
297 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
298 for (my $i=8;$i<=32;$i++){
299 if (&General::cidrtosub($i) eq $mask){
300 if ($full == 0){return $mask;}else{
301 return $net."/".$mask;
302 }
303 }
304 }
305 }
306 #Subnet in binary format?
307 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
308 if($full == 0){ return &General::cidrtosub($mask);}else{
309 return $net."/".&General::cidrtosub($mask);
310 }
311 }else{
312 return 3;
313 }
314 return 3;
315 }
316
317
318 sub iporsubtocidr
319 {
320 #gets: Ip Address or subnetmask in decimal oder CIDR
321 #Gives: What it gets only in CIDR format
322 my $subnet=$_[0];
323 my $net;
324 my $mask;
325 my $full=0;
326 if ($subnet =~ /^(.*?)\/(.*?)$/) {
327 ($net,$mask) = split (/\//,$subnet);
328 $full=1;
329 }else{
330 $mask=$subnet;
331 }
332 #Subnet in decimal and valid?
333 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
334 for (my $i=8;$i<=32;$i++){
335 if (&General::cidrtosub($i) eq $mask){
336 if ($full == 0){return &General::subtocidr($mask);}else{
337 return $net."/".&General::subtocidr($mask);
338 }
339 }
340 }
341 }
342 #Subnet already in binary format?
343 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
344 if($full == 0){ return $mask;}else{
345 return $net."/".$mask;
346 }
347 }else{
348 return 3;
349 }
350 return 3;
351 }
352
353 sub getnetworkip
354 {
355 #Gets: IP, CIDR (10.10.10.0-255, 24)
356 #Gives: 10.10.10.0
357 my ($ccdip,$ccdsubnet) = @_;
358 my $ip_address_binary = inet_aton( $ccdip );
359 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
360 my $network_address = inet_ntoa( $ip_address_binary & $netmask_binary );
361 return $network_address;
362 }
363
364 sub getccdbc
365 {
366 #Gets: IP in Form ("192.168.0.0/24")
367 #Gives: Broadcastaddress of network
368 my $ccdnet=$_;
369 my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
370 my $ip_address_binary = inet_aton( $ccdip );
371 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
372 my $broadcast_address = inet_ntoa( $ip_address_binary | ~$netmask_binary );
373 return $broadcast_address;
374 }
375
376 sub ip2dec
377 {
378 my $ip_num;
379 my $ip=$_[0];
380 if ( $ip =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
381 $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
382 } else {
383 $ip_num = -1;
384 }
385 $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
386 return($ip_num);
387 }
388
389 sub dec2ip
390 {
391 my $ip;
392 my $ip_num=$_[0];
393 my $o1=$ip_num%256;
394 $ip_num=int($ip_num/256);
395 my $o2=$ip_num%256;
396 $ip_num=int($ip_num/256);
397 my $o3=$ip_num%256;
398 $ip_num=int($ip_num/256);
399 my $o4=$ip_num%256;
400 $ip="$o4.$o3.$o2.$o1";
401 return ($ip);
402 }
403
404 sub getnextip
405 {
406 my $decip=&ip2dec($_[0]);
407 $decip=$decip+4;
408 return &dec2ip($decip);
409 }
410
411 sub getlastip
412 {
413 my $decip=&ip2dec($_[0]);
414 $decip--;
415 return &dec2ip($decip);
416 }
417
418 sub validipandmask
419 {
420 #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
421 #Gives: True bzw 0 if success or false
422 my $ccdnet=$_[0];
423 my $subcidr;
424
425 if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
426 return 0;
427 }
428 my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
429 #IP valid?
430 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 ))) {
431 #Subnet in decimal and valid?
432 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
433 for (my $i=8;$i<=32;$i++){
434 if (&General::cidrtosub($i) eq $ccdsubnet){
435 return 1;
436 }
437 }
438 #Subnet already in binary format?
439 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
440 return 1;
441 }else{
442 return 0;
443 }
444
445 }
446 return 0;
447 }
448
449 sub checksubnets
450 {
451 my %ccdconfhash=();
452 my @ccdconf=();
453 my $ccdname=$_[0];
454 my $ccdnet=$_[1];
455 my $errormessage;
456 my ($ip,$cidr)=split(/\//,$ccdnet);
457 $cidr=&iporsubtocidr($cidr);
458 #get OVPN-Subnet (dynamic range)
459 my %ovpnconf=();
460 &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
461 my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
462 $ovpncidr=&iporsubtocidr($ovpncidr);
463 #check if we try to use same network as ovpn server
464 if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
465 $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
466 return $errormessage;
467 }
468 #check if we use a network-name/subnet that already exists
469 &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
470 foreach my $key (keys %ccdconfhash) {
471 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
472 if ($ccdname eq $ccdconfhash{$key}[0])
473 {
474 $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
475 return $errormessage;
476 }
477 my ($newip,$newsub) = split(/\//,$ccdnet);
478 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
479 {
480 $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
481 return $errormessage;
482 }
483 }
484 #check if we use a ipsec right network which is already defined
485 my %ipsecconf=();
486 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
487 foreach my $key (keys %ipsecconf){
488 if ($ipsecconf{$key}[11] ne ''){
489 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
490 $ipsecsub=&iporsubtodec($ipsecsub);
491 if($ipsecconf{$key}[1] ne $ccdname){
492 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
493 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[1]";
494 return $errormessage;
495 }
496 }
497 }
498 }
499 #check if we use one of ipfire's networks (green,orange,blue)
500 my %ownnet=();
501 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
502 if (($ownnet{'GREEN_NETADDRESS'} ne '' && $ownnet{'GREEN_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'GREEN_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
503 if (($ownnet{'ORANGE_NETADDRESS'} ne '' && $ownnet{'ORANGE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'ORANGE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
504 if (($ownnet{'BLUE_NETADDRESS'} ne '' && $ownnet{'BLUE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'BLUE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
505 if (($ownnet{'RED_NETADDRESS'} ne '' && $ownnet{'RED_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'RED_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
506 }
507
508
509 sub validport
510 {
511 $_ = $_[0];
512
513 if (!/^\d+$/) {
514 return 0; }
515 if (/^0./) {
516 return 0; }
517 if ($_ >= 1 && $_ <= 65535) {
518 return 1; }
519 return 0;
520 }
521
522 sub validproxyport
523 {
524 $_ = $_[0];
525
526 if (!/^\d+$/) {
527 return 0; }
528 if (/^0./) {
529 return 0; }
530 if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
531 return 0; }
532 elsif ($_ >= 1 && $_ <= 65535) {
533 return 1; }
534 return 0;
535 }
536
537 sub validmac
538 {
539 my $checkmac = $_[0];
540 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
541 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
542 {
543 return 0;
544 }
545 return 1;
546 }
547
548 sub validhostname
549 {
550 # Checks a hostname against RFC1035
551 my $hostname = $_[0];
552
553 # Each part should be at least two characters in length
554 # but no more than 63 characters
555 if (length ($hostname) < 1 || length ($hostname) > 63) {
556 return 0;}
557 # Only valid characters are a-z, A-Z, 0-9 and -
558 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
559 return 0;}
560 # First character can only be a letter or a digit
561 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
562 return 0;}
563 # Last character can only be a letter or a digit
564 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
565 return 0;}
566 return 1;
567 }
568
569 sub validdomainname
570 {
571 my $part;
572
573 # Checks a domain name against RFC1035
574 my $domainname = $_[0];
575 my @parts = split (/\./, $domainname); # Split hostname at the '.'
576
577 foreach $part (@parts) {
578 # Each part should be at least two characters in length
579 # but no more than 63 characters
580 if (length ($part) < 2 || length ($part) > 63) {
581 return 0;}
582 # Only valid characters are a-z, A-Z, 0-9 and -
583 if ($part !~ /^[a-zA-Z0-9-]*$/) {
584 return 0;}
585 # First character can only be a letter or a digit
586 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
587 return 0;}
588 # Last character can only be a letter or a digit
589 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
590 return 0;}
591 }
592 return 1;
593 }
594
595 sub validfqdn
596 {
597 my $part;
598
599 # Checks a fully qualified domain name against RFC1035
600 my $fqdn = $_[0];
601 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
602 if (scalar(@parts) < 2) { # At least two parts should
603 return 0;} # exist in a FQDN
604 # (i.e. hostname.domain)
605 foreach $part (@parts) {
606 # Each part should be at least one character in length
607 # but no more than 63 characters
608 if (length ($part) < 1 || length ($part) > 63) {
609 return 0;}
610 # Only valid characters are a-z, A-Z, 0-9 and -
611 if ($part !~ /^[a-zA-Z0-9-]*$/) {
612 return 0;}
613 # First character can only be a letter or a digit
614 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
615 return 0;}
616 # Last character can only be a letter or a digit
617 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
618 return 0;}
619 }
620 return 1;
621 }
622
623 sub validportrange # used to check a port range
624 {
625 my $port = $_[0]; # port values
626 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
627 my $srcdst = $_[1]; # is it a source or destination port
628
629 if (!($port =~ /^(\d+)\:(\d+)$/)) {
630
631 if (!(&validport($port))) {
632 if ($srcdst eq 'src'){
633 return $Lang::tr{'source port numbers'};
634 } else {
635 return $Lang::tr{'destination port numbers'};
636 }
637 }
638 }
639 else
640 {
641 my @ports = ($1, $2);
642 if ($1 >= $2){
643 if ($srcdst eq 'src'){
644 return $Lang::tr{'bad source range'};
645 } else {
646 return $Lang::tr{'bad destination range'};
647 }
648 }
649 foreach $_ (@ports)
650 {
651 if (!(&validport($_))) {
652 if ($srcdst eq 'src'){
653 return $Lang::tr{'source port numbers'};
654 } else {
655 return $Lang::tr{'destination port numbers'};
656 }
657 }
658 }
659 return;
660 }
661 }
662
663 # Test if IP is within a subnet
664 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
665 # Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
666 # Everything in dottted notation
667 # Return: TRUE/FALSE
668 sub IpInSubnet
669 {
670 my $ip = unpack('N', &Socket::inet_aton(shift));
671 my $start = unpack('N', &Socket::inet_aton(shift));
672 my $mask = unpack('N', &Socket::inet_aton(shift));
673 $start &= $mask; # base of subnet...
674 my $end = $start + ~$mask;
675 return (($ip >= $start) && ($ip <= $end));
676 }
677
678 #
679 # Return the following IP (IP+1) in dotted notation.
680 # Call: NextIP ('1.1.1.1');
681 # Return: '1.1.1.2'
682 #
683 sub NextIP
684 {
685 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
686 )
687 );
688 }
689 sub NextIP2
690 {
691 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
692 )
693 );
694 }
695 sub ipcidr
696 {
697 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
698 return "$ip\/$cidr";
699 }
700
701 sub ipcidr2msk
702 {
703 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
704 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
705 return "$ip\/$netmask";
706 }
707
708
709 sub validemail {
710 my $mail = shift;
711 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
712 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
713 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
714 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
715 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
716 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
717 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
718 return 1;
719 }
720
721 #
722 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
723 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
724 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
725 #
726 sub readhasharray {
727 my ($filename, $hash) = @_;
728 %$hash = ();
729
730 open(FILE, $filename) or die "Unable to read file $filename";
731
732 while (<FILE>) {
733 my ($key, $rest, @temp);
734 chomp;
735 ($key, $rest) = split (/,/, $_, 2);
736 if ($key =~ /^[0-9]+$/) {
737 @temp = split (/,/, $rest);
738 $hash->{$key} = \@temp;
739 }
740 }
741 close FILE;
742 return;
743 }
744
745 sub writehasharray {
746 my ($filename, $hash) = @_;
747 my ($key, @temp, $i);
748
749 open(FILE, ">$filename") or die "Unable to write to file $filename";
750
751 foreach $key (keys %$hash) {
752 if ($key =~ /^[0-9]+$/) {
753 print FILE "$key";
754 foreach $i (0 .. $#{$hash->{$key}}) {
755 print FILE ",$hash->{$key}[$i]";
756 }
757 print FILE "\n";
758 }
759 }
760 close FILE;
761 return;
762 }
763
764 sub findhasharraykey {
765 foreach my $i (1 .. 1000000) {
766 if ( ! exists $_[0]{$i}) {
767 return $i;
768 }
769 }
770 }
771
772 sub srtarray
773 # Darren Critchley - darrenc@telus.net - (c) 2003
774 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
775 # This subroutine will take the following parameters:
776 # ColumnNumber = the column which you want to sort on, starts at 1
777 # AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
778 # SortDirection = asc or dsc (lowercase) Ascending or Descending sort
779 # ArrayToBeSorted = the array that wants sorting
780 #
781 # Returns an array that is sorted to your specs
782 #
783 # If SortOrder is greater than the elements in array, then it defaults to the first element
784 #
785 {
786 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
787 my @tmparray;
788 my @srtedarray;
789 my $line;
790 my $newline;
791 my $ctr;
792 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
793 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
794 return (@tobesorted);
795 }
796 my @tmp = split(/\,/,$tobesorted[0]);
797 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
798
799 # Darren Critchley - validate parameters
800 if ($colno > $ttlitems){$colno = '1';}
801 $colno--; # remove one from colno to deal with arrays starting at 0
802 if($colno < 0){$colno = '0';}
803 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
804 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
805
806 foreach $line (@tobesorted)
807 {
808 chomp($line);
809 if ($line ne '') {
810 my @temp = split(/\,/,$line);
811 # Darren Critchley - juggle the fields so that the one we want to sort on is first
812 my $tmpholder = $temp[0];
813 $temp[0] = $temp[$colno];
814 $temp[$colno] = $tmpholder;
815 $newline = "";
816 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
817 $newline=$newline . $temp[$ctr] . ",";
818 }
819 chop($newline);
820 push(@tmparray,$newline);
821 }
822 }
823 if ($alpnum eq 'n') {
824 @tmparray = sort {$a <=> $b} @tmparray;
825 } else {
826 @tmparray = (sort @tmparray);
827 }
828 foreach $line (@tmparray)
829 {
830 chomp($line);
831 if ($line ne '') {
832 my @temp = split(/\,/,$line);
833 my $tmpholder = $temp[0];
834 $temp[0] = $temp[$colno];
835 $temp[$colno] = $tmpholder;
836 $newline = "";
837 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
838 $newline=$newline . $temp[$ctr] . ",";
839 }
840 chop($newline);
841 push(@srtedarray,$newline);
842 }
843 }
844
845 if ($srtdir eq 'dsc') {
846 @tmparray = reverse(@srtedarray);
847 return (@tmparray);
848 } else {
849 return (@srtedarray);
850 }
851 }
852
853 sub FetchPublicIp {
854 my %proxysettings;
855 &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
856 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
857 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
858 Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
859 }
860 my $user_agent = &MakeUserAgent();
861 my ($out, $response) = Net::SSLeay::get_http( 'checkip4.dns.lightningwirelabs.com',
862 80,
863 "/",
864 Net::SSLeay::make_headers('User-Agent' => $user_agent )
865 );
866 if ($response =~ m%HTTP/1\.. 200 OK%) {
867 $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
868 return $1;
869 }
870 return '';
871 }
872
873 #
874 # Check if hostname.domain provided have IP provided
875 # use gethostbyname to verify that
876 # Params:
877 # IP
878 # hostname
879 # domain
880 # Output
881 # 1 IP matches host.domain
882 # 0 not in sync
883 #
884 sub DyndnsServiceSync ($;$;$) {
885
886 my ($ip,$hostName,$domain) = @_;
887 my @addresses;
888
889 #fix me no ip GROUP, what is the name ?
890 $hostName =~ s/$General::noipprefix//;
891 if ($hostName) { #may be empty
892 $hostName = "$hostName.$domain";
893 @addresses = gethostbyname($hostName);
894 }
895
896 if ($addresses[0] eq '') { # nothing returned ?
897 $hostName = $domain; # try resolving with domain only
898 @addresses = gethostbyname($hostName);
899 }
900
901 if ($addresses[0] ne '') { # got something ?
902 #&General::log("name:$addresses[0], alias:$addresses[1]");
903 # Build clear text list of IP
904 @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
905 if (grep (/$ip/, @addresses)) {
906 return 1;
907 }
908 }
909 return 0;
910 }
911 #
912 # This sub returns the red IP used to compare in DyndnsServiceSync
913 #
914 sub GetDyndnsRedIP {
915 my %settings;
916 &General::readhash("${General::swroot}/ddns/settings", \%settings);
917
918 open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
919 my $ip = <IP>;
920 close(IP);
921 chomp $ip;
922
923 # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
924 if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
925 &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
926 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
927 &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
928 {
929 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
930 my $RealIP = &General::FetchPublicIp;
931 $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
932 }
933 }
934 return $ip;
935 }
936
937 # Translate ICMP code to text
938 # ref: http://www.iana.org/assignments/icmp-parameters
939 sub GetIcmpDescription ($) {
940 my $index = shift;
941 my @icmp_description = (
942 'Echo Reply', #0
943 'Unassigned',
944 'Unassigned',
945 'Destination Unreachable',
946 'Source Quench',
947 'Redirect',
948 'Alternate Host Address',
949 'Unassigned',
950 'Echo',
951 'Router Advertisement',
952 'Router Solicitation', #10
953 'Time Exceeded',
954 'Parameter Problem',
955 'Timestamp',
956 'Timestamp Reply',
957 'Information Request',
958 'Information Reply',
959 'Address Mask Request',
960 'Address Mask Reply',
961 'Reserved (for Security)',
962 'Reserved (for Robustness Experiment)', #20
963 'Reserved',
964 'Reserved',
965 'Reserved',
966 'Reserved',
967 'Reserved',
968 'Reserved',
969 'Reserved',
970 'Reserved',
971 'Reserved',
972 'Traceroute', #30
973 'Datagram Conversion Error',
974 'Mobile Host Redirect',
975 'IPv6 Where-Are-You',
976 'IPv6 I-Am-Here',
977 'Mobile Registration Request',
978 'Mobile Registration Reply',
979 'Domain Name Request',
980 'Domain Name Reply',
981 'SKIP',
982 'Photur', #40
983 'Experimental');
984 if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
985 }
986
987 sub GetCoreUpdateVersion() {
988 my $core_update;
989
990 open(FILE, "/opt/pakfire/db/core/mine");
991 while (<FILE>) {
992 $core_update = $_;
993 last;
994 }
995 close(FILE);
996
997 return $core_update;
998 }
999
1000 sub MakeUserAgent() {
1001 my $user_agent = "IPFire/$General::version";
1002
1003 my $core_update = &GetCoreUpdateVersion();
1004 if ($core_update ne "") {
1005 $user_agent .= "/$core_update";
1006 }
1007
1008 return $user_agent;
1009 }
1010
1011 sub RedIsWireless() {
1012 # This function checks if a network device is a wireless device.
1013
1014 my %settings = ();
1015 &readhash("${General::swroot}/ethernet/settings", \%settings);
1016
1017 # Find the name of the network device.
1018 my $device = $settings{'RED_DEV'};
1019
1020 # Exit, if no device is configured.
1021 return 0 if ($device eq "");
1022
1023 # Return 1 if the device is a wireless one.
1024 my $path = "/sys/class/net/$device/wireless";
1025 if (-d $path) {
1026 return 1;
1027 }
1028
1029 # Otherwise return zero.
1030 return 0;
1031 }
1032
1033 1;