You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
629 lines
18 KiB
629 lines
18 KiB
5 years ago
|
#============================================================= -*-perl-*-
|
||
|
#
|
||
|
# BackupPC::CGI::Lib package
|
||
|
#
|
||
|
# DESCRIPTION
|
||
|
#
|
||
|
# This library defines a BackupPC::Lib class and a variety of utility
|
||
|
# functions used by BackupPC.
|
||
|
#
|
||
|
# AUTHOR
|
||
|
# Craig Barratt <cbarratt@users.sourceforge.net>
|
||
|
#
|
||
|
# COPYRIGHT
|
||
|
# Copyright (C) 2003-2019 Craig Barratt
|
||
|
#
|
||
|
# This program is free software: you can redistribute it and/or modify
|
||
|
# it under the terms of the GNU General Public License as published by
|
||
|
# the Free Software Foundation, either version 3 of the License, or
|
||
|
# (at your option) any later version.
|
||
|
#
|
||
|
# This program is distributed in the hope that it will be useful,
|
||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
# GNU General Public License for more details.
|
||
|
#
|
||
|
# You should have received a copy of the GNU General Public License
|
||
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
#
|
||
|
#========================================================================
|
||
|
#
|
||
|
# Version 4.3.1, released 14 Jul 2019.
|
||
|
#
|
||
|
# See http://backuppc.sourceforge.net.
|
||
|
#
|
||
|
#========================================================================
|
||
|
|
||
|
package BackupPC::CGI::Lib;
|
||
|
|
||
|
use strict;
|
||
|
use BackupPC::Lib;
|
||
|
|
||
|
require Exporter;
|
||
|
|
||
|
use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
|
||
|
|
||
|
use vars qw($Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc);
|
||
|
use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
|
||
|
%QueueLen %StatusHost);
|
||
|
use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin);
|
||
|
use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq);
|
||
|
use vars qw($Lang);
|
||
|
|
||
|
@ISA = qw(Exporter);
|
||
|
|
||
|
@EXPORT = qw( );
|
||
|
|
||
|
@EXPORT_OK = qw(
|
||
|
timeStamp2
|
||
|
HostLink
|
||
|
UserLink
|
||
|
EscHTML
|
||
|
EscURI
|
||
|
ErrorExit
|
||
|
ServerConnect
|
||
|
GetStatusInfo
|
||
|
ReadUserEmailInfo
|
||
|
CheckPermission
|
||
|
GetUserHosts
|
||
|
ConfirmIPAddress
|
||
|
Header
|
||
|
Trailer
|
||
|
NavSectionTitle
|
||
|
NavSectionStart
|
||
|
NavSectionEnd
|
||
|
NavLink
|
||
|
h1
|
||
|
h2
|
||
|
$Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc
|
||
|
%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
|
||
|
%QueueLen %StatusHost
|
||
|
$Hosts $HostsMTime $ConfigMTime $PrivAdmin
|
||
|
%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq
|
||
|
$Lang
|
||
|
);
|
||
|
|
||
|
%EXPORT_TAGS = (
|
||
|
'all' => [ @EXPORT_OK ],
|
||
|
);
|
||
|
|
||
|
sub NewRequest
|
||
|
{
|
||
|
$Cgi = new CGI;
|
||
|
%In = $Cgi->Vars;
|
||
|
|
||
|
if ( !defined($bpc) ) {
|
||
|
ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log})
|
||
|
if ( !($bpc = BackupPC::Lib->new(undef, undef, undef, 1)) );
|
||
|
$TopDir = $bpc->TopDir();
|
||
|
$LogDir = $bpc->LogDir();
|
||
|
$BinDir = $bpc->BinDir();
|
||
|
%Conf = $bpc->Conf();
|
||
|
$Lang = $bpc->Lang();
|
||
|
$ConfigMTime = $bpc->ConfigMTime();
|
||
|
umask($Conf{UmaskMode});
|
||
|
} elsif ( $bpc->ConfigMTime() != $ConfigMTime ) {
|
||
|
$bpc->ConfigRead();
|
||
|
$TopDir = $bpc->TopDir();
|
||
|
$LogDir = $bpc->LogDir();
|
||
|
$BinDir = $bpc->BinDir();
|
||
|
%Conf = $bpc->Conf();
|
||
|
$Lang = $bpc->Lang();
|
||
|
$ConfigMTime = $bpc->ConfigMTime();
|
||
|
umask($Conf{UmaskMode});
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Default REMOTE_USER so in a miminal installation the user
|
||
|
# has a sensible default.
|
||
|
#
|
||
|
$ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );
|
||
|
|
||
|
#
|
||
|
# We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
|
||
|
# The latter requires .ht_access style authentication. Replace this
|
||
|
# code if you are using some other type of authentication, and have
|
||
|
# a different way of getting the user name.
|
||
|
#
|
||
|
$MyURL = $ENV{SCRIPT_NAME};
|
||
|
$User = $ENV{REMOTE_USER};
|
||
|
|
||
|
#
|
||
|
# Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint
|
||
|
#
|
||
|
$User = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ );
|
||
|
|
||
|
#
|
||
|
# Clean up %ENV for taint checking
|
||
|
#
|
||
|
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||
|
$ENV{PATH} = $Conf{MyPath};
|
||
|
|
||
|
#
|
||
|
# Verify we are running as the correct user
|
||
|
#
|
||
|
if ( $Conf{BackupPCUserVerify}
|
||
|
&& $> != (my $uid = getpwnam($Conf{BackupPCUser})) ) {
|
||
|
ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF);
|
||
|
This script needs to run as the user specified in \$Conf{BackupPCUser},
|
||
|
which is set to $Conf{BackupPCUser}.
|
||
|
<p>
|
||
|
This is an installation problem. If you are using mod_perl then
|
||
|
it appears that Apache is not running as user $Conf{BackupPCUser}.
|
||
|
If you are not using mod_perl, then most like setuid is not working
|
||
|
properly on BackupPC_Admin. Check the permissions on
|
||
|
$Conf{CgiDir}/BackupPC_Admin and look at the documentation.
|
||
|
EOF
|
||
|
}
|
||
|
|
||
|
if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
|
||
|
$HostsMTime = $bpc->HostsMTime();
|
||
|
$Hosts = $bpc->HostInfoRead();
|
||
|
|
||
|
# turn moreUsers list into a hash for quick lookups
|
||
|
foreach my $host (keys %$Hosts) {
|
||
|
$Hosts->{$host}{moreUsers} =
|
||
|
{map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) }
|
||
|
}
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Untaint the host name
|
||
|
#
|
||
|
if ( $In{host} =~ /^([\w.\s-]+)$/ ) {
|
||
|
$In{host} = $1;
|
||
|
} else {
|
||
|
delete($In{host});
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub timeStamp2
|
||
|
{
|
||
|
my $now = $_[0] == 0 ? time : $_[0];
|
||
|
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
|
||
|
= localtime($now);
|
||
|
$mon++;
|
||
|
if ( $Conf{CgiDateFormatMMDD} == 2 ) {
|
||
|
$year += 1900;
|
||
|
return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $min);
|
||
|
} elsif ( $Conf{CgiDateFormatMMDD} ) {
|
||
|
#
|
||
|
# Add the year if the time is more than 330 days ago
|
||
|
#
|
||
|
if ( time - $now > 330 * 24 * 3600 ) {
|
||
|
$year -= 100;
|
||
|
return sprintf("$mon/$mday/%02d %02d:%02d", $year, $hour, $min);
|
||
|
} else {
|
||
|
return sprintf("$mon/$mday %02d:%02d", $hour, $min);
|
||
|
}
|
||
|
} else {
|
||
|
#
|
||
|
# Add the year if the time is more than 330 days ago
|
||
|
#
|
||
|
if ( time - $now > 330 * 24 * 3600 ) {
|
||
|
$year -= 100;
|
||
|
return sprintf("$mday/$mon/%02d %02d:%02d", $year, $hour, $min);
|
||
|
} else {
|
||
|
return sprintf("$mday/$mon %02d:%02d", $hour, $min);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub HostLink
|
||
|
{
|
||
|
my($host) = @_;
|
||
|
my($s);
|
||
|
if ( defined($Hosts->{$host}) ) {
|
||
|
$s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
|
||
|
} else {
|
||
|
$s = $host;
|
||
|
}
|
||
|
return \$s;
|
||
|
}
|
||
|
|
||
|
sub UserLink
|
||
|
{
|
||
|
my($user) = @_;
|
||
|
my($s);
|
||
|
|
||
|
return \$user if ( $user eq ""
|
||
|
|| $Conf{CgiUserUrlCreate} eq "" );
|
||
|
if ( $Conf{CgiUserHomePageCheck} eq ""
|
||
|
|| -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
|
||
|
$s = "<a href=\""
|
||
|
. sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
|
||
|
. "\">$user</a>";
|
||
|
} else {
|
||
|
$s = $user;
|
||
|
}
|
||
|
return \$s;
|
||
|
}
|
||
|
|
||
|
sub EscHTML
|
||
|
{
|
||
|
my($s) = @_;
|
||
|
$s =~ s/&/&/g;
|
||
|
$s =~ s/\"/"/g;
|
||
|
$s =~ s/>/>/g;
|
||
|
$s =~ s/</</g;
|
||
|
### $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
|
||
|
return \$s;
|
||
|
}
|
||
|
|
||
|
sub EscURI
|
||
|
{
|
||
|
my($s) = @_;
|
||
|
$s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
|
||
|
return \$s;
|
||
|
}
|
||
|
|
||
|
sub ErrorExit
|
||
|
{
|
||
|
my(@mesg) = @_;
|
||
|
my($head) = shift(@mesg);
|
||
|
my($mesg) = join("</p>\n<p>", @mesg);
|
||
|
|
||
|
if ( !defined($ENV{REMOTE_USER}) ) {
|
||
|
$mesg .= <<EOF;
|
||
|
<p>
|
||
|
Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
|
||
|
installation problem. BackupPC_Admin expects Apache to authenticate
|
||
|
the user and pass their user name into this script as the REMOTE_USER
|
||
|
environment variable. See the documentation.
|
||
|
EOF
|
||
|
}
|
||
|
|
||
|
$bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
|
||
|
if ( defined($bpc) );
|
||
|
if ( !defined($Lang->{Error}) ) {
|
||
|
$mesg = <<EOF if ( !defined($mesg) );
|
||
|
There is some problem with the BackupPC installation.
|
||
|
Please check the permissions on BackupPC_Admin.
|
||
|
EOF
|
||
|
my $content = <<EOF;
|
||
|
${h1("Error: Unable to read config.pl or language strings!!")}
|
||
|
<p>$mesg</p>
|
||
|
EOF
|
||
|
Header("BackupPC: Error", $content);
|
||
|
Trailer();
|
||
|
} else {
|
||
|
my $content = eval("qq{$Lang->{Error____head}}");
|
||
|
Header(eval("qq{$Lang->{Error}}"), $content);
|
||
|
Trailer();
|
||
|
}
|
||
|
exit(1);
|
||
|
}
|
||
|
|
||
|
sub ServerConnect
|
||
|
{
|
||
|
#
|
||
|
# Verify that the server connection is ok
|
||
|
#
|
||
|
return if ( $bpc->ServerOK() );
|
||
|
$bpc->ServerDisconnect();
|
||
|
if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
|
||
|
if ( CheckPermission()
|
||
|
&& -f $Conf{ServerInitdPath}
|
||
|
&& $Conf{ServerInitdStartCmd} ne "" ) {
|
||
|
my $content = eval("qq{$Lang->{Admin_Start_Server}}");
|
||
|
Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content);
|
||
|
Trailer();
|
||
|
exit(1);
|
||
|
} else {
|
||
|
ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"),
|
||
|
eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_error_message}}"));
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub GetStatusInfo
|
||
|
{
|
||
|
my($status) = @_;
|
||
|
ServerConnect();
|
||
|
%Status = () if ( $status =~ /\bhosts\b/ );
|
||
|
%StatusHost = () if ( $status =~ /\bhost\(/ );
|
||
|
my $reply = $bpc->ServerMesg("status $status");
|
||
|
$reply = $1 if ( $reply =~ /(.*)/s );
|
||
|
eval($reply);
|
||
|
# ignore status related to admin jobs
|
||
|
if ( $status =~ /\bhosts\b/ ) {
|
||
|
foreach my $host ( grep(/admin/, keys(%Status)) ) {
|
||
|
delete($Status{$host}) if ( $bpc->isAdminJob($host) );
|
||
|
}
|
||
|
delete($Status{$bpc->scgiJob});
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub ReadUserEmailInfo
|
||
|
{
|
||
|
if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
|
||
|
do "$LogDir/UserEmailInfo.pl";
|
||
|
$UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9];
|
||
|
}
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Check if the user is privileged. A privileged user can access
|
||
|
# any information (backup files, logs, status pages etc).
|
||
|
#
|
||
|
# A user is privileged if they belong to the group
|
||
|
# $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
|
||
|
# or they are the user assigned to a host in the host file.
|
||
|
#
|
||
|
sub CheckPermission
|
||
|
{
|
||
|
my($host) = @_;
|
||
|
my $Privileged = 0;
|
||
|
|
||
|
return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
|
||
|
|| $host ne "" && !defined($Hosts->{$host}) );
|
||
|
if ( $Conf{CgiAdminUserGroup} ne "" ) {
|
||
|
for ( split(/\s+/, $Conf{CgiAdminUserGroup}) ) {
|
||
|
my ($n, $p, $gid, $mem) = getgrnam($_);
|
||
|
$Privileged ||= ( $mem =~ /\b\Q$User\E\b/ );
|
||
|
last if ( $Privileged );
|
||
|
}
|
||
|
}
|
||
|
if ( $Conf{CgiAdminUsers} ne "" ) {
|
||
|
$Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/);
|
||
|
$Privileged ||= $Conf{CgiAdminUsers} eq "*";
|
||
|
}
|
||
|
$PrivAdmin = $Privileged;
|
||
|
return $Privileged if ( !defined($host) );
|
||
|
|
||
|
$Privileged ||= $User eq $Hosts->{$host}{user};
|
||
|
$Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
|
||
|
return $Privileged;
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Returns the list of hosts that should appear in the navigation bar
|
||
|
# for this user. If $getAll is set, the admin gets all the hosts.
|
||
|
# Otherwise, regular users get hosts for which they are the user or
|
||
|
# are listed in the moreUsers column in the hosts file.
|
||
|
#
|
||
|
sub GetUserHosts
|
||
|
{
|
||
|
my($getAll) = @_;
|
||
|
my @hosts;
|
||
|
|
||
|
if ( $getAll && CheckPermission() ) {
|
||
|
@hosts = sort keys %$Hosts;
|
||
|
} else {
|
||
|
@hosts = sort grep { $Hosts->{$_}{user} eq $User ||
|
||
|
defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
|
||
|
}
|
||
|
return @hosts;
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Given a host name tries to find the IP address. For non-dhcp hosts
|
||
|
# we just return the host name. For dhcp hosts we check the address
|
||
|
# the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
|
||
|
# address for $host. (Later we should replace this with a broadcast
|
||
|
# nmblookup.)
|
||
|
#
|
||
|
sub ConfirmIPAddress
|
||
|
{
|
||
|
my($host) = @_;
|
||
|
my $ipAddr = $host;
|
||
|
|
||
|
if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
|
||
|
&& $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
|
||
|
$ipAddr = $1;
|
||
|
my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
|
||
|
if ( $netBiosHost ne $host ) {
|
||
|
my($tryIP);
|
||
|
GetStatusInfo("host(${EscURI($host)})");
|
||
|
if ( defined($StatusHost{dhcpHostIP})
|
||
|
&& $StatusHost{dhcpHostIP} ne $ipAddr ) {
|
||
|
$tryIP = eval("qq{$Lang->{tryIP}}");
|
||
|
($netBiosHost, $netBiosUser)
|
||
|
= $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
|
||
|
}
|
||
|
if ( $netBiosHost ne $host ) {
|
||
|
ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
|
||
|
eval("qq{$Lang->{host_is_a_DHCP_host}}"));
|
||
|
}
|
||
|
$ipAddr = $StatusHost{dhcpHostIP};
|
||
|
}
|
||
|
}
|
||
|
return $ipAddr;
|
||
|
}
|
||
|
|
||
|
###########################################################################
|
||
|
# HTML layout subroutines
|
||
|
###########################################################################
|
||
|
|
||
|
sub Header
|
||
|
{
|
||
|
my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
|
||
|
my @adminLinks = (
|
||
|
{ link => "?action=status", name => $Lang->{Status}},
|
||
|
{ link => "?action=summary", name => $Lang->{PC_Summary}},
|
||
|
{ link => "?action=editConfig", name => $Lang->{CfgEdit_Edit_Config},
|
||
|
priv => 1},
|
||
|
{ link => "?action=editConfig&newMenu=hosts",
|
||
|
name => $Lang->{CfgEdit_Edit_Hosts},
|
||
|
priv => 1},
|
||
|
{ link => "?action=adminOpts", name => $Lang->{Admin_Options},
|
||
|
priv => 1},
|
||
|
{ link => "?action=view&type=LOG", name => $Lang->{LOG_file},
|
||
|
priv => 1},
|
||
|
{ link => "?action=LOGlist", name => $Lang->{Old_LOGs},
|
||
|
priv => 1},
|
||
|
{ link => "?action=emailSummary", name => $Lang->{Email_summary},
|
||
|
priv => 1},
|
||
|
{ link => "?action=queue", name => $Lang->{Current_queues},
|
||
|
priv => 1},
|
||
|
{ link => "?action=check", name => 'Check',
|
||
|
priv => 1},
|
||
|
@{$Conf{CgiNavBarLinks} || []},
|
||
|
);
|
||
|
my $host = $In{host};
|
||
|
|
||
|
binmode(select, ":utf8");
|
||
|
print $Cgi->header(-charset => "utf-8");
|
||
|
print <<EOF;
|
||
|
<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
|
||
|
<html><head>
|
||
|
<title>$title</title>
|
||
|
<link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
|
||
|
<link rel=icon href="$Conf{CgiImageDirURL}/favicon.ico" type="image/x-icon">
|
||
|
$Conf{CgiHeaders}
|
||
|
<script src="$Conf{CgiImageDirURL}/sorttable.js"></script>
|
||
|
</head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
|
||
|
|
||
|
<div id="navigation-container">
|
||
|
<div id="logo-container">
|
||
|
<a href="https://backuppc.github.io/backuppc/"><img src="$Conf{CgiImageDirURL}/logo.gif"></a>
|
||
|
</div>
|
||
|
EOF
|
||
|
|
||
|
if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
|
||
|
print "<div class=\"NavMenu section-title\">";
|
||
|
NavSectionTitle("${EscHTML($host)}");
|
||
|
print <<EOF;
|
||
|
</div>
|
||
|
<div class="NavMenu host">
|
||
|
EOF
|
||
|
NavLink("?host=${EscURI($host)}",
|
||
|
"$host $Lang->{Home}", " class=\"navbar\"");
|
||
|
NavLink("?action=browse&host=${EscURI($host)}",
|
||
|
$Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
|
||
|
NavLink("?action=view&type=LOG&host=${EscURI($host)}",
|
||
|
$Lang->{LOG_file}, " class=\"navbar\"");
|
||
|
NavLink("?action=LOGlist&host=${EscURI($host)}",
|
||
|
$Lang->{LOG_files}, " class=\"navbar\"");
|
||
|
if ( -f "$TopDir/pc/$host/SmbLOG.bad"
|
||
|
|| -f "$TopDir/pc/$host/SmbLOG.bad.z"
|
||
|
|| -f "$TopDir/pc/$host/XferLOG.bad"
|
||
|
|| -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
|
||
|
NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
|
||
|
$Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
|
||
|
NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
|
||
|
$Lang->{Last_bad_XferLOG_errors_only},
|
||
|
" class=\"navbar\"");
|
||
|
}
|
||
|
if ( $Conf{CgiUserConfigEditEnable} || $PrivAdmin ) {
|
||
|
NavLink("?action=editConfig&host=${EscURI($host)}",
|
||
|
$Lang->{CfgEdit_Edit_Config}, " class=\"navbar\"");
|
||
|
} elsif ( -f "$TopDir/pc/$host/config.pl"
|
||
|
|| ($host ne "config" && -f "$TopDir/conf/$host.pl") ) {
|
||
|
NavLink("?action=view&type=config&host=${EscURI($host)}",
|
||
|
$Lang->{Config_file}, " class=\"navbar\"");
|
||
|
}
|
||
|
print "</div>\n";
|
||
|
}
|
||
|
print <<EOF;
|
||
|
<div class="NavMenu" id="NavMenu">
|
||
|
EOF
|
||
|
my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
|
||
|
my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
|
||
|
NavSectionTitle($Lang->{Hosts});
|
||
|
if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
|
||
|
foreach my $host ( @hosts ) {
|
||
|
NavLink("?host=${EscURI($host)}", $host)
|
||
|
if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
|
||
|
my $sel = " selected" if ( $host eq $In{host} );
|
||
|
$hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
|
||
|
. "$host</option>";
|
||
|
}
|
||
|
}
|
||
|
if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
|
||
|
print <<EOF;
|
||
|
<select onChange="document.location=this.value">
|
||
|
$hostSelectbox
|
||
|
</select>
|
||
|
EOF
|
||
|
}
|
||
|
if ( $Conf{CgiSearchBoxEnable} ) {
|
||
|
print <<EOF;
|
||
|
<form action="$MyURL" method="get">
|
||
|
<input type="text" name="host" size="14" maxlength="64">
|
||
|
<input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
|
||
|
</form>
|
||
|
EOF
|
||
|
}
|
||
|
NavSectionTitle($Lang->{NavSectionTitle_});
|
||
|
foreach my $l ( @adminLinks ) {
|
||
|
if ( $PrivAdmin || !$l->{priv} ) {
|
||
|
my $txt = $l->{lname} ne "" ? $Lang->{$l->{lname}} : $l->{name};
|
||
|
NavLink($l->{link}, $txt);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
print <<EOF;
|
||
|
</div>
|
||
|
</div> <!-- end #navigation-container -->
|
||
|
EOF
|
||
|
|
||
|
print("<div id=\"Content\">\n$content\n");
|
||
|
if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
|
||
|
while ( (my $s = &$contentSub()) ne "" ) {
|
||
|
print($s);
|
||
|
}
|
||
|
}
|
||
|
print($contentPost) if ( defined($contentPost) );
|
||
|
}
|
||
|
|
||
|
sub Trailer
|
||
|
{
|
||
|
print <<EOF;
|
||
|
</body></html>
|
||
|
EOF
|
||
|
}
|
||
|
|
||
|
|
||
|
sub NavSectionTitle
|
||
|
{
|
||
|
my($head) = @_;
|
||
|
print <<EOF;
|
||
|
<h2 class="NavTitle">$head</h2>
|
||
|
EOF
|
||
|
}
|
||
|
|
||
|
sub NavSectionStart
|
||
|
{
|
||
|
}
|
||
|
|
||
|
sub NavSectionEnd
|
||
|
{
|
||
|
}
|
||
|
|
||
|
sub NavLink
|
||
|
{
|
||
|
my($link, $text) = @_;
|
||
|
if ( defined($link) ) {
|
||
|
my($class);
|
||
|
$class = " class=\"NavCurrent\""
|
||
|
if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
|
||
|
|| length($link) && $link =~ /\&host=/ && $ENV{REQUEST_URI} =~ /\Q$link\E/
|
||
|
|| $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
|
||
|
$link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
|
||
|
print <<EOF;
|
||
|
<a href="$link"$class>$text</a>
|
||
|
EOF
|
||
|
} else {
|
||
|
print <<EOF;
|
||
|
$text<br>
|
||
|
EOF
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub h1
|
||
|
{
|
||
|
my($str) = @_;
|
||
|
return \<<EOF;
|
||
|
<h1>$str</h1>
|
||
|
EOF
|
||
|
}
|
||
|
|
||
|
sub h2
|
||
|
{
|
||
|
my($str) = @_;
|
||
|
return \<<EOF;
|
||
|
<h2>$str</h2>
|
||
|
EOF
|
||
|
}
|