lib/BackupPC/CGI/Lib.pm

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