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