1 #============================================================= -*-perl-*-
3 # BackupPC::CGI::Lib package
7 # This library defines a BackupPC::Lib class and a variety of utility
8 # functions used by BackupPC.
11 # Craig Barratt <cbarratt@users.sourceforge.net>
14 # Copyright (C) 2003-2009 Craig Barratt
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.
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.
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
30 #========================================================================
32 # Version 3.2.0, released 31 Jul 2010.
34 # See http://backuppc.sourceforge.net.
36 #========================================================================
38 package BackupPC::CGI::Lib;
45 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
47 use vars qw($Cgi %In $MyURL $User %Conf $TopDir $LogDir $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);
79 $Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc
80 %Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
82 $Hosts $HostsMTime $ConfigMTime $PrivAdmin
83 %UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq
88 'all' => [ @EXPORT_OK ],
96 if ( !defined($bpc) ) {
97 ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log})
98 if ( !($bpc = BackupPC::Lib->new(undef, undef, undef, 1)) );
99 $TopDir = $bpc->TopDir();
100 $LogDir = $bpc->LogDir();
101 $BinDir = $bpc->BinDir();
102 %Conf = $bpc->Conf();
103 $Lang = $bpc->Lang();
104 $ConfigMTime = $bpc->ConfigMTime();
105 umask($Conf{UmaskMode});
106 } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) {
108 $TopDir = $bpc->TopDir();
109 $LogDir = $bpc->LogDir();
110 $BinDir = $bpc->BinDir();
111 %Conf = $bpc->Conf();
112 $Lang = $bpc->Lang();
113 $ConfigMTime = $bpc->ConfigMTime();
114 umask($Conf{UmaskMode});
118 # Default REMOTE_USER so in a miminal installation the user
119 # has a sensible default.
121 $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );
124 # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
125 # The latter requires .ht_access style authentication. Replace this
126 # code if you are using some other type of authentication, and have
127 # a different way of getting the user name.
129 $MyURL = $ENV{SCRIPT_NAME};
130 $User = $ENV{REMOTE_USER};
133 # Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint
135 $User = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ );
137 # strip Active directory domain in front of user
138 $User = $1 if ( $User =~ /\w+\\(\w+)/ );
139 use Data::Dump qw(dump);
140 warn "XX User: $User",dump( \%ENV );
143 # Clean up %ENV for taint checking
145 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
146 $ENV{PATH} = $Conf{MyPath};
149 # Verify we are running as the correct user
151 if ( $Conf{BackupPCUserVerify}
152 && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) {
153 ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF);
154 This script needs to run as the user specified in \$Conf{BackupPCUser},
155 which is set to $Conf{BackupPCUser}.
157 This is an installation problem. If you are using mod_perl then
158 it appears that Apache is not running as user $Conf{BackupPCUser}.
159 If you are not using mod_perl, then most like setuid is not working
160 properly on BackupPC_Admin. Check the permissions on
161 $Conf{CgiDir}/BackupPC_Admin and look at the documentation.
165 if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
166 $HostsMTime = $bpc->HostsMTime();
167 $Hosts = $bpc->HostInfoRead();
169 # turn moreUsers list into a hash for quick lookups
170 foreach my $host (keys %$Hosts) {
171 $Hosts->{$host}{moreUsers} =
172 {map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) }
177 # Untaint the host name
179 if ( $In{host} =~ /^([\w.\s-]+)$/ ) {
188 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
189 = localtime($_[0] == 0 ? time : $_[0] );
191 if ( $Conf{CgiDateFormatMMDD} == 2 ) {
193 return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $min);
194 } elsif ( $Conf{CgiDateFormatMMDD} ) {
195 return sprintf("$mon/$mday %02d:%02d", $hour, $min);
197 return sprintf("$mday/$mon %02d:%02d", $hour, $min);
205 if ( defined($Hosts->{$host}) || defined($Status{$host}) ) {
206 $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
218 return \$user if ( $user eq ""
219 || $Conf{CgiUserUrlCreate} eq "" );
220 if ( $Conf{CgiUserHomePageCheck} eq ""
221 || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
223 . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
238 ### $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
245 $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
252 my($head) = shift(@mesg);
253 my($mesg) = join("</p>\n<p>", @mesg);
255 if ( !defined($ENV{REMOTE_USER}) ) {
258 Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
259 installation problem. BackupPC_Admin expects Apache to authenticate
260 the user and pass their user name into this script as the REMOTE_USER
261 environment variable. See the documentation.
265 $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
266 if ( defined($bpc) );
267 if ( !defined($Lang->{Error}) ) {
268 $mesg = <<EOF if ( !defined($mesg) );
269 There is some problem with the BackupPC installation.
270 Please check the permissions on BackupPC_Admin.
273 ${h1("Error: Unable to read config.pl or language strings!!")}
276 Header("BackupPC: Error", $content);
279 my $content = eval("qq{$Lang->{Error____head}}");
280 Header(eval("qq{$Lang->{Error}}"), $content);
289 # Verify that the server connection is ok
291 return if ( $bpc->ServerOK() );
292 $bpc->ServerDisconnect();
293 if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
294 if ( CheckPermission()
295 && -f $Conf{ServerInitdPath}
296 && $Conf{ServerInitdStartCmd} ne "" ) {
297 my $content = eval("qq{$Lang->{Admin_Start_Server}}");
298 Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content);
302 ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"),
303 eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_error_message}}"));
312 %Status = () if ( $status =~ /\bhosts\b/ );
313 %StatusHost = () if ( $status =~ /\bhost\(/ );
314 my $reply = $bpc->ServerMesg("status $status");
315 $reply = $1 if ( $reply =~ /(.*)/s );
317 # ignore status related to admin and trashClean jobs
318 if ( $status =~ /\bhosts\b/ ) {
319 foreach my $host ( grep(/admin/, keys(%Status)) ) {
320 delete($Status{$host}) if ( $bpc->isAdminJob($host) );
322 delete($Status{$bpc->trashJob});
326 sub ReadUserEmailInfo
328 if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
329 do "$LogDir/UserEmailInfo.pl";
330 $UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9];
335 # Check if the user is privileged. A privileged user can access
336 # any information (backup files, logs, status pages etc).
338 # A user is privileged if they belong to the group
339 # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
340 # or they are the user assigned to a host in the host file.
347 return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
348 || $host ne "" && !defined($Hosts->{$host}) );
349 if ( $Conf{CgiAdminUserGroup} ne "" ) {
350 my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
351 $Privileged ||= ($mem =~ /\b\Q$User\E\b/);
353 if ( $Conf{CgiAdminUsers} ne "" ) {
354 $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/);
355 $Privileged ||= $Conf{CgiAdminUsers} eq "*";
357 $PrivAdmin = $Privileged;
358 return $Privileged if ( !defined($host) );
360 $Privileged ||= $User eq $Hosts->{$host}{user};
361 $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
363 # XXX check against REMOTE_NTGROUP from mod_ntlm
364 $Privileged ||= $Conf{CgiAdminUserGroup} eq $ENV{REMOTE_NTGROUP};
370 # Returns the list of hosts that should appear in the navigation bar
371 # for this user. If $getAll is set, the admin gets all the hosts.
372 # Otherwise, regular users get hosts for which they are the user or
373 # are listed in the moreUsers column in the hosts file.
380 if ( $getAll && CheckPermission() ) {
381 @hosts = sort keys %$Hosts;
383 @hosts = sort grep { $Hosts->{$_}{user} eq $User ||
384 defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
390 # Given a host name tries to find the IP address. For non-dhcp hosts
391 # we just return the host name. For dhcp hosts we check the address
392 # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
393 # address for $host. (Later we should replace this with a broadcast
401 if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
402 && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
404 my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
405 if ( $netBiosHost ne $host ) {
407 GetStatusInfo("host(${EscURI($host)})");
408 if ( defined($StatusHost{dhcpHostIP})
409 && $StatusHost{dhcpHostIP} ne $ipAddr ) {
410 $tryIP = eval("qq{$Lang->{tryIP}}");
411 ($netBiosHost, $netBiosUser)
412 = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
414 if ( $netBiosHost ne $host ) {
415 ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
416 eval("qq{$Lang->{host_is_a_DHCP_host}}"));
418 $ipAddr = $StatusHost{dhcpHostIP};
424 ###########################################################################
425 # HTML layout subroutines
426 ###########################################################################
430 my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
432 { link => "", name => $Lang->{Status}},
433 { link => "?action=summary", name => $Lang->{PC_Summary}},
434 { link => "?action=editConfig", name => $Lang->{CfgEdit_Edit_Config},
436 { link => "?action=editConfig&newMenu=hosts",
437 name => $Lang->{CfgEdit_Edit_Hosts},
439 { link => "?action=adminOpts", name => $Lang->{Admin_Options},
441 { link => "?action=view&type=LOG", name => $Lang->{LOG_file},
443 { link => "?action=LOGlist", name => $Lang->{Old_LOGs},
445 { link => "?action=emailSummary", name => $Lang->{Email_summary},
447 { link => "?action=queue", name => $Lang->{Current_queues},
449 # XXX additional search extensions
450 { link => "?action=search", name => $Lang->{Search_archive},
452 { link => "?action=burn", name => $Lang->{Burn_media},
454 @{$Conf{CgiNavBarLinks} || []},
456 my $host = $In{host};
458 binmode(STDOUT, ":utf8");
459 print $Cgi->header(-charset => "utf-8");
461 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
463 <title>$title</title>
464 <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
465 <link rel=icon href="$Conf{CgiImageDirURL}/favicon.ico" type="image/x-icon">
467 <script src="$Conf{CgiImageDirURL}/sorttable.js"></script>
468 </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
469 <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
472 if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
473 print "<div class=\"NavMenu\">";
474 NavSectionTitle("${EscHTML($host)}");
477 <div class="NavMenu">
479 NavLink("?host=${EscURI($host)}",
480 "$host $Lang->{Home}", " class=\"navbar\"");
481 NavLink("?action=browse&host=${EscURI($host)}",
482 $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
483 NavLink("?action=view&type=LOG&host=${EscURI($host)}",
484 $Lang->{LOG_file}, " class=\"navbar\"");
485 NavLink("?action=LOGlist&host=${EscURI($host)}",
486 $Lang->{LOG_files}, " class=\"navbar\"");
487 if ( -f "$TopDir/pc/$host/SmbLOG.bad"
488 || -f "$TopDir/pc/$host/SmbLOG.bad.z"
489 || -f "$TopDir/pc/$host/XferLOG.bad"
490 || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
491 NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
492 $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
493 NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
494 $Lang->{Last_bad_XferLOG_errors_only},
495 " class=\"navbar\"");
497 if ( $Conf{CgiUserConfigEditEnable} || $PrivAdmin ) {
498 NavLink("?action=editConfig&host=${EscURI($host)}",
499 $Lang->{CfgEdit_Edit_Config}, " class=\"navbar\"");
500 } elsif ( -f "$TopDir/pc/$host/config.pl"
501 || ($host ne "config" && -f "$TopDir/conf/$host.pl") ) {
502 NavLink("?action=view&type=config&host=${EscURI($host)}",
503 $Lang->{Config_file}, " class=\"navbar\"");
507 print("<div id=\"Content\">\n$content\n");
508 if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
509 while ( (my $s = &$contentSub()) ne "" ) {
513 print($contentPost) if ( defined($contentPost) );
517 <div class="NavMenu" id="NavMenu" style="height:100%">
519 my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
520 my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
521 NavSectionTitle($Lang->{Hosts});
522 if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
523 foreach my $host ( @hosts ) {
524 NavLink("?host=${EscURI($host)}", $host)
525 if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
526 my $sel = " selected" if ( $host eq $In{host} );
527 $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
531 if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
534 <select onChange="document.location=this.value">
540 if ( $Conf{CgiSearchBoxEnable} ) {
542 <form action="$MyURL" method="get">
543 <input type="text" name="host" size="14" maxlength="64">
544 <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
548 NavSectionTitle($Lang->{NavSectionTitle_});
549 foreach my $l ( @adminLinks ) {
550 if ( $PrivAdmin || !$l->{priv} ) {
551 my $txt = $l->{lname} ne "" ? $Lang->{$l->{lname}} : $l->{name};
552 NavLink($l->{link}, $txt);
574 <div class="NavTitle">$head</div>
588 my($link, $text) = @_;
589 if ( defined($link) ) {
591 $class = " class=\"NavCurrent\""
592 if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
593 || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
594 $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
596 <a href="$link"$class>$text</a>
609 <div class="h1">$str</div>
617 <div class="h2">$str</div>