| 1 |
#============================================================= -*-perl-*- |
| 2 |
# |
| 3 |
# BackupPC::CGI::Lib package |
| 4 |
# |
| 5 |
# DESCRIPTION |
| 6 |
# |
| 7 |
# This library defines a BackupPC::Lib class and a variety of utility |
| 8 |
# functions used by BackupPC. |
| 9 |
# |
| 10 |
# AUTHOR |
| 11 |
# Craig Barratt <cbarratt@users.sourceforge.net> |
| 12 |
# |
| 13 |
# COPYRIGHT |
| 14 |
# Copyright (C) 2003 Craig Barratt |
| 15 |
# |
| 16 |
# This program is free software; you can redistribute it and/or modify |
| 17 |
# it under the terms of the GNU General Public License as published by |
| 18 |
# the Free Software Foundation; either version 2 of the License, or |
| 19 |
# (at your option) any later version. |
| 20 |
# |
| 21 |
# This program is distributed in the hope that it will be useful, |
| 22 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 23 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 24 |
# GNU General Public License for more details. |
| 25 |
# |
| 26 |
# You should have received a copy of the GNU General Public License |
| 27 |
# along with this program; if not, write to the Free Software |
| 28 |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| 29 |
# |
| 30 |
#======================================================================== |
| 31 |
# |
| 32 |
# Version 2.1.0, released 20 Jun 2004. |
| 33 |
# |
| 34 |
# See http://backuppc.sourceforge.net. |
| 35 |
# |
| 36 |
#======================================================================== |
| 37 |
|
| 38 |
package BackupPC::CGI::Lib; |
| 39 |
|
| 40 |
use strict; |
| 41 |
use BackupPC::Lib; |
| 42 |
|
| 43 |
require Exporter; |
| 44 |
|
| 45 |
use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); |
| 46 |
|
| 47 |
use vars qw($Cgi %In $MyURL $User %Conf $TopDir $BinDir $bpc); |
| 48 |
use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue |
| 49 |
%QueueLen %StatusHost); |
| 50 |
use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin); |
| 51 |
use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq); |
| 52 |
use vars qw($Lang); |
| 53 |
|
| 54 |
@ISA = qw(Exporter); |
| 55 |
|
| 56 |
@EXPORT = qw( ); |
| 57 |
|
| 58 |
@EXPORT_OK = qw( |
| 59 |
timeStamp2 |
| 60 |
HostLink |
| 61 |
UserLink |
| 62 |
EscHTML |
| 63 |
EscURI |
| 64 |
ErrorExit |
| 65 |
ServerConnect |
| 66 |
GetStatusInfo |
| 67 |
ReadUserEmailInfo |
| 68 |
CheckPermission |
| 69 |
GetUserHosts |
| 70 |
ConfirmIPAddress |
| 71 |
Header |
| 72 |
Trailer |
| 73 |
NavSectionTitle |
| 74 |
NavSectionStart |
| 75 |
NavSectionEnd |
| 76 |
NavLink |
| 77 |
h1 |
| 78 |
h2 |
| 79 |
$Cgi %In $MyURL $User %Conf $TopDir $BinDir $bpc |
| 80 |
%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue |
| 81 |
%QueueLen %StatusHost |
| 82 |
$Hosts $HostsMTime $ConfigMTime $PrivAdmin |
| 83 |
%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq |
| 84 |
$Lang |
| 85 |
); |
| 86 |
|
| 87 |
%EXPORT_TAGS = ( |
| 88 |
'all' => [ @EXPORT_OK ], |
| 89 |
); |
| 90 |
|
| 91 |
sub NewRequest |
| 92 |
{ |
| 93 |
$Cgi = new CGI; |
| 94 |
%In = $Cgi->Vars; |
| 95 |
|
| 96 |
if ( !defined($bpc) ) { |
| 97 |
ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log}) |
| 98 |
if ( !($bpc = BackupPC::Lib->new(undef, undef, 1)) ); |
| 99 |
$TopDir = $bpc->TopDir(); |
| 100 |
$BinDir = $bpc->BinDir(); |
| 101 |
%Conf = $bpc->Conf(); |
| 102 |
$Lang = $bpc->Lang(); |
| 103 |
$ConfigMTime = $bpc->ConfigMTime(); |
| 104 |
} elsif ( $bpc->ConfigMTime() != $ConfigMTime ) { |
| 105 |
$bpc->ServerMesg("log Re-read config file because mtime changed"); |
| 106 |
$bpc->ServerMesg("server reload"); |
| 107 |
} |
| 108 |
|
| 109 |
# |
| 110 |
# Default REMOTE_USER so in a miminal installation the user |
| 111 |
# has a sensible default. |
| 112 |
# |
| 113 |
$ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" ); |
| 114 |
|
| 115 |
# |
| 116 |
# We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}. |
| 117 |
# The latter requires .ht_access style authentication. Replace this |
| 118 |
# code if you are using some other type of authentication, and have |
| 119 |
# a different way of getting the user name. |
| 120 |
# |
| 121 |
$MyURL = $ENV{SCRIPT_NAME}; |
| 122 |
$User = $ENV{REMOTE_USER}; |
| 123 |
|
| 124 |
# |
| 125 |
# Clean up %ENV for taint checking |
| 126 |
# |
| 127 |
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; |
| 128 |
$ENV{PATH} = $Conf{MyPath}; |
| 129 |
|
| 130 |
# |
| 131 |
# Verify we are running as the correct user |
| 132 |
# |
| 133 |
if ( $Conf{BackupPCUserVerify} |
| 134 |
&& $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) { |
| 135 |
ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF); |
| 136 |
This script needs to run as the user specified in \$Conf{BackupPCUser}, |
| 137 |
which is set to $Conf{BackupPCUser}. |
| 138 |
<p> |
| 139 |
This is an installation problem. If you are using mod_perl then |
| 140 |
it appears that Apache is not running as user $Conf{BackupPCUser}. |
| 141 |
If you are not using mod_perl, then most like setuid is not working |
| 142 |
properly on BackupPC_Admin. Check the permissions on |
| 143 |
$Conf{CgiDir}/BackupPC_Admin and look at the documentation. |
| 144 |
EOF |
| 145 |
} |
| 146 |
|
| 147 |
if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) { |
| 148 |
$HostsMTime = $bpc->HostsMTime(); |
| 149 |
$Hosts = $bpc->HostInfoRead(); |
| 150 |
|
| 151 |
# turn moreUsers list into a hash for quick lookups |
| 152 |
foreach my $host (keys %$Hosts) { |
| 153 |
$Hosts->{$host}{moreUsers} = |
| 154 |
{map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) } |
| 155 |
} |
| 156 |
} |
| 157 |
} |
| 158 |
|
| 159 |
sub timeStamp2 |
| 160 |
{ |
| 161 |
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) |
| 162 |
= localtime($_[0] == 0 ? time : $_[0] ); |
| 163 |
$mon++; |
| 164 |
if ( $Conf{CgiDateFormatMMDD} ) { |
| 165 |
return sprintf("$mon/$mday %02d:%02d", $hour, $min); |
| 166 |
} else { |
| 167 |
return sprintf("$mday/$mon %02d:%02d", $hour, $min); |
| 168 |
} |
| 169 |
} |
| 170 |
|
| 171 |
sub HostLink |
| 172 |
{ |
| 173 |
my($host) = @_; |
| 174 |
my($s); |
| 175 |
if ( defined($Hosts->{$host}) || defined($Status{$host}) ) { |
| 176 |
$s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>"; |
| 177 |
} else { |
| 178 |
$s = $host; |
| 179 |
} |
| 180 |
return \$s; |
| 181 |
} |
| 182 |
|
| 183 |
sub UserLink |
| 184 |
{ |
| 185 |
my($user) = @_; |
| 186 |
my($s); |
| 187 |
|
| 188 |
return \$user if ( $user eq "" |
| 189 |
|| $Conf{CgiUserUrlCreate} eq "" ); |
| 190 |
if ( $Conf{CgiUserHomePageCheck} eq "" |
| 191 |
|| -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) { |
| 192 |
$s = "<a href=\"" |
| 193 |
. sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user) |
| 194 |
. "\">$user</a>"; |
| 195 |
} else { |
| 196 |
$s = $user; |
| 197 |
} |
| 198 |
return \$s; |
| 199 |
} |
| 200 |
|
| 201 |
sub EscHTML |
| 202 |
{ |
| 203 |
my($s) = @_; |
| 204 |
$s =~ s/&/&/g; |
| 205 |
$s =~ s/\"/"/g; |
| 206 |
$s =~ s/>/>/g; |
| 207 |
$s =~ s/</</g; |
| 208 |
$s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg; |
| 209 |
return \$s; |
| 210 |
} |
| 211 |
|
| 212 |
sub EscURI |
| 213 |
{ |
| 214 |
my($s) = @_; |
| 215 |
$s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg; |
| 216 |
return \$s; |
| 217 |
} |
| 218 |
|
| 219 |
sub ErrorExit |
| 220 |
{ |
| 221 |
my(@mesg) = @_; |
| 222 |
my($head) = shift(@mesg); |
| 223 |
my($mesg) = join("</p>\n<p>", @mesg); |
| 224 |
|
| 225 |
if ( !defined($ENV{REMOTE_USER}) ) { |
| 226 |
$mesg .= <<EOF; |
| 227 |
<p> |
| 228 |
Note: \$ENV{REMOTE_USER} is not set, which could mean there is an |
| 229 |
installation problem. BackupPC_Admin expects Apache to authenticate |
| 230 |
the user and pass their user name into this script as the REMOTE_USER |
| 231 |
environment variable. See the documentation. |
| 232 |
EOF |
| 233 |
} |
| 234 |
|
| 235 |
$bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head") |
| 236 |
if ( defined($bpc) ); |
| 237 |
if ( !defined($Lang->{Error}) ) { |
| 238 |
$mesg = <<EOF if ( !defined($mesg) ); |
| 239 |
There is some problem with the BackupPC installation. |
| 240 |
Please check the permissions on BackupPC_Admin. |
| 241 |
EOF |
| 242 |
my $content = <<EOF; |
| 243 |
${h1("Error: Unable to read config.pl or language strings!!")} |
| 244 |
<p>$mesg</p> |
| 245 |
EOF |
| 246 |
Header("BackupPC: Error", $content); |
| 247 |
Trailer(); |
| 248 |
} else { |
| 249 |
my $content = eval("qq{$Lang->{Error____head}}"); |
| 250 |
Header(eval("qq{$Lang->{Error}}"), $content); |
| 251 |
Trailer(); |
| 252 |
} |
| 253 |
exit(1); |
| 254 |
} |
| 255 |
|
| 256 |
sub ServerConnect |
| 257 |
{ |
| 258 |
# |
| 259 |
# Verify that the server connection is ok |
| 260 |
# |
| 261 |
return if ( $bpc->ServerOK() ); |
| 262 |
$bpc->ServerDisconnect(); |
| 263 |
if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) { |
| 264 |
if ( CheckPermission() |
| 265 |
&& -f $Conf{ServerInitdPath} |
| 266 |
&& $Conf{ServerInitdStartCmd} ne "" ) { |
| 267 |
my $content = eval("qq{$Lang->{Admin_Start_Server}}"); |
| 268 |
Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content); |
| 269 |
Trailer(); |
| 270 |
exit(1); |
| 271 |
} else { |
| 272 |
ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}")); |
| 273 |
} |
| 274 |
} |
| 275 |
} |
| 276 |
|
| 277 |
sub GetStatusInfo |
| 278 |
{ |
| 279 |
my($status) = @_; |
| 280 |
ServerConnect(); |
| 281 |
my $reply = $bpc->ServerMesg("status $status"); |
| 282 |
$reply = $1 if ( $reply =~ /(.*)/s ); |
| 283 |
eval($reply); |
| 284 |
# ignore status related to admin and trashClean jobs |
| 285 |
if ( $status =~ /\bhosts\b/ ) { |
| 286 |
foreach my $host ( grep(/admin/, keys(%Status)) ) { |
| 287 |
delete($Status{$host}) if ( $bpc->isAdminJob($host) ); |
| 288 |
} |
| 289 |
delete($Status{$bpc->trashJob}); |
| 290 |
} |
| 291 |
} |
| 292 |
|
| 293 |
sub ReadUserEmailInfo |
| 294 |
{ |
| 295 |
if ( (stat("$TopDir/log/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) { |
| 296 |
do "$TopDir/log/UserEmailInfo.pl"; |
| 297 |
$UserEmailInfoMTime = (stat("$TopDir/log/UserEmailInfo.pl"))[9]; |
| 298 |
} |
| 299 |
} |
| 300 |
|
| 301 |
# |
| 302 |
# Check if the user is privileged. A privileged user can access |
| 303 |
# any information (backup files, logs, status pages etc). |
| 304 |
# |
| 305 |
# A user is privileged if they belong to the group |
| 306 |
# $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers} |
| 307 |
# or they are the user assigned to a host in the host file. |
| 308 |
# |
| 309 |
sub CheckPermission |
| 310 |
{ |
| 311 |
my($host) = @_; |
| 312 |
my $Privileged = 0; |
| 313 |
|
| 314 |
return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*" |
| 315 |
|| $host ne "" && !defined($Hosts->{$host}) ); |
| 316 |
if ( $Conf{CgiAdminUserGroup} ne "" ) { |
| 317 |
my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup}); |
| 318 |
$Privileged ||= ($mem =~ /\b$User\b/); |
| 319 |
} |
| 320 |
if ( $Conf{CgiAdminUsers} ne "" ) { |
| 321 |
$Privileged ||= ($Conf{CgiAdminUsers} =~ /\b$User\b/); |
| 322 |
$Privileged ||= $Conf{CgiAdminUsers} eq "*"; |
| 323 |
} |
| 324 |
$PrivAdmin = $Privileged; |
| 325 |
return $Privileged if ( !defined($host) ); |
| 326 |
|
| 327 |
$Privileged ||= $User eq $Hosts->{$host}{user}; |
| 328 |
$Privileged ||= defined($Hosts->{$host}{moreUsers}{$User}); |
| 329 |
return $Privileged; |
| 330 |
} |
| 331 |
|
| 332 |
# |
| 333 |
# Returns the list of hosts that should appear in the navigation bar |
| 334 |
# for this user. If $getAll is set, the admin gets all the hosts. |
| 335 |
# Otherwise, regular users get hosts for which they are the user or |
| 336 |
# are listed in the moreUsers column in the hosts file. |
| 337 |
# |
| 338 |
sub GetUserHosts |
| 339 |
{ |
| 340 |
my($getAll) = @_; |
| 341 |
my @hosts; |
| 342 |
|
| 343 |
if ( $getAll && CheckPermission() ) { |
| 344 |
@hosts = sort keys %$Hosts; |
| 345 |
} else { |
| 346 |
@hosts = sort grep { $Hosts->{$_}{user} eq $User || |
| 347 |
defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts); |
| 348 |
} |
| 349 |
return @hosts; |
| 350 |
} |
| 351 |
|
| 352 |
# |
| 353 |
# Given a host name tries to find the IP address. For non-dhcp hosts |
| 354 |
# we just return the host name. For dhcp hosts we check the address |
| 355 |
# the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP |
| 356 |
# address for $host. (Later we should replace this with a broadcast |
| 357 |
# nmblookup.) |
| 358 |
# |
| 359 |
sub ConfirmIPAddress |
| 360 |
{ |
| 361 |
my($host) = @_; |
| 362 |
my $ipAddr = $host; |
| 363 |
|
| 364 |
if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp} |
| 365 |
&& $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) { |
| 366 |
$ipAddr = $1; |
| 367 |
my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr); |
| 368 |
if ( $netBiosHost ne $host ) { |
| 369 |
my($tryIP); |
| 370 |
GetStatusInfo("host(${EscURI($host)})"); |
| 371 |
if ( defined($StatusHost{dhcpHostIP}) |
| 372 |
&& $StatusHost{dhcpHostIP} ne $ipAddr ) { |
| 373 |
$tryIP = eval("qq{$Lang->{tryIP}}"); |
| 374 |
($netBiosHost, $netBiosUser) |
| 375 |
= $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP}); |
| 376 |
} |
| 377 |
if ( $netBiosHost ne $host ) { |
| 378 |
ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"), |
| 379 |
eval("qq{$Lang->{host_is_a_DHCP_host}}")); |
| 380 |
} |
| 381 |
$ipAddr = $StatusHost{dhcpHostIP}; |
| 382 |
} |
| 383 |
} |
| 384 |
return $ipAddr; |
| 385 |
} |
| 386 |
|
| 387 |
########################################################################### |
| 388 |
# HTML layout subroutines |
| 389 |
########################################################################### |
| 390 |
|
| 391 |
sub Header |
| 392 |
{ |
| 393 |
my($title, $content, $noBrowse, $contentSub, $contentPost) = @_; |
| 394 |
my @adminLinks = ( |
| 395 |
{ link => "", name => $Lang->{Status}}, |
| 396 |
{ link => "?action=adminOpts", name => $Lang->{Admin_Options}, |
| 397 |
priv => 1}, |
| 398 |
{ link => "?action=summary", name => $Lang->{PC_Summary}}, |
| 399 |
{ link => "?action=view&type=LOG", name => $Lang->{LOG_file}, |
| 400 |
priv => 1}, |
| 401 |
{ link => "?action=LOGlist", name => $Lang->{Old_LOGs}, |
| 402 |
priv => 1}, |
| 403 |
{ link => "?action=emailSummary", name => $Lang->{Email_summary}, |
| 404 |
priv => 1}, |
| 405 |
{ link => "?action=view&type=config", name => $Lang->{Config_file}, |
| 406 |
priv => 1}, |
| 407 |
{ link => "?action=view&type=hosts", name => $Lang->{Hosts_file}, |
| 408 |
priv => 1}, |
| 409 |
{ link => "?action=queue", name => $Lang->{Current_queues}, |
| 410 |
priv => 1}, |
| 411 |
{ link => "?action=search", name => $Lang->{Search_archive}, |
| 412 |
priv => 0}, |
| 413 |
{ link => "?action=burn", name => $Lang->{Burn_media}, |
| 414 |
priv => 1}, |
| 415 |
@{$Conf{CgiNavBarLinks} || []}, |
| 416 |
); |
| 417 |
my $host = $In{host}; |
| 418 |
|
| 419 |
print $Cgi->header(); |
| 420 |
print <<EOF; |
| 421 |
<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN"> |
| 422 |
<html><head> |
| 423 |
<title>$title</title> |
| 424 |
<link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile"> |
| 425 |
$Conf{CgiHeaders} |
| 426 |
</head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight"> |
| 427 |
<a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br> |
| 428 |
EOF |
| 429 |
|
| 430 |
if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) { |
| 431 |
print "<div class=\"NavMenu\">"; |
| 432 |
NavSectionTitle("${EscHTML($host)}"); |
| 433 |
print <<EOF; |
| 434 |
</div> |
| 435 |
<div class="NavMenu"> |
| 436 |
EOF |
| 437 |
NavLink("?host=${EscURI($host)}", |
| 438 |
"$host $Lang->{Home}", " class=\"navbar\""); |
| 439 |
NavLink("?action=browse&host=${EscURI($host)}", |
| 440 |
$Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse ); |
| 441 |
NavLink("?action=view&type=LOG&host=${EscURI($host)}", |
| 442 |
$Lang->{LOG_file}, " class=\"navbar\""); |
| 443 |
NavLink("?action=LOGlist&host=${EscURI($host)}", |
| 444 |
$Lang->{LOG_files}, " class=\"navbar\""); |
| 445 |
if ( -f "$TopDir/pc/$host/SmbLOG.bad" |
| 446 |
|| -f "$TopDir/pc/$host/SmbLOG.bad.z" |
| 447 |
|| -f "$TopDir/pc/$host/XferLOG.bad" |
| 448 |
|| -f "$TopDir/pc/$host/XferLOG.bad.z" ) { |
| 449 |
NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}", |
| 450 |
$Lang->{Last_bad_XferLOG}, " class=\"navbar\""); |
| 451 |
NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}", |
| 452 |
$Lang->{Last_bad_XferLOG_errors_only}, |
| 453 |
" class=\"navbar\""); |
| 454 |
} |
| 455 |
if ( -f "$TopDir/pc/$host/config.pl" ) { |
| 456 |
NavLink("?action=view&type=config&host=${EscURI($host)}", |
| 457 |
$Lang->{Config_file}, " class=\"navbar\""); |
| 458 |
} |
| 459 |
print "</div>\n"; |
| 460 |
} |
| 461 |
print("<div id=\"Content\">\n$content\n"); |
| 462 |
if ( defined($contentSub) && ref($contentSub) eq "CODE" ) { |
| 463 |
while ( (my $s = &$contentSub()) ne "" ) { |
| 464 |
print($s); |
| 465 |
} |
| 466 |
} |
| 467 |
print($contentPost) if ( defined($contentPost) ); |
| 468 |
print <<EOF; |
| 469 |
<br><br><br> |
| 470 |
</div> |
| 471 |
<div class="NavMenu" id="NavMenu" style="height:100%"> |
| 472 |
EOF |
| 473 |
my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>"; |
| 474 |
my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts}); |
| 475 |
if ( defined($Hosts) && %$Hosts > 0 && @hosts ) { |
| 476 |
NavSectionTitle($Lang->{Hosts}); |
| 477 |
foreach my $host ( @hosts ) { |
| 478 |
NavLink("?host=${EscURI($host)}", $host) |
| 479 |
if ( @hosts < $Conf{CgiNavBarAdminAllHosts} ); |
| 480 |
my $sel = " selected" if ( $host eq $In{host} ); |
| 481 |
$hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>" |
| 482 |
. "$host</option>"; |
| 483 |
} |
| 484 |
} |
| 485 |
if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) { |
| 486 |
print <<EOF; |
| 487 |
<br> |
| 488 |
<select onChange="document.location=this.value"> |
| 489 |
$hostSelectbox |
| 490 |
</select> |
| 491 |
<br><br> |
| 492 |
EOF |
| 493 |
} |
| 494 |
if ( $Conf{CgiSearchBoxEnable} ) { |
| 495 |
print <<EOF; |
| 496 |
<form action="$MyURL" method="get"> |
| 497 |
<input type="text" name="host" size="14" maxlength="64"> |
| 498 |
<input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore"> |
| 499 |
</form> |
| 500 |
EOF |
| 501 |
} |
| 502 |
NavSectionTitle($Lang->{NavSectionTitle_}); |
| 503 |
foreach my $l ( @adminLinks ) { |
| 504 |
if ( $PrivAdmin || !$l->{priv} ) { |
| 505 |
my $txt = defined($l->{lname}) ? $Lang->{$l->{lname}} : $l->{name}; |
| 506 |
NavLink($l->{link}, $txt); |
| 507 |
} |
| 508 |
} |
| 509 |
|
| 510 |
print <<EOF; |
| 511 |
<br><br><br> |
| 512 |
</div> |
| 513 |
EOF |
| 514 |
} |
| 515 |
|
| 516 |
sub Trailer |
| 517 |
{ |
| 518 |
print <<EOF; |
| 519 |
</body></html> |
| 520 |
EOF |
| 521 |
} |
| 522 |
|
| 523 |
|
| 524 |
sub NavSectionTitle |
| 525 |
{ |
| 526 |
my($head) = @_; |
| 527 |
print <<EOF; |
| 528 |
<div class="NavTitle">$head</div> |
| 529 |
EOF |
| 530 |
} |
| 531 |
|
| 532 |
sub NavSectionStart |
| 533 |
{ |
| 534 |
} |
| 535 |
|
| 536 |
sub NavSectionEnd |
| 537 |
{ |
| 538 |
} |
| 539 |
|
| 540 |
sub NavLink |
| 541 |
{ |
| 542 |
my($link, $text) = @_; |
| 543 |
if ( defined($link) ) { |
| 544 |
my($class); |
| 545 |
$class = " class=\"NavCurrent\"" |
| 546 |
if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/ |
| 547 |
|| $link eq "" && $ENV{REQUEST_URI} !~ /\?/ ); |
| 548 |
$link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ ); |
| 549 |
print <<EOF; |
| 550 |
<a href="$link"$class>$text</a> |
| 551 |
EOF |
| 552 |
} else { |
| 553 |
print <<EOF; |
| 554 |
$text<br> |
| 555 |
EOF |
| 556 |
} |
| 557 |
} |
| 558 |
|
| 559 |
sub h1 |
| 560 |
{ |
| 561 |
my($str) = @_; |
| 562 |
return \<<EOF; |
| 563 |
<div class="h1">$str</div> |
| 564 |
EOF |
| 565 |
} |
| 566 |
|
| 567 |
sub h2 |
| 568 |
{ |
| 569 |
my($str) = @_; |
| 570 |
return \<<EOF; |
| 571 |
<div class="h2">$str</div> |
| 572 |
EOF |
| 573 |
} |
Parent Directory
| 
Revision Log