← Back to branch summary

~vcs-imports/ipfire/ipfire-2.x

« back to all changes in this revision

Viewing changes to config/cfgroot/general-functions.pl

  • Committer: Daniel Glanzmann
  • Date: 2008-09-26 17:05:28 UTC
  • mto: (1394.1.12)
  • mto: This revision was merged to the branch mainline in revision 1401.
  • Revision ID: git-v1:19ac4d1b6e234e1391b3d406381e3b74e92c40dd
added new useragent thunderbird

Show diffs side-by-side

added added

removed removed

Lines of Context:
config/cfgroot/general-functions.pl
18
18
use Socket;
19
19
use IO::Socket;
20
20
use Net::SSLeay;
21
 
use Net::IPv4Addr qw(:all);
 
21
 
22
22
$|=1; # line buffering
23
23
 
24
24
$General::version = 'VERSION';
25
25
$General::swroot = 'CONFIG_ROOT';
26
26
$General::noipprefix = 'noipg-';
27
 
 
28
 
require "${General::swroot}/network-functions.pl";
29
 
 
30
 
# This function executes a shell command without forking a shell or do any other
31
 
# Perl-voodoo before it. It deprecates the "system" command and is the only way
32
 
# to call shell commands.
33
 
sub safe_system($) {
34
 
        my @command = @_;
35
 
 
36
 
        system { ${command[0]} } @command;
37
 
 
38
 
        # Return exit code
39
 
        return $? >> 8;
40
 
}
41
 
 
42
 
# Calls a process in the background and returns nothing
43
 
sub system_background($) {
44
 
        my $pid = fork();
45
 
 
46
 
        unless ($pid) {
47
 
                my $rc = &system(@_);
48
 
                exit($rc);
49
 
        }
50
 
 
51
 
        return 0;
52
 
}
53
 
 
54
 
# Returns the output of a shell command
55
 
sub system_output($) {
56
 
        my @command = @_;
57
 
        my $pid;
58
 
        my @output = ();
59
 
 
60
 
        unless ($pid = open(OUTPUT, "-|")) {
61
 
                open(STDERR, ">&STDOUT");
62
 
                exec { ${command[0]} } @command;
63
 
                die "Could not execute @command: $!";
64
 
        }
65
 
 
66
 
        waitpid($pid, 0);
67
 
 
68
 
        while (<OUTPUT>) {
69
 
                push(@output, $_);
70
 
        }
71
 
        close(OUTPUT);
72
 
 
73
 
        return @output;
74
 
}
75
 
 
76
 
# Calls a shell command and throws away the output
77
 
sub system($) {
78
 
        my @command = @_;
79
 
 
80
 
        open(SAVEOUT, ">&STDOUT");
81
 
        open(SAVEERR, ">&STDERR");
82
 
 
83
 
        open(STDOUT, ">/dev/null");
84
 
        open(STDERR, ">&STDOUT");
85
 
 
86
 
        select(STDERR); $|=1;
87
 
        select(STDOUT); $|=1;
88
 
 
89
 
        my $rc = &safe_system(@command);
90
 
 
91
 
        close(STDOUT);
92
 
        close(STDERR);
93
 
 
94
 
        # Restore
95
 
        open(STDOUT, ">&SAVEOUT");
96
 
        open(STDERR, ">&SAVEERR");
97
 
 
98
 
        return $rc;
99
 
}
100
 
 
101
 
# Function to remove duplicates from an array
102
 
sub uniq { my %seen; grep !$seen{$_}++, @_ }
 
27
$General::adminmanualurl = 'http://wiki.ipfire.org';
103
28
 
104
29
#
105
30
# log ("message") use default 'ipcop' tag
112
37
        my $logmessage = $_[0];
113
38
        $logmessage =~ /([\w\W]*)/;
114
39
        $logmessage = $1;
115
 
        &system('logger', '-t', $tag, $logmessage);
116
 
}
117
 
sub setup_default_networks
118
 
{
119
 
        my %netsettings=();
120
 
        my $defaultNetworks = shift;
121
 
        
122
 
        &readhash("/var/ipfire/ethernet/settings", \%netsettings);
123
 
        
124
 
        # Get current defined networks (Red, Green, Blue, Orange)
125
 
        $defaultNetworks->{$Lang::tr{'fwhost any'}}{'IPT'} = "0.0.0.0/0.0.0.0";
126
 
        $defaultNetworks->{$Lang::tr{'fwhost any'}}{'NAME'} = "ALL";
127
 
                
128
 
        $defaultNetworks->{$Lang::tr{'green'}}{'IPT'} = "$netsettings{'GREEN_NETADDRESS'}/$netsettings{'GREEN_NETMASK'}";
129
 
        $defaultNetworks->{$Lang::tr{'green'}}{'NET'} = "$netsettings{'GREEN_ADDRESS'}";
130
 
        $defaultNetworks->{$Lang::tr{'green'}}{'NAME'} = "GREEN";
131
 
 
132
 
        if ($netsettings{'RED_DEV'} ne ''){
133
 
                $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'IPT'} = "$netsettings{'RED_NETADDRESS'}/$netsettings{'RED_NETMASK'}";
134
 
                $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NET'} = "$netsettings{'RED_ADDRESS'}";
135
 
                $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NAME'} = "RED";
136
 
        }
