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