mirror of
https://github.com/vincentmli/bpfire.git
synced 2026-04-11 19:55:52 +02:00
0d909a4a5e
Noch im Teststadium - Clamav ist das Testpaket. Fixes in den neuen Statusseiten und Proxysteuerung. Mkflash-Scripte entfernt. (Frag mich wozu die da ueberhaupt waren...) git-svn-id: http://svn.ipfire.org/svn/ipfire/trunk@511 ea5c0bd1-69bd-2848-81d8-4f18e57aeed8
1081 lines
27 KiB
Perl
1081 lines
27 KiB
Perl
# SmoothWall CGIs
|
|
#
|
|
# This code is distributed under the terms of the GPL
|
|
#
|
|
# (c) The SmoothWall Team
|
|
# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
|
|
# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
|
|
# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
|
|
# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
|
|
# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
|
|
#
|
|
package Header;
|
|
|
|
use CGI();
|
|
use Socket;
|
|
use Time::Local;
|
|
|
|
$|=1; # line buffering
|
|
|
|
$Header::revision = 'final';
|
|
$Header::swroot = '/var/ipfire';
|
|
$Header::graphdir='/srv/web/ipfire/html/graphs';
|
|
$Header::pagecolour = '#ffffff';
|
|
#$Header::tablecolour = '#a0a0a0';
|
|
$Header::tablecolour = '#FFFFFF';
|
|
$Header::bigboxcolour = '#F6F4F4';
|
|
$Header::boxcolour = '#EAE9EE';
|
|
$Header::bordercolour = '#000000';
|
|
$Header::table1colour = '#E0E0E0';
|
|
$Header::table2colour = '#F0F0F0';
|
|
$Header::colourred = '#993333';
|
|
$Header::colourorange = '#FF9933';
|
|
$Header::colouryellow = '#FFFF00';
|
|
$Header::colourgreen = '#339933';
|
|
$Header::colourblue = '#333399';
|
|
$Header::colourovpn = '#339999';
|
|
$Header::colourfw = '#000000';
|
|
$Header::colourvpn = '#990099';
|
|
$Header::colourerr = '#FF0000';
|
|
$Header::viewsize = 150;
|
|
$Header::errormessage = '';
|
|
my %menuhash = ();
|
|
my $menu = \%menuhash;
|
|
%settings = ();
|
|
%ethsettings = ();
|
|
@URI = ();
|
|
|
|
### Make sure this is an SSL request
|
|
if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {
|
|
print "Status: 302 Moved\r\n";
|
|
print "Location: https://$ENV{'SERVER_ADDR'}:444/$ENV{'PATH_INFO'}\r\n\r\n";
|
|
exit 0;
|
|
}
|
|
|
|
### Initialize environment
|
|
&readhash("${swroot}/main/settings", \%settings);
|
|
&readhash("${swroot}/ethernet/settings", \%ethsettings);
|
|
$language = $settings{'LANGUAGE'};
|
|
$hostname = $settings{'HOSTNAME'};
|
|
$hostnameintitle = 0;
|
|
|
|
### Initialize language
|
|
if ($language =~ /^(\w+)$/) {$language = $1;}
|
|
|
|
### Read English Files
|
|
if ( -d "/var/ipfire/langs/en/" ) {
|
|
opendir(DIR, "/var/ipfire/langs/en/");
|
|
@names = readdir(DIR) or die "Cannot Read Directory: $!\n";
|
|
foreach $name(@names) {
|
|
next if ($name eq ".");
|
|
next if ($name eq "..");
|
|
next if (!($name =~ /\.pl$/));
|
|
require "${swroot}/langs/en/${name}";
|
|
};
|
|
};
|
|
|
|
|
|
### Enable Language Files
|
|
if ( -d "/var/ipfire/langs/${language}/" ) {
|
|
opendir(DIR, "/var/ipfire/langs/${language}/");
|
|
@names = readdir(DIR) or die "Cannot Read Directory: $!\n";
|
|
foreach $name(@names) {
|
|
next if ($name eq ".");
|
|
next if ($name eq "..");
|
|
next if (!($name =~ /\.pl$/));
|
|
require "${swroot}/langs/${language}/${name}";
|
|
};
|
|
};
|
|
|
|
### Read IPFire Buildversion
|
|
$FIREBUILD = "File not found: firebuild\n";
|
|
if (open(MYFile, "<${swroot}/firebuild")) {
|
|
$FIREBUILD = <MYFile>;
|
|
chomp($FIREBUILD);
|
|
$FIREBUILD = "(Build: $FIREBUILD)";
|
|
close(MYFile);
|
|
};
|
|
|
|
require "${swroot}/langs/en.pl";
|
|
require "${swroot}/langs/${language}.pl";
|
|
eval `/bin/cat /srv/web/ipfire/html/themes/$settings{'THEME'}/include/functions.pl`;
|
|
|
|
sub orange_used () {
|
|
if ($ethsettings{'CONFIG_TYPE'} =~ /^[1357]$/) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub blue_used () {
|
|
if ($ethsettings{'CONFIG_TYPE'} =~ /^[4567]$/) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub is_modem {
|
|
if ($ethsettings{'CONFIG_TYPE'} =~ /^[0145]$/) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
### Initialize menu
|
|
sub genmenu {
|
|
|
|
my %subsystemhash = ();
|
|
my $subsystem = \%subsystemhash;
|
|
|
|
my %substatushash = ();
|
|
my $substatus = \%substatushash;
|
|
|
|
my %subnetworkhash = ();
|
|
my $subnetwork = \%subnetworkhash;
|
|
|
|
my %subserviceshash = ();
|
|
my $subservices = \%subserviceshash;
|
|
|
|
my %subfirewallhash = ();
|
|
my $subfirewall = \%subfirewallhash;
|
|
|
|
my %subipfirehash = ();
|
|
my $subipfire = \%subipfirehash;
|
|
|
|
my %sublogshash = ();
|
|
my $sublogs = \%sublogshash;
|
|
|
|
eval `/bin/cat /var/ipfire/menu.d/*.menu`;
|
|
eval `/bin/cat /var/ipfire/menu.d/*.main`;
|
|
|
|
if (! blue_used() && ! orange_used()) {
|
|
$menu->{'05.firewall'}{'subMenu'}->{'40.dmz'}{'enabled'} = 0;
|
|
}
|
|
if (! blue_used()) {
|
|
$menu->{'05.firewall'}{'subMenu'}->{'30.wireless'}{'enabled'} = 0;
|
|
}
|
|
if ( $ethsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $ethsettings{'RED_TYPE'} eq 'STATIC' ) {
|
|
$menu->{'03.network'}{'subMenu'}->{'70.aliases'}{'enabled'} = 1;
|
|
}
|
|
}
|
|
|
|
sub showhttpheaders
|
|
{
|
|
print "Pragma: no-cache\n";
|
|
print "Cache-control: no-cache\n";
|
|
print "Connection: close\n";
|
|
print "Content-type: text/html\n\n";
|
|
}
|
|
|
|
sub is_menu_visible($) {
|
|
my $link = shift;
|
|
$link =~ s#\?.*$##;
|
|
return (-e $ENV{'DOCUMENT_ROOT'}."/../$link");
|
|
}
|
|
|
|
|
|
sub getlink($) {
|
|
my $root = shift;
|
|
if (! $root->{'enabled'}) {
|
|
return '';
|
|
}
|
|
if ($root->{'uri'} !~ /^$/) {
|
|
my $vars = '';
|
|
if ($root->{'vars'} !~ /^$/) {
|
|
$vars = '?'. $root->{'vars'};
|
|
}
|
|
if (! is_menu_visible($root->{'uri'})) {
|
|
return '';
|
|
}
|
|
return $root->{'uri'}.$vars;
|
|
}
|
|
my $submenus = $root->{'subMenu'};
|
|
if (! $submenus) {
|
|
return '';
|
|
}
|
|
foreach my $item (sort keys %$submenus) {
|
|
my $link = getlink($submenus->{$item});
|
|
if ($link ne '') {
|
|
return $link;
|
|
}
|
|
}
|
|
return '';
|
|
}
|
|
|
|
|
|
sub compare_url($) {
|
|
my $conf = shift;
|
|
|
|
my $uri = $conf->{'uri'};
|
|
my $vars = $conf->{'vars'};
|
|
my $novars = $conf->{'novars'};
|
|
|
|
if ($uri eq '') {
|
|
return 0;
|
|
}
|
|
if ($uri ne $URI[0]) {
|
|
return 0;
|
|
}
|
|
if ($novars) {
|
|
if ($URI[1] !~ /^$/) {
|
|
return 0;
|
|
}
|
|
}
|
|
if (! $vars) {
|
|
return 1;
|
|
}
|
|
return ($URI[1] eq $vars);
|
|
}
|
|
|
|
|
|
sub gettitle($) {
|
|
my $root = shift;
|
|
|
|
if (! $root) {
|
|
return '';
|
|
}
|
|
foreach my $item (sort keys %$root) {
|
|
my $val = $root->{$item};
|
|
if (compare_url($val)) {
|
|
$val->{'selected'} = 1;
|
|
if ($val->{'title'} !~ /^$/) {
|
|
return $val->{'title'};
|
|
}
|
|
return 'EMPTY TITLE';
|
|
}
|
|
|
|
my $title = gettitle($val->{'subMenu'});
|
|
if ($title ne '') {
|
|
$val->{'selected'} = 1;
|
|
return $title;
|
|
}
|
|
}
|
|
return '';
|
|
}
|
|
|
|
sub writehash
|
|
{
|
|
my $filename = $_[0];
|
|
my $hash = $_[1];
|
|
|
|
# write cgi vars to the file.
|
|
open(FILE, ">${filename}") or die "Unable to write file $filename";
|
|
flock FILE, 2;
|
|
foreach $var (keys %$hash)
|
|
{
|
|
$val = $hash->{$var};
|
|
# Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
|
|
# location of the mouse are submitted as well, this was being written to the settings file causing
|
|
# some serious grief! This skips the variable.x and variable.y
|
|
if (!($var =~ /(.x|.y)$/)) {
|
|
if ($val =~ / /) {
|
|
$val = "\'$val\'"; }
|
|
if (!($var =~ /^ACTION/)) {
|
|
print FILE "${var}=${val}\n"; }
|
|
}
|
|
}
|
|
close FILE;
|
|
}
|
|
|
|
sub readhash
|
|
{
|
|
my $filename = $_[0];
|
|
my $hash = $_[1];
|
|
my ($var, $val);
|
|
|
|
open(FILE, $filename) or die "Unable to read file $filename";
|
|
|
|
while (<FILE>)
|
|
{
|
|
chop;
|
|
($var, $val) = split /=/, $_, 2;
|
|
if ($var)
|
|
{
|
|
$val =~ s/^\'//g;
|
|
$val =~ s/\'$//g;
|
|
|
|
# Untaint variables read from hash
|
|
$var =~ /([A-Za-z0-9_-]*)/; $var = $1;
|
|
$val =~ /([\w\W]*)/; $val = $1;
|
|
$hash->{$var} = $val;
|
|
}
|
|
}
|
|
close FILE;
|
|
}
|
|
|
|
sub getcgihash {
|
|
my ($hash, $params) = @_;
|
|
my $cgi = CGI->new ();
|
|
$hash->{'__CGI__'} = $cgi;
|
|
return if ($ENV{'REQUEST_METHOD'} ne 'POST');
|
|
if (!$params->{'wantfile'}) {
|
|
$CGI::DISABLE_UPLOADS = 1;
|
|
$CGI::POST_MAX = 512 * 1024;
|
|
} else {
|
|
$CGI::POST_MAX = 10 * 1024 * 1024;
|
|
}
|
|
|
|
$cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;
|
|
my $referer = $1;
|
|
$cgi->url() =~ m/^https?\:\/\/([^\/]+)/;
|
|
my $servername = $1;
|
|
return if ($referer ne $servername);
|
|
|
|
### Modified for getting multi-vars, split by |
|
|
%temp = $cgi->Vars();
|
|
foreach my $key (keys %temp) {
|
|
$hash->{$key} = $temp{$key};
|
|
$hash->{$key} =~ s/\0/|/g;
|
|
$hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;
|
|
}
|
|
|
|
if (($params->{'wantfile'})&&($params->{'filevar'})) {
|
|
$hash->{$params->{'filevar'}} = $cgi->upload
|
|
($params->{'filevar'});
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub log
|
|
{
|
|
my $logmessage = $_[0];
|
|
$logmessage =~ /([\w\W]*)/;
|
|
$logmessage = $1;
|
|
system('/usr/bin/logger', '-t', 'ipfire', $logmessage);
|
|
}
|
|
|
|
sub age
|
|
{
|
|
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
|
|
$atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
|
|
my $now = time;
|
|
|
|
my $totalsecs = $now - $mtime;
|
|
my $days = int($totalsecs / 86400);
|
|
my $totalhours = int($totalsecs / 3600);
|
|
my $hours = $totalhours % 24;
|
|
my $totalmins = int($totalsecs / 60);
|
|
my $mins = $totalmins % 60;
|
|
my $secs = $totalsecs % 60;
|
|
|
|
return "${days}d ${hours}h ${mins}m ${secs}s";
|
|
}
|
|
|
|
sub validip
|
|
{
|
|
my $ip = $_[0];
|
|
|
|
if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
|
|
return 0; }
|
|
else
|
|
{
|
|
@octets = ($1, $2, $3, $4);
|
|
foreach $_ (@octets)
|
|
{
|
|
if (/^0./) {
|
|
return 0; }
|
|
if ($_ < 0 || $_ > 255) {
|
|
return 0; }
|
|
}
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
sub validmask
|
|
{
|
|
my $mask = $_[0];
|
|
|
|
# secord part an ip?
|
|
if (&validip($mask)) {
|
|
return 1; }
|
|
# second part a number?
|
|
if (/^0/) {
|
|
return 0; }
|
|
if (!($mask =~ /^\d+$/)) {
|
|
return 0; }
|
|
if ($mask >= 0 && $mask <= 32) {
|
|
return 1; }
|
|
return 0;
|
|
}
|
|
|
|
sub validipormask
|
|
{
|
|
my $ipormask = $_[0];
|
|
|
|
# see if it is a IP only.
|
|
if (&validip($ipormask)) {
|
|
return 1; }
|
|
# split it into number and mask.
|
|
if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
|
|
return 0; }
|
|
$ip = $1;
|
|
$mask = $2;
|
|
# first part not a ip?
|
|
if (!(&validip($ip))) {
|
|
return 0; }
|
|
return &validmask($mask);
|
|
}
|
|
|
|
sub validipandmask
|
|
{
|
|
my $ipandmask = $_[0];
|
|
|
|
# split it into number and mask.
|
|
if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
|
|
return 0; }
|
|
$ip = $1;
|
|
$mask = $2;
|
|
# first part not a ip?
|
|
if (!(&validip($ip))) {
|
|
return 0; }
|
|
return &validmask($mask);
|
|
}
|
|
|
|
sub validport
|
|
{
|
|
$_ = $_[0];
|
|
|
|
if (!/^\d+$/) {
|
|
return 0; }
|
|
if (/^0./) {
|
|
return 0; }
|
|
if ($_ >= 1 && $_ <= 65535) {
|
|
return 1; }
|
|
return 0;
|
|
}
|
|
|
|
sub validmac
|
|
{
|
|
my $checkmac = $_[0];
|
|
my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
|
|
if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
|
|
{
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub validhostname
|
|
{
|
|
# Checks a hostname against RFC1035
|
|
my $hostname = $_[0];
|
|
|
|
# Each part should be at least two characters in length
|
|
# but no more than 63 characters
|
|
if (length ($hostname) < 2 || length ($hostname) > 63) {
|
|
return 0;}
|
|
# Only valid characters are a-z, A-Z, 0-9 and -
|
|
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 0;}
|
|
# Last character can only be a letter or a digit
|
|
if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
|
|
return 0;}
|
|
return 1;
|
|
}
|
|
|
|
sub validdomainname
|
|
{
|
|
# Checks a domain name against RFC1035
|
|
my $domainname = $_[0];
|
|
my @parts = split (/\./, $domainname); # Split hostname at the '.'
|
|
|
|
foreach $part (@parts) {
|
|
# Each part should be at least two characters in length
|
|
# but no more than 63 characters
|
|
if (length ($part) < 2 || 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]*$/) {
|
|
return 0;}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub validfqdn
|
|
{
|
|
# Checks a fully qualified domain name against RFC1035
|
|
my $fqdn = $_[0];
|
|
my @parts = split (/\./, $fqdn); # Split hostname at the '.'
|
|
if (scalar(@parts) < 2) { # At least two parts should
|
|
return 0;} # exist in a FQDN
|
|
# (i.e. hostname.domain)
|
|
foreach $part (@parts) {
|
|
# Each part should be at least two characters in length
|
|
# but no more than 63 characters
|
|
if (length ($part) < 2 || 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]*$/) {
|
|
return 0;}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub validportrange # used to check a port range
|
|
{
|
|
my $port = $_[0]; # port values
|
|
$port =~ tr/-/:/; # replace all - with colons just in case someone used -
|
|
my $srcdst = $_[1]; # is it a source or destination port
|
|
|
|
if (!($port =~ /^(\d+)\:(\d+)$/)) {
|
|
|
|
if (!(&validport($port))) {
|
|
if ($srcdst eq 'src'){
|
|
return $tr{'source port numbers'};
|
|
} else {
|
|
return $tr{'destination port numbers'};
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
@ports = ($1, $2);
|
|
if ($1 >= $2){
|
|
if ($srcdst eq 'src'){
|
|
return $tr{'bad source range'};
|
|
} else {
|
|
return $tr{'bad destination range'};
|
|
}
|
|
}
|
|
foreach $_ (@ports)
|
|
{
|
|
if (!(&validport($_))) {
|
|
if ($srcdst eq 'src'){
|
|
return $tr{'source port numbers'};
|
|
} else {
|
|
return $tr{'destination port numbers'};
|
|
}
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Test if IP is within a subnet
|
|
# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
|
|
# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
|
|
# Everything in dottted notation
|
|
# Return: TRUE/FALSE
|
|
sub IpInSubnet
|
|
{
|
|
$ip = unpack('N', inet_aton(shift));
|
|
$start = unpack('N', inet_aton(shift));
|
|
$mask = unpack('N', inet_aton(shift));
|
|
$start &= $mask; # base of subnet...
|
|
$end = $start + ~$mask;
|
|
return (($ip >= $start) && ($ip <= $end));
|
|
}
|
|
|
|
sub validemail {
|
|
my $mail = shift;
|
|
return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
|
|
return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
|
|
return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
|
|
return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
|
|
return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
|
|
return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
|
|
return 0 if ( $mail !~ /\.([a-zA-Z]{2,3})$/ );
|
|
return 1;
|
|
}
|
|
|
|
sub readhasharray {
|
|
my ($filename, $hash) = @_;
|
|
|
|
open(FILE, $filename) or die "Unable to read file $filename";
|
|
|
|
while (<FILE>) {
|
|
my ($key, $rest, @temp);
|
|
chomp;
|
|
($key, $rest) = split (/,/, $_, 2);
|
|
if ($key =~ /^[0-9]+$/ && $rest) {
|
|
@temp = split (/,/, $rest);
|
|
$hash->{$key} = \@temp;
|
|
}
|
|
}
|
|
close FILE;
|
|
return;
|
|
}
|
|
|
|
sub writehasharray {
|
|
my ($filename, $hash) = @_;
|
|
my ($key, @temp);
|
|
|
|
open(FILE, ">$filename") or die "Unable to write to file $filename";
|
|
|
|
foreach $key (keys %$hash) {
|
|
if ( $hash->{$key} ) {
|
|
print FILE "$key";
|
|
foreach $i (0 .. $#{$hash->{$key}}) {
|
|
print FILE ",$hash->{$key}[$i]";
|
|
}
|
|
}
|
|
print FILE "\n";
|
|
}
|
|
close FILE;
|
|
return;
|
|
}
|
|
|
|
sub findhasharraykey {
|
|
foreach my $i (1 .. 1000000) {
|
|
if ( ! exists $_[0]{$i}) {
|
|
return $i;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub cleanhtml
|
|
{
|
|
my $outstring =$_[0];
|
|
$outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';
|
|
$outstring =~ s/&/&/g;
|
|
$outstring =~ s/\'/'/g;
|
|
$outstring =~ s/\"/"/g;
|
|
$outstring =~ s/</</g;
|
|
$outstring =~ s/>/>/g;
|
|
return $outstring;
|
|
}
|
|
|
|
sub connectionstatus
|
|
{
|
|
my %pppsettings = ();
|
|
my %netsettings = ();
|
|
my $iface='';
|
|
|
|
$pppsettings{'PROFILENAME'} = 'None';
|
|
&General::readhash("${General::swroot}/ppp/settings", \%pppsettings);
|
|
&General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
|
|
|
|
my $profileused='';
|
|
if ( ! ( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {
|
|
$profileused="- $pppsettings{'PROFILENAME'}";
|
|
}
|
|
|
|
if ( ( $pppsettings{'METHOD'} eq 'DHCP' && $netsettings{'RED_TYPE'} ne 'PPTP')
|
|
|| $netsettings{'RED_TYPE'} eq 'DHCP' ) {
|
|
if (open(IFACE, "${General::swroot}/red/iface")) {
|
|
$iface = <IFACE>;
|
|
close IFACE;
|
|
chomp ($iface);
|
|
$iface =~ /([a-zA-Z0-9]*)/; $iface = $1;
|
|
}
|
|
}
|
|
|
|
my ($timestr, $connstate);
|
|
if ($netsettings{'CONFIG_TYPE'} =~ /^(0|1|4|5)$/ && $pppsettings{'TYPE'} =~ /^isdn/) {
|
|
# Count ISDN channels
|
|
my ($idmap, $chmap, $drmap, $usage, $flags, $phone);
|
|
my @phonenumbers;
|
|
my $count=0;
|
|
|
|
open (FILE, "/dev/isdninfo");
|
|
|
|
$idmap = <FILE>; chop $idmap;
|
|
$chmap = <FILE>; chop $chmap;
|
|
$drmap = <FILE>; chop $drmap;
|
|
$usage = <FILE>; chop $usage;
|
|
$flags = <FILE>; chop $flags;
|
|
$phone = <FILE>; chop $phone;
|
|
|
|
$phone =~ s/^phone(\s*):(\s*)//;
|
|
|
|
@phonenumbers = split / /, $phone;
|
|
|
|
foreach (@phonenumbers) {
|
|
if ($_ ne '???') {
|
|
$count++;
|
|
}
|
|
}
|
|
close (FILE);
|
|
|
|
## Connection status
|
|
my $number;
|
|
if ($count == 0) {
|
|
$number = 'none!';
|
|
} elsif ($count == 1) {
|
|
$number = 'single';
|
|
} else {
|
|
$number = 'dual';
|
|
}
|
|
|
|
if (-e "${General::swroot}/red/active") {
|
|
$timestr = &General::age("${General::swroot}/red/active");
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} - $number channel (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
|
|
} else {
|
|
if ($count == 0) {
|
|
if (-e "${General::swroot}/red/dial-on-demand") {
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";
|
|
} else {
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
|
|
}
|
|
} else {
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";
|
|
}
|
|
}
|
|
} elsif ($netsettings{'RED_TYPE'} eq "STATIC" || $pppsettings {'METHOD'} eq 'STATIC') {
|
|
if (-e "${General::swroot}/red/active") {
|
|
$timestr = &General::age("${General::swroot}/red/active");
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
|
|
} else {
|
|
$connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
|
|
}
|
|
} elsif ( ( (-e "${General::swroot}/dhcpc/dhcpcd-$iface.pid") && $netsettings{'RED_TYPE'} ne 'PPTP' ) ||
|
|
!system("/bin/ps -ef | /bin/grep -q '[p]ppd'") || !system("/bin/ps -ef | /bin/grep -q '[c]onnectioncheck'")) {
|
|
if (-e "${General::swroot}/red/active") {
|
|
$timestr = &General::age("${General::swroot}/red/active");
|
|
if ($pppsettings{'TYPE'} =~ /^(modem|bewanadsl|conexantpciadsl|eagleusbadsl)$/) {
|
|
my $speed;
|
|
if ($pppsettings{'TYPE'} eq 'modem') {
|
|
open(CONNECTLOG, "/var/log/connect.log");
|
|
while (<CONNECTLOG>) {
|
|
if (/CONNECT/) {
|
|
$speed = (split / /)[6];
|
|
}
|
|
}
|
|
close (CONNECTLOG);
|
|
} elsif ($pppsettings{'TYPE'} eq 'bewanadsl') {
|
|
$speed = `/usr/bin/unicorn_status | /bin/grep Rate | /usr/bin/cut -f2 -d ':'`;
|
|
} elsif ($pppsettings{'TYPE'} eq 'conexantpciadsl') {
|
|
$speed = `/bin/cat /proc/net/atm/CnxAdsl:* | /bin/grep 'Line Rates' | /bin/sed -e 's+Line Rates: Receive+Rx+' -e 's+Transmit+Tx+'`;
|
|
} elsif ($pppsettings{'TYPE'} eq 'eagleusbadsl') {
|
|
$speed = `/usr/sbin/eaglestat | /bin/grep Rate`;
|
|
}
|
|
$connstate = "$Lang::tr{'connected'} ($timestr) $profileused (\@$speed)";
|
|
} else {
|
|
$connstate = "$Lang::tr{'connected'} ($timestr) $profileused";
|
|
}
|
|
} else {
|
|
if (-e "${General::swroot}/red/dial-on-demand") {
|
|
$connstate = "$Lang::tr{'dod waiting'} $profileused";
|
|
} else {
|
|
$connstate = "$Lang::tr{'connecting'} $profileused";
|
|
}
|
|
}
|
|
} else {
|
|
$connstate = "$Lang::tr{'idle'} $profileused";
|
|
}
|
|
return $connstate;
|
|
}
|
|
|
|
sub srtarray
|
|
# Darren Critchley - darrenc@telus.net - (c) 2003
|
|
# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
|
|
# This subroutine will take the following parameters:
|
|
# ColumnNumber = the column which you want to sort on, starts at 1
|
|
# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
|
|
# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
|
|
# ArrayToBeSorted = the array that wants sorting
|
|
#
|
|
# Returns an array that is sorted to your specs
|
|
#
|
|
# If SortOrder is greater than the elements in array, then it defaults to the first element
|
|
#
|
|
{
|
|
my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
|
|
my @tmparray;
|
|
my @srtedarray;
|
|
my $line;
|
|
my $newline;
|
|
my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
|
|
if ($ttlitems < 1){ # if no items, don't waste our time lets leave
|
|
return (@tobesorted);
|
|
}
|
|
my @tmp = split(/\,/,$tobesorted[0]);
|
|
$ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
|
|
|
|
# Darren Critchley - validate parameters
|
|
if ($colno > $ttlitems){$colno = '1';}
|
|
$colno--; # remove one from colno to deal with arrays starting at 0
|
|
if($colno < 0){$colno = '0';}
|
|
if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
|
|
if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
|
|
|
|
foreach $line (@tobesorted)
|
|
{
|
|
chomp($line);
|
|
if ($line ne '') {
|
|
my @temp = split(/\,/,$line);
|
|
# Darren Critchley - juggle the fields so that the one we want to sort on is first
|
|
my $tmpholder = $temp[0];
|
|
$temp[0] = $temp[$colno];
|
|
$temp[$colno] = $tmpholder;
|
|
$newline = "";
|
|
for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
|
|
$newline=$newline . $temp[$ctr] . ",";
|
|
}
|
|
chop($newline);
|
|
push(@tmparray,$newline);
|
|
}
|
|
}
|
|
if ($alpnum eq 'n') {
|
|
@tmparray = sort {$a <=> $b} @tmparray;
|
|
} else {
|
|
@tmparray = (sort @tmparray);
|
|
}
|
|
foreach $line (@tmparray)
|
|
{
|
|
chomp($line);
|
|
if ($line ne '') {
|
|
my @temp = split(/\,/,$line);
|
|
my $tmpholder = $temp[0];
|
|
$temp[0] = $temp[$colno];
|
|
$temp[$colno] = $tmpholder;
|
|
$newline = "";
|
|
for ($ctr=0; $ctr < $ttlitems ; $ctr++){
|
|
$newline=$newline . $temp[$ctr] . ",";
|
|
}
|
|
chop($newline);
|
|
push(@srtedarray,$newline);
|
|
}
|
|
}
|
|
|
|
if ($srtdir eq 'dsc') {
|
|
@tmparray = reverse(@srtedarray);
|
|
return (@tmparray);
|
|
} else {
|
|
return (@srtedarray);
|
|
}
|
|
}
|
|
|
|
sub speedtouchversion
|
|
{
|
|
if (-f "/proc/bus/usb/devices")
|
|
{
|
|
$speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;
|
|
if ($speedtouch eq '') {
|
|
$speedtouch= $tr{'connect the modem'};
|
|
}
|
|
} else {
|
|
$speedtouch='USB '.$tr{'not running'};
|
|
}
|
|
return $speedtouch
|
|
}
|
|
|
|
sub CheckSortOrder {
|
|
#Sorting of allocated leases
|
|
if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {
|
|
my $newsort=$ENV{'QUERY_STRING'};
|
|
&readhash("${swroot}/dhcp/settings", \%dhcpsettings);
|
|
$act=$dhcpsettings{'SORT_LEASELIST'};
|
|
#Reverse actual ?
|
|
if ($act =~ $newsort) {
|
|
if ($act !~ 'Rev') {$Rev='Rev'};
|
|
$newsort.=$Rev
|
|
};
|
|
|
|
$dhcpsettings{'SORT_LEASELIST'}=$newsort;
|
|
&writehash("${swroot}/dhcp/settings", \%dhcpsettings);
|
|
$dhcpsettings{'ACTION'} = 'SORT'; # avoid the next test "First lauch"
|
|
}
|
|
|
|
}
|
|
|
|
sub PrintActualLeases
|
|
{
|
|
&openbox('100%', 'left', $tr{'current dynamic leases'});
|
|
print <<END
|
|
<table width='100%'>
|
|
<tr>
|
|
<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$tr{'ip address'}</b></a></td>
|
|
<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$tr{'mac address'}</b></a></td>
|
|
<td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$tr{'hostname'}</b></a></td>
|
|
<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$tr{'lease expires'} (local time d/m/y)</b></a></td>
|
|
<td width='5%' align='center'><b>Add to fix leases<b></td>
|
|
</tr>
|
|
END
|
|
;
|
|
|
|
open(LEASES,"/var/state/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";
|
|
while ($line = <LEASES>) {
|
|
next if( $line =~ /^\s*#/ );
|
|
chomp($line);
|
|
@temp = split (' ', $line);
|
|
|
|
if ($line =~ /^\s*lease/) {
|
|
$ip = $temp[1];
|
|
#All field are not necessarily read. Clear everything
|
|
$endtime = 0;
|
|
$ether = "";
|
|
$hostname = "";
|
|
}
|
|
|
|
if ($line =~ /^\s*ends/) {
|
|
$line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;
|
|
$endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);
|
|
}
|
|
|
|
if ($line =~ /^\s*hardware ethernet/) {
|
|
$ether = $temp[2];
|
|
$ether =~ s/;//g;
|
|
}
|
|
|
|
if ($line =~ /^\s*client-hostname/) {
|
|
$hostname = "$temp[1] $temp[2] $temp[3]";
|
|
$hostname =~ s/;//g;
|
|
$hostname =~ s/\"//g;
|
|
}
|
|
|
|
if ($line eq "}") {
|
|
@record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);
|
|
$record = {}; # create a reference to empty hash
|
|
%{$record} = @record; # populate that hash with @record
|
|
$entries{$record->{'IPADDR'}} = $record; # add this to a hash of hashes
|
|
}
|
|
}
|
|
close(LEASES);
|
|
|
|
my $id = 0;
|
|
foreach my $key (sort leasesort keys %entries) {
|
|
print "<form method='post' action='/cgi-bin/dhcp.cgi'>\n";
|
|
my $hostname = &cleanhtml($entries{$key}->{HOSTNAME},"y");
|
|
|
|
if ($id % 2) {
|
|
print "<tr bgcolor='$table1colour'>";
|
|
}
|
|
else {
|
|
print "<tr bgcolor='$table2colour'>";
|
|
}
|
|
|
|
print <<END
|
|
<td align='center'><input type='hidden' name='FIX_ADDR' value='$entries{$key}->{IPADDR}' />$entries{$key}->{IPADDR}</td>
|
|
<td align='center'><input type='hidden' name='FIX_MAC' value='$entries{$key}->{ETHER}' />$entries{$key}->{ETHER}</td>
|
|
<td align='center'><input type='hidden' name='FIX_REMARK' value='$hostname' /> $hostname</td>
|
|
<td align='center'><input type='hidden' name='FIX_ENABLED' value='on' />
|
|
END
|
|
;
|
|
|
|
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});
|
|
$enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);
|
|
|
|
if ($entries{$key}->{ENDTIME} < time() ){
|
|
print "<strike>$enddate</strike>";
|
|
} else {
|
|
print "$enddate";
|
|
}
|
|
print <<END
|
|
<td><input type='hidden' name='ACTION' value='$Lang::tr{'add'}2' /><input type='submit' name='SUBMIT' value='$Lang::tr{'add'}' />
|
|
</td></td></tr></form>
|
|
END
|
|
;
|
|
$id++;
|
|
}
|
|
|
|
print "</table>";
|
|
&closebox();
|
|
}
|
|
|
|
|
|
# This sub is used during display of actives leases
|
|
sub leasesort {
|
|
if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)
|
|
{
|
|
$qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);
|
|
if ($qs eq 'IPADDR') {
|
|
@a = split(/\./,$entries{$a}->{$qs});
|
|
@b = split(/\./,$entries{$b}->{$qs});
|
|
($b[0]<=>$a[0]) ||
|
|
($b[1]<=>$a[1]) ||
|
|
($b[2]<=>$a[2]) ||
|
|
($b[3]<=>$a[3]);
|
|
}else {
|
|
$entries{$b}->{$qs} cmp $entries{$a}->{$qs};
|
|
}
|
|
}
|
|
else #not reverse
|
|
{
|
|
$qs=$dhcpsettings{'SORT_LEASELIST'};
|
|
if ($qs eq 'IPADDR') {
|
|
@a = split(/\./,$entries{$a}->{$qs});
|
|
@b = split(/\./,$entries{$b}->{$qs});
|
|
($a[0]<=>$b[0]) ||
|
|
($a[1]<=>$b[1]) ||
|
|
($a[2]<=>$b[2]) ||
|
|
($a[3]<=>$b[3]);
|
|
}else {
|
|
$entries{$a}->{$qs} cmp $entries{$b}->{$qs};
|
|
}
|
|
}
|
|
}
|
|
|
|
sub get_uplinks() {
|
|
my @uplinks = ();
|
|
opendir(DIR, "${swroot}/uplinks/") || return \@uplinks;
|
|
foreach my $dir (readdir(DIR)) {
|
|
next if ($dir =~ /^\./);
|
|
next if (-f "${swroot}/uplinks/$dir");
|
|
push(@uplinks, $dir);
|
|
}
|
|
closedir(DIR);
|
|
return \@uplinks;
|
|
}
|
|
|
|
sub get_iface($) {
|
|
my $filename = shift;
|
|
chomp($filename);
|
|
open (F, $filename) || return "";
|
|
my $iface = <F>;
|
|
close(F);
|
|
chomp($iface);
|
|
return $iface;
|
|
}
|
|
|
|
sub get_red_ifaces_by_type($) {
|
|
my $type=shift;
|
|
my @gottypeiface = ();
|
|
my @gottypeuplink = ();
|
|
my @gottype = ();
|
|
|
|
my $ref=get_uplinks();
|
|
my @uplinks=@$ref;
|
|
my %set = ();
|
|
foreach my $link (@uplinks) {
|
|
eval {
|
|
&readhash("${swroot}/uplinks/$link/settings", \%set);
|
|
};
|
|
push(@gottype, $link);
|
|
|
|
my $iface = $set{'RED_DEV'};
|
|
if (!$iface) {
|
|
$iface = get_iface("${swroot}/uplinks/$link/interface");
|
|
}
|
|
next if (!$iface);
|
|
|
|
if ($set{'RED_TYPE'} eq $type) {
|
|
push(@gottypeiface, $iface);
|
|
push(@gottypeuplink, $link);
|
|
}
|
|
}
|
|
return (\@gottypeiface, \@gottypeuplink, \@gottype);
|
|
}
|
|
|
|
sub get_red_ifaces() {
|
|
return `cat ${swroot}/uplinks/*/interface 2>/dev/null`;
|
|
}
|
|
|
|
sub get_zone_devices($) {
|
|
my $bridge = shift;
|
|
my @ifaces = ();
|
|
open (FILE, "${swroot}/ethernet/$bridge") || return "";
|
|
foreach my $line (<FILE>) {
|
|
chomp($line);
|
|
next if (!$line);
|
|
push(@ifaces, $line);
|
|
}
|
|
close(FILE);
|
|
return \@ifaces;
|
|
}
|