137
 
        if ($netsettings{'ORANGE_DEV'} ne ''){
138
 
                $defaultNetworks->{$Lang::tr{'orange'}}{'IPT'} = "$netsettings{'ORANGE_NETADDRESS'}/$netsettings{'ORANGE_NETMASK'}";
139
 
                $defaultNetworks->{$Lang::tr{'orange'}}{'NET'} = "$netsettings{'ORANGE_ADDRESS'}";
140
 
                $defaultNetworks->{$Lang::tr{'orange'}}{'NAME'} = "ORANGE";
141
 
        }
142
 
 
143
 
        if ($netsettings{'BLUE_DEV'} ne ''){
144
 
                $defaultNetworks->{$Lang::tr{'blue'}}{'IPT'} = "$netsettings{'BLUE_NETADDRESS'}/$netsettings{'BLUE_NETMASK'}";
145
 
                $defaultNetworks->{$Lang::tr{'blue'}}{'NET'} = "$netsettings{'BLUE_ADDRESS'}";
146
 
                $defaultNetworks->{$Lang::tr{'blue'}}{'NAME'} = "BLUE";
147
 
        }
148
 
        
149
 
        #IPFire himself
150
 
        $defaultNetworks->{'IPFire'}{'NAME'} = "IPFire";
151
 
 
152
 
        # OpenVPN
153
 
        if(-e "${General::swroot}/ovpn/settings")
154
 
        {
155
 
                my %ovpnSettings = ();
156
 
                &readhash("${General::swroot}/ovpn/settings", \%ovpnSettings);
157
 
 
158
 
                # OpenVPN on Red?
159
 
                if(defined($ovpnSettings{'DOVPN_SUBNET'}))
160
 
                {
161
 
                        my ($ip,$sub) = split(/\//,$ovpnSettings{'DOVPN_SUBNET'});
162
 
                        $sub=&General::iporsubtocidr($sub);
163
 
                        my @tempovpnsubnet = split("\/", $ovpnSettings{'DOVPN_SUBNET'});
164
 
                        $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'ADR'} = $tempovpnsubnet[0];
165
 
                        $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'NAME'} = "OpenVPN-Dyn";
166
 
                }
167
 
        } # end OpenVPN
168
 
        # IPsec RW NET
169
 
        if(-e "${General::swroot}/vpn/settings")
170
 
        {
171
 
                my %ipsecsettings = ();
172
 
                &readhash("${General::swroot}/vpn/settings", \%ipsecsettings);
173
 
                if($ipsecsettings{'RW_NET'} ne '')
174
 
                {
175
 
                        my ($ip,$sub) = split(/\//,$ipsecsettings{'RW_NET'});
176
 
                        $sub=&General::iporsubtocidr($sub);
177
 
                        my @tempipsecsubnet = split("\/", $ipsecsettings{'RW_NET'});
178
 
                        $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'ADR'} = $tempipsecsubnet[0];
179
 
                        $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NAME'} = "IPsec RW";
180
 
                        $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NET'} = &getnextip($ip);
181
 
                }
182
 
        }
183
 
}
184
 
sub get_aliases
185
 
{
186
 
        
187
 
        my $defaultNetworks = shift;
188
 
        open(FILE, "${General::swroot}/ethernet/aliases") or die 'Unable to open aliases file.';
189
 
        my @current = <FILE>;
190
 
        close(FILE);
191
 
        my $ctr = 0;
192
 
        foreach my $line (@current)
193
 
        {
194
 
                if ($line ne ''){
195
 
                        chomp($line);
196
 
                        my @temp = split(/\,/,$line);
197
 
                        if ($temp[2] eq '') {
198
 
                                $temp[2] = "Alias $ctr : $temp[0]";
199
 
                        }
200
 
                        $defaultNetworks->{$temp[2]}{'IPT'} = "$temp[0]";
201
 
                        $defaultNetworks->{$temp[2]}{'NET'} = "$temp[0]";
202
 
                        
203
 
                        $ctr++;
204
 
                }
205
 
        }
 
40
        system('logger', '-t', $tag, $logmessage);
206
41
}
207
42
 
208
43
sub readhash
221
56
        while (<FILE>)
