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