use strict;
use Socket;
use IO::Socket;
-use Locale::Codes::Country;
use Net::SSLeay;
use Net::IPv4Addr qw(:all);
$|=1; # line buffering
$General::version = 'VERSION';
$General::swroot = 'CONFIG_ROOT';
$General::noipprefix = 'noipg-';
-$General::adminmanualurl = 'http://wiki.ipfire.org';
require "${General::swroot}/network-functions.pl";
+# This function executes a shell command without forking a shell or do any other
+# Perl-voodoo before it. It deprecates the "system" command and is the only way
+# to call shell commands.
+sub safe_system($) {
+ my @command = @_;
+
+ system { ${command[0]} } @command;
+
+ # Return exit code
+ return $? >> 8;
+}
+
+# Calls a process in the background and returns nothing
+sub system_background($) {
+ my $pid = fork();
+
+ unless ($pid) {
+ my $rc = &system(@_);
+ exit($rc);
+ }
+
+ return 0;
+}
+
+# Returns the output of a shell command
+sub system_output($) {
+ my @command = @_;
+ my $pid;
+ my @output = ();
+
+ unless ($pid = open(OUTPUT, "-|")) {
+ open(STDERR, ">&STDOUT");
+ exec { ${command[0]} } @command;
+ die "Could not execute @command: $!";
+ }
+
+ waitpid($pid, 0);
+
+ while (<OUTPUT>) {
+ push(@output, $_);
+ }
+ close(OUTPUT);
+
+ return @output;
+}
+
+# Calls a shell command and throws away the output
+sub system($) {
+ my @command = @_;
+
+ open(SAVEOUT, ">&STDOUT");
+ open(SAVEERR, ">&STDERR");
+
+ open(STDOUT, ">/dev/null");
+ open(STDERR, ">&STDOUT");
+
+ select(STDERR); $|=1;
+ select(STDOUT); $|=1;
+
+ my $rc = &safe_system(@command);
+
+ close(STDOUT);
+ close(STDERR);
+
+ # Restore
+ open(STDOUT, ">&SAVEOUT");
+ open(STDERR, ">&SAVEERR");
+
+ return $rc;
+}
+
# Function to remove duplicates from an array
sub uniq { my %seen; grep !$seen{$_}++, @_ }
my $logmessage = $_[0];
$logmessage =~ /([\w\W]*)/;
$logmessage = $1;
- system('logger', '-t', $tag, $logmessage);
+ &system('logger', '-t', $tag, $logmessage);
}
sub setup_default_networks
{
if($ownnet ne 'ipsec'){
&General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
foreach my $key (keys %ipsecconf){
- if ($ipsecconf{$key}[11] ne ''){
+ if ($ipsecconf{$key}[11] ne '' && $ipsecconf{$key}[36] eq ""){
foreach my $ipsecsubitem (split(/\|/, $ipsecconf{$key}[11])) {
- my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
+ my ($ipsecip,$ipsecsub) = split (/\//, $ipsecsubitem);
$ipsecsub=&iporsubtodec($ipsecsub);
if($ipsecconf{$key}[1] ne $ccdname){
if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
# Checks a hostname against RFC1035
my $hostname = $_[0];
- # Each part should be at least two characters in length
+ # Hostname should be at least one character in length
# but no more than 63 characters
if (length ($hostname) < 1 || length ($hostname) > 63) {
return 0;}
# Only valid characters are a-z, A-Z, 0-9 and -
- if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
+ if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
return 0;}
# First character can only be a letter or a digit
if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
return 1;
}
+sub validccdname
+{
+ # Checks a ccdname for letters, numbers and spaces
+ my $ccdname = $_[0];
+
+ # ccdname should be at least one character in length
+ # but no more than 63 characters
+ if (length ($ccdname) < 1 || length ($ccdname) > 63) {
+ return 0;}
+ # Only valid characters are a-z, A-Z, 0-9, space and -
+ if ($ccdname !~ /^[a-zA-Z0-9 -]*$/) {
+ return 0;}
+ return 1;
+}
+
sub validdomainname
{
my $part;
- # Checks a domain name against RFC1035
+ # Checks a domain name against RFC1035 and RFC2181
my $domainname = $_[0];
- my @parts = split (/\./, $domainname); # Split hostname at the '.'
+ my @parts = split (/\./, $domainname); # Split domain name at the '.'
foreach $part (@parts) {
- # Each part should be no more than 63 characters in length
+ # Each part should be at least one character in length
+ # but no more than 63 characters
if (length ($part) < 1 || length ($part) > 63) {
return 0;}
# Only valid characters are a-z, A-Z, 0-9, _ and -
if ($part !~ /^[a-zA-Z0-9_-]*$/) {
- return 0;
- }
+ return 0;}
}
return 1;
}
+sub validwildcarddomainname($) {
+ my $domainname = shift;
+
+ # Ignore any leading dots
+ if ($domainname =~ m/^\*\.([^\*]*)\*?/) {
+ $domainname = $1;
+ }
+
+ return &validdomainname($domainname);
+}
+
sub validfqdn
{
- my $part;
-
- # Checks a fully qualified domain name against RFC1035
+ # Checks a fully qualified domain name against RFC1035 and RFC2181
my $fqdn = $_[0];
- my @parts = split (/\./, $fqdn); # Split hostname at the '.'
+ my @parts = split (/\./, $fqdn); # Split FQDN at the '.'
if (scalar(@parts) < 2) { # At least two parts should
return 0;} # exist in a FQDN
# (i.e.hostname.domain)
- foreach $part (@parts) {
+
+ for (my $index=0; $index < scalar(@parts); $index++) {
# Each part should be at least one character in length
# but no more than 63 characters
- if (length ($part) < 1 || length ($part) > 63) {
- return 0;}
- # Only valid characters are a-z, A-Z, 0-9 and -
- if ($part !~ /^[a-zA-Z0-9-]*$/) {
- return 0;}
- # First character can only be a letter or a digit
- if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
- return 0;}
- # Last character can only be a letter or a digit
- if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+ if (length ($parts[$index]) < 1 || length ($parts[$index]) > 63) {
return 0;}
+ if ($index eq 0) {
+ # This is the hostname part
+ # Only valid characters are a-z, A-Z, 0-9 and -
+ if ($parts[$index] !~ /^[a-zA-Z0-9-]*$/) {
+ return 0;}
+ # First character can only be a letter or a digit
+ if (substr ($parts[$index], 0, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ # Last character can only be a letter or a digit
+ if (substr ($parts[$index], -1, 1) !~ /^[a-zA-Z0-9]*$/) {
+ return 0;}
+ } else{
+ # This is the domain part
+ # Only valid characters are a-z, A-Z, 0-9, _ and -
+ if ($parts[$index] !~ /^[a-zA-Z0-9_-]*$/) {
+ return 0;}
+ }
}
return 1;
}
}
sub firewall_reload() {
- system("/usr/local/bin/firewallctrl");
+ &system("/usr/local/bin/firewallctrl");
}
# Function which will return the used interface for the red network zone (red0, ppp0, etc).
+# if you change this also check speed.cgi that include a local copy for systemload reasons
sub get_red_interface() {
-
- open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
-
- my $interface = <IFACE>;
- close(IFACE);
- chomp $interface;
+ my $interface;
+ my $red_iface_file = "${General::swroot}/red/iface";
+
+ if (-e $red_iface_file) {
+ open(IFACE, "$red_iface_file") or die "Could not open $red_iface_file";
+ $interface = <IFACE>;
+ close(IFACE);
+ chomp $interface;
+ }
return $interface;
}
-sub dnssec_status() {
- my $path = "${General::swroot}/red/dnssec-status";
-
- open(STATUS, $path) or return 0;
- my $status = <STATUS>;
- close(STATUS);
-
- chomp($status);
-
- return $status;
-}
sub number_cpu_cores() {
open my $cpuinfo, "/proc/cpuinfo" or die "Can't open cpuinfo: $!\n";
my $cores = scalar (map /^processor/, <$cpuinfo>);
return sprintf("%.2f %s", $bytes, $unit);
}
+# Function to collect and generate a hash for translating protocol numbers into
+# their names.
+sub generateProtoTransHash () {
+ # File which contains the protocol definitions.
+ my $protocols_file = "/etc/protocols";
+
+ my %protocols = ();
+
+ # Open protocols file.
+ open(FILE, "$protocols_file") or die "Could not open $protocols_file. $!\n";
+
+ # Loop through the file.
+ while (my $line = <FILE>) {
+ # Skip comments.
+ next if ($line =~ /^\#/);
+
+ # Skip blank lines.
+ next if ($line =~ /^\s*$/);
+
+ # Remove any newlines.
+ chomp($line);
+
+ # Split line content.
+ my ($protocol_lc, $number, $protocol_uc, $comment) = split(' ', $line);
+
+ # Add proto details to the hash of protocols.
+ $protocols{$number} = $protocol_uc;
+ }
+
+ # Close file handle.
+ close(FILE);
+
+ # Return the hash.
+ return %protocols;
+}
+
+# Cloud Stuff
+
+sub running_in_cloud() {
+ return &running_on_ec2() || &running_on_gcp();
+}
+
+sub running_on_ec2() {
+ if (-e "/var/run/aws-instance-id") {
+ return 1;
+ }
+
+ return 0;
+}
+
+sub running_on_gcp() {
+ if (-e "/var/run/gcp-instance-id") {
+ return 1;
+ }
+
+ return 0;
+}
+
1;
projects / people / pmueller / ipfire-2.x.git / blobdiff