222
57
        {
223
58
                chop;
224
 
 
225
 
                # Skip comments.
226
 
                next if ($_ =~ /^#/);
227
 
 
228
59
                ($var, $val) = split /=/, $_, 2;
229
60
                if ($var)
230
61
                {
272
103
        close FILE;
273
104
}
274
105
 
275
 
sub writehashpart
 
106
 
 
107
sub age
276
108
{
277
 
        # This function replaces the given hash in the original hash by keeping the old
278
 
        # content and just replacing the new content
279
 
 
280
 
        my $filename = $_[0];
281
 
        my $newhash = $_[1];
282
 
        my %oldhash;
283
 
        my ($var, $val);
284
 
 
285
 
        readhash("${filename}", \%oldhash);
286
 
 
287
 
        foreach $var (keys %$newhash){
288
 
                $oldhash{$var}=$newhash->{$var};
289
 
        }
290
 
 
291
 
        # write cgi vars to the file.
292
 
        open(FILE, ">${filename}") or die "Unable to write file $filename";
293
 
        flock FILE, 2;
294
 
        foreach $var (keys %oldhash) 
295
 
        {
296
 
                if ( $var eq "__CGI__"){next;}
297
 
                $val = $oldhash{$var};
298
 
                # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
299
 
                # location of the mouse are submitted as well, this was being written to the settings file causing
300
 
                # some serious grief! This skips the variable.x and variable.y
301
 
                if (!($var =~ /(.x|.y)$/)) {
302
 
                        if ($val =~ / /) {
303
 
                                $val = "\'$val\'"; }
304
 
                        if (!($var =~ /^ACTION/)) {
305
 
                                print FILE "${var}=${val}\n"; }
306
 
                }
307
 
        }
308
 
        close FILE;
309
 
}
310
 
 
311
 
sub age {
312
109
        my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
313
 
                $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
314
 
        my $t = time() - $mtime;
315
 
 
316
 
        return &format_time($t);
317
 
}
318
 
 
319
 
sub format_time($) {
320
 
        my $totalsecs = shift;
321
 
        my @s = ();
322
 
 
 
110
                $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 
111
        my $now = time;
 
112
 
 
113
        my $totalsecs = $now - $mtime;
 
114
        my $days = int($totalsecs / 86400);
 
115
        my $totalhours = int($totalsecs / 3600);
 
116
        my $hours = $totalhours % 24;
 
117
        my $totalmins = int($totalsecs / 60);
 
118
        my $mins = $totalmins % 60;
323
119
        my $secs = $totalsecs % 60;
324
 
        $totalsecs /= 60;
325
 
        if ($secs > 0) {
326
 
                push(@s, "${secs}s");
327
 
        }
328
 
 
329
 
        my $min = $totalsecs % 60;
330
 
        $totalsecs /= 60;
331
 
        if ($min > 0) {
332
 
                push(@s, "${min}m");
333
 
        }
334
 
 
335
 
        my $hrs = $totalsecs % 24;
336
 
        $totalsecs /= 24;
337
 
        if ($hrs > 0) {
338
 
                push(@s, "${hrs}h");
339
 
        }
340
 
 
341
 
        my $days = int($totalsecs);
342
 
        if ($days > 0) {
343
 
                push(@s, "${days}d");
344
 
        }
345
 
 
346
 
        return join(" ", reverse(@s));
 
120
 
 
121
        return "${days}d ${hours}h ${mins}m ${secs}s";
347
122
}
348
123
 
349
124
sub validip
366
141
        }
367
142
}
368
143
 
369
 
sub validmask {
370
 
        my $mask = shift;
 
144
sub validmask
 
145
{
 
146
        my $mask = $_[0];
371
147
 
372
 
        return &Network::check_netmask($mask) || &Network::check_prefix($mask);
 
148
        # secord part an ip?
 
149
        if (&validip($mask)) {
 
150
                return 1; }
 
151
        # second part a number?
 
152
        if (/^0/) {
 
153
                return 0; }
 
154
        if (!($mask =~ /^\d+$/)) {
 
155
                return 0; }
 
156
        if ($mask >= 0 && $mask <= 32) {
 
157
                return 1; }
 
158
        return 0;
373
159
}
374
160
 
375
161
sub validipormask
390
176
        return &validmask($mask);
391
177
}
392
178
 
393
 
sub subtocidr {
394
 
        return &Network::convert_netmask2prefix(shift);
395
 
}
396
 
 
397
 
sub cidrtosub {
398
 
        return &Network::convert_prefix2netmask(shift);
399
 
}
400
 
  
401
 
sub iporsubtodec
402
 
{
403
 
        #Gets: Ip address or subnetmask in decimal oder CIDR
404
 
        #Gives: What it gets only in CIDR format
405
 
        my $subnet=$_[0];
406
 
        my $net;
407
 
        my $mask;
408
 
        my $full=0;
409
 
        if ($subnet =~ /^(.*?)\/(.*?)$/) {
410
 
                ($net,$mask) = split (/\//,$subnet);
411
 
                $full=1;
412
 
                return "$subnet";
413
 
        }else{
414
 
                $mask=$subnet;
415
 
        }
416
 
        #Subnet already in decimal and valid?
417
 
        if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
418
 
                for (my $i=0;$i<=32;$i++){
419
 
                        if (&General::cidrtosub($i) eq $mask){
420
 
                                if ($full == 0){return $mask;}else{
421
 
                                                         return $net."/".$mask;
422
 
                                }
423
 
                        }
424
 
                }       
425
 
        }
426
 
        #Subnet in binary format?
427
 
        if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
428
 
                        if($full == 0){ return &General::cidrtosub($mask);}else{
429
 
                                                 return $net."/".&General::cidrtosub($mask);
430
 
                        }
431
 
        }else{
432
 
                        return 3;
433
 
        }
434
 
        return 3;
435
 
}
436
 
  
437
 
  
438
 
sub iporsubtocidr
439
 
{
440
 
        #gets: Ip Address  or subnetmask in decimal oder CIDR
441
 
        #Gives: What it gets only in CIDR format
442
 
        my $subnet=$_[0];
443
 
        my $net;
444
 
        my $mask;
445
 
        my $full=0;
446
 
        if ($subnet =~ /^(.*?)\/(.*?)$/) {
447
 
                ($net,$mask) = split (/\//,$subnet);
448
 
                $full=1;
449
 
        }else{
450
 
                $mask=$subnet;
451
 
        }
452
 
        #Subnet in decimal and valid?
453
 
        if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
454
 
                for (my $i=0;$i<=32;$i++){
455
 
                        if (&General::cidrtosub($i) eq $mask){
456
 
                                if ($full == 0){return &General::subtocidr($mask);}else{
457
 
                                                         return $net."/".&General::subtocidr($mask);
458
 
                                }
459
 
                        }
460
 
                }       
461
 
        }
462
 
        #Subnet already in binary format?
463
 
        if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
464
 
                        if($full == 0){ return $mask;}else{
465
 
                                                 return $net."/".$mask;
466
 
                        }
467
 
        }else{
468
 
                        return 3;
469
 
        }
470
 
        return 3;
471
 
}
472
 
 
473
 
