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