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