sub getnetworkip {
474
 
        my $arg = join("/", @_);
475
 
 
476
 
        return &Network::get_netaddress($arg);
477
 
}
478
 
 
479
 
sub getccdbc
480
 
{
481
 
        #Gets: IP in Form ("192.168.0.0/24")
482
 
        #Gives: Broadcastaddress of network
483
 
        my $ccdnet=$_;
484
 
        my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
485
 
        my $ip_address_binary = inet_aton( $ccdip );
486
 
        my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
487
 
        my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
488
 
        return $broadcast_address;
489
 
}
490
 
 
491
 
sub ip2dec  {
492
 
        return &Network::ip2bin(shift);
493
 
}
494
 
 
495
 
sub dec2ip  {
496
 
        return &Network::bin2ip(shift);
497
 
}
498
 
 
499
 
sub getnextip {
500
 
        return &Network::find_next_ip_address(shift, 4);
501
 
}
502
 
 
503
 
sub getlastip {
504
 
        return &Network::find_next_ip_address(shift, -1);
505
 
}
506
 
 
507
179
sub validipandmask
508
180
{
509
 
        #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
510
 
        #Gives: True bzw 0 if success or false 
511
 
        my $ccdnet=$_[0];
512
 
        my $subcidr;
513
 
        
514
 
        if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
515
 
                return 0;
516
 
        }
517
 
        my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
518
 
        #IP valid?
519
 
        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 ))) {
520
 
                #Subnet in decimal and valid?
521
 
                if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
522
 
                        for (my $i=0;$i<=32;$i++){
523
 
                                if (&General::cidrtosub($i) eq $ccdsubnet){
524
 
                                        return 1;
525
 
                                }
526
 
                        }
527
 
                #Subnet already in binary format?
528
 
                }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
529
 
                        return 1;
530
 
                }else{
531
 
                        return 0;
532
 
                }
533
 
                
534
 
        }
535
 
        return 0;
536
 
}
537
 
 
538
 
sub checksubnets
539
 
{
540
 
        my %ccdconfhash=();
541
 
        my %ovpnconfhash=();
542
 
        my %vpnconf=();
543
 
        my %ipsecconf=();
544
 
        my %ownnet=();
545
 
        my %ovpnconf=();
546
 
        my @ccdconf=();
547
 
        my $ccdname=$_[0];
548
 
        my $ccdnet=$_[1];
549
 
        my $ownnet=$_[2];
550
 
        my $checktype=$_[3];
551
 
        my $errormessage;
552
 
        my ($ip,$cidr)=split(/\//,$ccdnet);
553
 
        $cidr=&iporsubtocidr($cidr);
554
 
 
555
 
        #get OVPN-Subnet (dynamic range)
556
 
        &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
557
 
        my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
558
 
        $ovpncidr=&iporsubtocidr($ovpncidr);
559
 
 
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
 
        }
565
 
 
566
 
        #check if we try to use same network as another ovpn N2N
567
 
        if($ownnet ne 'ovpn'){
568
 
                &readhasharray("${General::swroot}/ovpn/ovpnconfig", \%ovpnconfhash);
569
 
                foreach my $key (keys %ovpnconfhash) {
570
 
                        if ($ovpnconfhash{$key}[3] eq 'net'){
571
 
                                my @ovpnnet=split (/\//,$ovpnconfhash{$key}[11]);
572
 
                                if (&IpInSubnet($ip,$ovpnnet[0],&iporsubtodec($ovpnnet[1]))){
573
 
                                        $errormessage=$errormessage.$Lang::tr{'ccd err isovpnn2n'}." $ovpnconfhash{$key}[1] <br>";
574
 
                                        return $errormessage;
575
 
                                }
576
 
                        }
577
 
                }
578
 
        }
579
 
 
580
 
        #check if we use a network-name/subnet (static-ovpn) that already exists
581
 
        &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
582
 
        foreach my $key (keys %ccdconfhash) {
583
 
                @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
584
 
                if ($ccdname eq $ccdconfhash{$key}[0]) 
585
 
                {
586
 
                        $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
587
 
                        return $errormessage;
588
 
                }
589
 
                my ($newip,$newsub) = split(/\//,$ccdnet);
590
 
                if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1]))) 
591
 
                {
592
 
                        $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
593
 
                        return $errormessage;
594
 
                }
595
 
        }
596
 
 
597
 
        #check if we use a ipsec right network which is already defined
598
 
        if($ownnet ne 'ipsec'){
599
 
                &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
600
 
                foreach my $key (keys %ipsecconf){
601
 
                        if ($ipsecconf{$key}[11] ne '' && $ipsecconf{$key}[36] eq ""){
602
 
                                foreach my $ipsecsubitem (split(/\|/, $ipsecconf{$key}[11])) {
603
 
                                        my ($ipsecip,$ipsecsub) = split (/\//, $ipsecsubitem);
604
 
                                        $ipsecsub=&iporsubtodec($ipsecsub);
605
 
                                        if($ipsecconf{$key}[1] ne $ccdname){
606
 
                                                if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
607
 
                                                        $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
608
 
                                                        return $errormessage;
609
 
                                                }
610
 
                                        }
611
 
                                }
612
 
                        }
613
 
                }
614
 
        }
615
 
 
616
 
        #check if we use the ipsec RW Network (if defined)
617
 
        &readhash("${General::swroot}/vpn/settings", \%vpnconf);
618
 
        if ($vpnconf{'RW_NET'} ne ''){
619
 
                my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
620
 
                if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
621
 
                {
622
 
                        $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
623
 
                        return $errormessage;
624
 
                }
625
 
        }
626
 
        
627
 
        #call check_net_internal
628
 
        if ($checktype eq "exact")
629
 
        {
630
 
                &General::check_net_internal_exact($ccdnet);
631
 
        }else{
632
 
                &General::check_net_internal_range($ccdnet);
633
 
        }
634
 
}
635
 
 
636
 
sub check_net_internal_range{
637
 
        my $network=shift;
638
 
        my ($ip,$cidr)=split(/\//,$network);
639
 
        my %ownnet=();
640
 
        my $errormessage;
641
 
        $cidr=&iporsubtocidr($cidr);
642
 
        #check if we use one of ipfire's networks (green,orange,blue)
643
 
        &readhash("${General::swroot}/ethernet/settings", \%ownnet);
644
 
        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;}
645
 
        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;}
646
 
        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;}
647
 
        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;}
648
 
}
649
 
 
650
 
sub check_net_internal_exact{
651
 
        my $network=shift;
652
 
        my ($ip,$cidr)=split(/\//,$network);
653
 
        my %ownnet=();
654
 
        my $errormessage;
655
 
        $cidr=&iporsubtocidr($cidr);
656
 
        #check if we use one of ipfire's networks (green,orange,blue)
657
 
        &readhash("${General::swroot}/ethernet/settings", \%ownnet);
658
 
        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;}
659
 
        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;}
660
 
        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;}
661
 
        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;}
 
181
        my $ipandmask = $_[0];
 
182
 
 
183
        # split it into number and mask.
 
184
        if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
 
185
                return 0; }
 
186
        my $ip = $1;
 
187
        my $mask = $2;
 
188
        # first part not a ip?
 
189
        if (!(&validip($ip))) {
 
190
                return 0; }
 
191
        return &validmask($mask);
662
192
}
663
193
 
664
194
sub validport
705
235
        # Checks a hostname against RFC1035
706
236
        my $hostname = $_[0];
707
237
 
708
 
        # Hostname should be at least one character in length
 
238
        # Each part should be at least two characters in length
709
239
        # but no more than 63 characters
710
240
        if (length ($hostname) < 1 || length ($hostname) > 63) {
711
241
                return 0;}
721
251
        return 1;
722
252
}
723
253
 
724
 
sub validccdname
725
 
{
726
 
        # Checks a ccdname for letters, numbers and spaces
727
 
        my $ccdname = $_[0];
728
 
 
729
 
        # ccdname should be at least one character in length
730
 
        # but no more than 63 characters
731
 
        if (length ($ccdname) < 1 || length ($ccdname) > 63) {
732
 
                return 0;}
733
 
        # Only valid characters are a-z, A-Z, 0-9, space and -
734
 
        if ($ccdname !~ /^[a-zA-Z0-9 -]*$/) {
735
 
                return 0;}
736
 
        return 1;
737
 
}
738
 
 
739
254
sub validdomainname
740
255
{
741
256
        my $part;
742
257
 
743
 
        # Checks a domain name against RFC1035 and RFC2181
 
258
        # Checks a domain name against RFC1035
744
259
        my $domainname = $_[0];
745
 
        my @parts = split (/\./, $domainname);  # Split domain name at the '.'
 
260
        my @parts = split (/\./, $domainname);  # Split hostname at the '.'
746
261
 
747
262
        foreach $part (@parts) {
748
 
                # Each part should be at least one character in length
 
263
                # Each part should be at least two characters in length
749
264
                # but no more than 63 characters
750
 
                if (length ($part) < 1 || length ($part) > 63) {
751
 
                        return 0;}
752
 
                # Only valid characters are a-z, A-Z, 0-9, _ and -
753
 
                if ($part !~ /^[a-zA-Z0-9_-]*$/) {
 
265
                if (length ($part) < 2 || length ($part) > 63) {
 
266
                        return 0;}
 
267
                # Only valid characters are a-z, A-Z, 0-9 and -
 
268
                if ($part !~ /^[a-zA-Z0-9-]*$/) {
 
269
                        return 0;}
 
270
                # First character can only be a letter or a digit
 
271
                if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 
272
                        return 0;}
 
273
                # Last character can only be a letter or a digit
 
274
                if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
754
275
                        return 0;}
755
276
        }
756
277
        return 1;
757
278
}
758
279
 
759
 
sub validwildcarddomainname($) {
760
 
        my $domainname = shift;
761
 
 
762
 
        # Ignore any leading dots
763
 
        if ($domainname =~ m/^\*\.([^\*]*)\*?/) {
764
 
                $domainname = $1;
765
 
        }
766
 
 
767
 
        return &validdomainname($domainname);
768
 
}
769
 
 
770
280
sub validfqdn
771
281
{
772
 
        # Checks a fully qualified domain name against RFC1035 and RFC2181
 
282
        my $part;
 
283
 
 
284
        # Checks a fully qualified domain name against RFC1035
773
285
        my $fqdn = $_[0];
774
 
        my @parts = split (/\./, $fqdn);        # Split FQDN at the '.'
 
286
        my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
775
287
        if (scalar(@parts) < 2) {               # At least two parts should
776
288
                return 0;}                      # exist in a FQDN
777
 
                                                # (i.e.hostname.domain)
778
 
 
779
 
        for (my $index=0; $index < scalar(@parts); $index++) {
 
289
                                                # (i.e. hostname.domain)
 
290
        foreach $part (@parts) {
780
291
                # Each part should be at least one character in length
781
292
                # but no more than 63 characters
782
 
                if (length ($parts[$index]) < 1 || length ($parts[$index]) > 63) {
783
 
                        return 0;}
784
 
                if ($index eq 0) {              
785
 
                        # This is the hostname part
786
 
                        # Only valid characters are a-z, A-Z, 0-9 and -
787
 
                        if ($parts[$index] !~ /^[a-zA-Z0-9-]*$/) {
788
 
                                return 0;}
789
 
                        # First character can only be a letter or a digit
790
 
                        if (substr ($parts[$index], 0, 1) !~ /^[a-zA-Z0-9]*$/) {
791
 
                                return 0;}
792
 
                        # Last character can only be a letter or a digit
793
 
                        if (substr ($parts[$index], -1, 1) !~ /^[a-zA-Z0-9]*$/) {
794
 
                                return 0;}
795
 
                } else{                         
796
 
                        # This is the domain part
797
 
                        # Only valid characters are a-z, A-Z, 0-9, _ and -
798
 
                        if ($parts[$index] !~ /^[a-zA-Z0-9_-]*$/) {
799
 
                                return 0;}
800
 
                }
 
293
                if (length ($part) < 1 || length ($part) > 63) {
 
294
                        return 0;}
 
295
                # Only valid characters are a-z, A-Z, 0-9 and -
 
296
                if ($part !~ /^[a-zA-Z0-9-]*$/) {
 
297
                        return 0;}
 
298
                # First character can only be a letter or a digit
 
299
                if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 
300
                        return 0;}
 
301
                # Last character can only be a letter or a digit
 
302
                if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 
303
                        return 0;}
801
304
        }
802
305
        return 1;
803
306
}
842
345
        }
843
346
}
844
347
 
845
 
sub IpInSubnet {
846
 
        my $addr = shift;
847
 
        my $network = shift;
848
 
        my $netmask = shift;
849
 
 
850
 
        return &Network::ip_address_in_network($addr, "$network/$netmask");
 
348
# Test if IP is within a subnet
 
349
# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 
350
#       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 
351
#       Everything in dottted notation
 
352
# Return: TRUE/FALSE
 
353
sub IpInSubnet
 
354
{
 
355
    my $ip = unpack('N', &Socket::inet_aton(shift));
 
356
    my $start = unpack('N', &Socket::inet_aton(shift));
 
357
    my $mask  = unpack('N', &Socket::inet_aton(shift));
 
358
       $start &= $mask;  # base of subnet...
 
359
    my $end   = $start + ~$mask;
 
360
    return (($ip >= $start) && ($ip <= $end));
851
361
}
852
362
 
853
363
#
855
365
# Call: NextIP ('1.1.1.1');
856
366
# Return: '1.1.1.2'
857
367
#
858
 
sub NextIP {
859
 
        return &Network::find_next_ip_address(shift, 1);
860
 
}
861
 
 
862
 
sub NextIP2 {
863
 
        return &Network::find_next_ip_address(shift, 4);
864
 
}
865
 
 
866
 
sub ipcidr {
867
 
        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
868
 
        return "$ip\/$cidr";
869
 
}
870
 
 
871
 
sub ipcidr2msk {
872
 
       my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
873
 
       my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
874
 
       return "$ip\/$netmask";
 
368
sub NextIP
 
369
{
 
370
    return &Socket::inet_ntoa( pack("N", 1 +  unpack('N', &Socket::inet_aton(shift))
 
371
                                   )
 
372
                             );
875
373
}
876
374
 
877
375
sub validemail {
878
 
    my $address = shift;
879
 
    my @parts = split( /\@/, $address );
880
 
    my $count=@parts;
881
 
 
882
 
    #check if we have one part before and after '@'
883
 
    return 0 if ( $count != 2 );
884
 
 
885
 
    #check if one of the parts starts or ends with a dot
886
 
    return 0 if ( substr($parts[0],0,1) eq '.' );
887
 
    return 0 if ( substr($parts[0],-1,1) eq '.' );
888
 
    return 0 if ( substr($parts[1],0,1) eq '.' );
889
 
    return 0 if ( substr($parts[1],-1,1) eq '.' );
890
 
 
891
 
    #check first addresspart (before '@' sign)
892
 
    return 0 if  ( $parts[0] !~ m/^[a-zA-Z0-9\.!\-\_\+#]+$/ );
893
 
 
894
 
    #check second addresspart (after '@' sign)
895
 
    return 0 if  ( $parts[1] !~ m/^[a-zA-Z0-9\.\-]+$/ );
896
 
 
 
376
    my $mail = shift;
 
377
    return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 
378
    return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 
379
    return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 
380
    return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 
381
    return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 
382
    return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 
383
    return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
897
384
    return 1;
898
385
}
899
386
 
928
415
    open(FILE, ">$filename") or die "Unable to write to file $filename";
929
416
 
930
417
    foreach $key (keys %$hash) {
931
 
                if ($key =~ /^[0-9]+$/) {
932
 
                        print FILE "$key";
933
 
                        foreach $i (0 .. $#{$hash->{$key}}) {
934
 
                                print FILE ",$hash->{$key}[$i]";
935
 
                        }
936
 
                        print FILE "\n";
937
 
                }
 
418
        if ($key =~ /^[0-9]+$/) {
 
419
            print FILE "$key";
 
420
            foreach $i (0 .. $#{$hash->{$key}}) {
 
421
                print FILE ",$hash->{$key}[$i]";
 
422
            }
 
423
            print FILE "\n";
 
424
        }
938
425
    }
939
426
    close FILE;
940
427
    return;
1036
523
        my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
1037
524
        Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
1038
525
    }
1039
 
    my $user_agent = &MakeUserAgent();
1040
 
    my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
 
526
    my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
1041
527
                                                    80,
1042
528
                                                    "/",
1043
 
                                                    Net::SSLeay::make_headers('User-Agent' => $user_agent )
 
529
                                                    Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
1044
530
                                                );
1045
531
    if ($response =~ m%HTTP/1\.. 200 OK%) {
1046
 
        $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
 
532
        $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
1047
533
        return $1;
1048
534
    }
1049
535
    return '';
1099
585
    close(IP);
1100
586
    chomp $ip;
1101
587
 
1102
 
    # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
1103
588
    if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
1104
589
        &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
1105
 
        &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
1106
 
        &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
 
590
        &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
1107
591
    {
1108
592
        if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
1109
593
            my $RealIP = &General::FetchPublicIp;
1160
644
    'SKIP',
1161
645
    'Photur',                           #40
1162
646
    'Experimental');
1163
 
    if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1164
 
}
1165
 
 
1166
 
sub GetCoreUpdateVersion() {
1167
 
        my $core_update;
1168
 
 
1169
 
        open(FILE, "/opt/pakfire/db/core/mine");
1170
 
        while (<FILE>) {
1171
 
                $core_update = $_;
1172
 
                last;
1173
 
        }
1174
 
        close(FILE);
1175
 
 
1176
 
        return $core_update;
1177
 
}
1178
 
 
1179
 
sub MakeUserAgent() {
1180
 
        my $user_agent = "IPFire/$General::version";
1181
 
 
1182
 
        my $core_update = &GetCoreUpdateVersion();
1183
 
        if ($core_update ne "") {
1184
 
                $user_agent .= "/$core_update";
1185
 
        }
1186
 
 
1187
 
        return $user_agent;
1188
 
}
1189
 
 
1190
 
sub RedIsWireless() {
1191
 
        # This function checks if a network device is a wireless device.
1192
 
 
1193
 
        my %settings = ();
1194
 
        &readhash("${General::swroot}/ethernet/settings", \%settings);
1195
 
 
1196
 
        # Find the name of the network device.
1197
 
        my $device = $settings{'RED_DEV'};
1198
 
 
1199
 
        # Exit, if no device is configured.
1200
 
        return 0 if ($device eq "");
1201
 
 
1202
 
        # Return 1 if the device is a wireless one.
1203
 
        my $path = "/sys/class/net/$device/wireless";
1204
 
        if (-d $path) {
1205
 
                return 1;
1206
 
        }
1207
 
 
1208
 
        # Otherwise return zero.
1209
 
        return 0;
1210
 
}
1211
 
 
1212
 
# Function to read a file with UTF-8 charset.
1213
 
sub read_file_utf8 ($) {
1214
 
        my ($file) = @_;
1215
 
 
1216
 
        open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1217
 
        local $/ = undef;
1218
 
        my $all = <$in>;
1219
 
        close $in;
1220
 
 
1221
 
        return $all;
1222
 
}
1223
 
 
1224
 
# Function to write a file with UTF-8 charset.
1225
 
sub write_file_utf8 ($) {
1226
 
        my ($file, $content) = @_;
1227
 
 
1228
 
        open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;           
1229
 
        print $out $content;
1230
 
        close $out;
1231
 
 
1232
 
        return; 
1233
 
}
1234
 
 
1235
 
my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1236
 
 
1237
 
sub firewall_config_changed() {
1238
 
        open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1239
 
        close FILE;
1240
 
}
1241
 
 
1242
 
sub firewall_needs_reload() {
1243
 
        if (-e "$FIREWALL_RELOAD_INDICATOR") {
1244
 
                return 1;
1245
 
        }
1246
 
 
1247
 
        return 0;
1248
 
}
1249
 
 
1250
 
sub firewall_reload() {
1251
 
        &system("/usr/local/bin/firewallctrl");
1252
 
}
1253
 
 
1254
 
# Function which will return the used interface for the red network zone (red0, ppp0, etc).
1255
 
# if you change this also check speed.cgi that include a local copy for systemload reasons
1256
 
sub get_red_interface() {
1257
 
        my $interface;
1258
 
        my $red_iface_file = "${General::swroot}/red/iface";
1259
 
 
1260
 
        if (-e $red_iface_file) {
1261
 
                open(IFACE, "$red_iface_file") or die "Could not open $red_iface_file";
1262
 
                $interface = <IFACE>;
1263
 
                close(IFACE);
1264
 
                chomp $interface;
1265
 
        }
1266
 
 
1267
 
        return $interface;
1268
 
}
1269
 
 
1270
 
sub number_cpu_cores() {
1271
 
        open my $cpuinfo, "/proc/cpuinfo" or die "Can't open cpuinfo: $!\n";
1272
 
        my $cores = scalar (map /^processor/, <$cpuinfo>);
1273
 
        close $cpuinfo;
1274
 
 
1275
 
        return $cores;
1276
 
}
1277
 
 
1278
 
# Tiny function to grab a single IP-address from a given file.
1279
 
sub grab_address_from_file($) {
1280
 
        my ($file) = @_;
1281
 
 
1282
 
        my $address;
1283
 
 
1284
 
        # Check if the given file exists.
1285
 
        if(-f $file) {
1286
 
                # Open the file for reading.
1287
 
                open(FILE, $file) or die "Could not read from $file. $!\n";
1288
 
 
1289
 
                # Read the address from the file.
1290
 
                $address = <FILE>;
1291
 
 
1292
 
                # Close filehandle.
1293
 
                close(FILE);
1294
 
 
1295
 
                # Remove newlines.
1296
 
                chomp($address);
1297
 
 
1298
 
                # Check if the obtained address is valid.
1299
 
                if (&validip($address)) {
1300
 
                        # Return the address.
1301
 
                        return $address;
1302
 
                }
1303
 
        }
1304
 
 
1305
 
        # Return nothing.
1306
 
        return;
1307
 
}
1308
 
 
1309
 
# Function to get all configured and enabled nameservers.
1310
 
sub get_nameservers () {
1311
 
        my %settings;
1312
 
        my %servers;
1313
 
 
1314
 
        my @nameservers;
1315
 
 
1316
 
        # Read DNS configuration.
1317
 
        &readhash("$General::swroot/dns/settings", \%settings);
1318
 
 
1319
 
        # Read configured DNS servers.
1320
 
        &readhasharray("$General::swroot/dns/servers", \%servers);
1321
 
 
1322
 
        # Check if the ISP assigned server should be used.
1323
 
        if ($settings{'USE_ISP_NAMESERVERS'} eq "on") {
1324
 
                # Assign ISP nameserver files.
1325
 
                my @ISP_nameserver_files = ( "/var/run/dns1", "/var/run/dns2" );
1326
 
 
1327
 
                # Loop through the array of ISP assigned DNS servers.
1328
 
                foreach my $file (@ISP_nameserver_files) {
1329
 
                        # Grab the IP address.
1330
 
                        my $address = &grab_address_from_file($file);
1331
 
 
1332
 
                        # Check if an address has been grabbed.
1333
 
                        if ($address) {
1334
 
                                # Add the address to the array of nameservers.
1335
 
                                push(@nameservers, $address);
1336
 
                        }
1337
 
                }
1338
 
        }
1339
 
 
1340
 
        # Check if DNS servers are configured.
1341
 
        if (%servers) {
1342
 
                # Loop through the hash of configured DNS servers.
1343
 
                foreach my $id (keys %servers) {
1344
 
                        my $address = $servers{$id}[0];
1345
 
                        my $status = $servers{$id}[2];
1346
 
 
1347
 
                        # Check if the current processed server is enabled.
1348
 
                        if ($status eq "enabled") {
1349
 
                                # Add the address to the array of nameservers.
1350
 
                                push(@nameservers, $address);
1351
 
                        }
1352
 
                }
1353
 
        }
1354
 
 
1355
 
        # Return the array.
1356
 
        return &uniq(@nameservers);
1357
 
}
1358
 
 
1359
 
# Function to format a string containing the amount of bytes to
1360
 
# something human-readable. 
1361
 
sub formatBytes {
1362
 
        # Private array which contains the units.
1363
 
        my @units = qw(B KB MB GB TB PB);
1364
 
 
1365
 
        my $bytes = shift;
1366
 
        my $unit;
1367
 
 
1368
 
        # Loop through the array of units.
1369
 
        foreach my $element (@units) {
1370
 
                # Assign current processed element to unit.
1371
 
                $unit = $element;
1372
 
 
1373
 
                # Break loop if the bytes are less than the next unit.
1374
 
                last if $bytes < 1024;
1375
 
 
1376
 
                # Divide bytes amount with 1024.
1377
 
                $bytes /= 1024;
1378
 
        }
1379
 
 
1380
 
        # Return the divided and rounded bytes count and the unit.
1381
 
        return sprintf("%.2f %s", $bytes, $unit);
1382
 
}
1383
 
 
1384
 
# Function to collect and generate a hash for translating protocol numbers into
1385
 
# their names.
1386
 
sub generateProtoTransHash () {
1387
 
        # File which contains the protocol definitions.
1388
 
        my $protocols_file = "/etc/protocols";
1389
 
 
1390
 
        my %protocols = ();
1391
 
 
1392
 
        # Open protocols file.
1393
 
        open(FILE, "$protocols_file") or die "Could not open $protocols_file. $!\n";
1394
 
 
1395
 
        # Loop through the file.
1396
 
        while (my $line = <FILE>) {
1397
 
                # Skip comments.
1398
 
                next if ($line =~ /^\#/);
1399
 
 
1400
 
                # Skip blank  lines.
1401
 
                next if ($line =~ /^\s*$/);
1402
 
 
1403
 
                # Remove any newlines.
1404
 
                chomp($line);
1405
 
 
1406
 
                # Split line content.
1407
 
                my ($protocol_lc, $number, $protocol_uc, $comment) = split(' ', $line);
1408
 
 
1409
 
                # Add proto details to the hash of protocols.
1410
 
                $protocols{$number} = $protocol_uc;
1411
 
        }
1412
 
 
1413
 
        # Close file handle.
1414
 
        close(FILE);
1415
 
 
1416
 
        # Return the hash.
1417
 
        return %protocols;
1418
 
}
1419
 
 
1420
 
# Cloud Stuff
1421
 
 
1422
 
sub running_in_cloud() {
1423
 
        return &running_on_ec2() || &running_on_gcp();
1424
 
}
1425
 
 
1426
 
sub running_on_ec2() {
1427
 
        if (-e "/var/run/aws-instance-id") {
1428
 
                return 1;
1429
 
        }
1430
 
 
1431
 
        return 0;
1432
 
}
1433
 
 
1434
 
sub running_on_gcp() {
1435
 
        if (-e "/var/run/gcp-instance-id") {
1436
 
                return 1;
1437
 
        }
1438
 
 
1439
 
        return 0;
1440
 
}
1441
 
 
 
647
    if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
 
648
}
1442
649
1;