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->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/&/&amp;/g;
 205     $s =~ s/\"/&quot;/g;
 206     $s =~ s/>/&gt;/g;
 207     $s =~ s/</&lt;/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         @{$Conf{CgiNavBarLinks} || []},
 412     );
 413     my $host = $In{host};
 414
 415     print $Cgi->header();
 416     print <<EOF;
 417 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
 418 <html><head>
 419 <title>$title</title>
 420 <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
 421 $Conf{CgiHeaders}
 422 </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
 423 <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
 424 EOF
 425
 426     if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
 427         print "<div class=\"NavMenu\">";
 428         NavSectionTitle("${EscHTML($host)}");
 429         print <<EOF;
 430 </div>
 431 <div class="NavMenu">
 432 EOF
 433         NavLink("?host=${EscURI($host)}",
 434                 "$host $Lang->{Home}", " class=\"navbar\"");
 435         NavLink("?action=browse&host=${EscURI($host)}",
 436                 $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
 437         NavLink("?action=view&type=LOG&host=${EscURI($host)}",
 438                 $Lang->{LOG_file}, " class=\"navbar\"");
 439         NavLink("?action=LOGlist&host=${EscURI($host)}",
 440                 $Lang->{LOG_files}, " class=\"navbar\"");
 441         if ( -f "$TopDir/pc/$host/SmbLOG.bad"
 442                     || -f "$TopDir/pc/$host/SmbLOG.bad.z"
 443                     || -f "$TopDir/pc/$host/XferLOG.bad"
 444                     || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
 445            NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
 446                     $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
 447            NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
 448                     $Lang->{Last_bad_XferLOG_errors_only},
 449                     " class=\"navbar\"");
 450         }
 451         if ( -f "$TopDir/pc/$host/config.pl" ) {
 452             NavLink("?action=view&type=config&host=${EscURI($host)}",
 453                     $Lang->{Config_file}, " class=\"navbar\"");
 454         }
 455         print "</div>\n";
 456     }
 457     print("<div id=\"Content\">\n$content\n");
 458     if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
 459         while ( (my $s = &$contentSub()) ne "" ) {
 460             print($s);
 461         }
 462     }
 463     print($contentPost) if ( defined($contentPost) );
 464     print <<EOF;
 465 <br><br><br>
 466 </div>
 467 <div class="NavMenu" id="NavMenu" style="height:100%">
 468 EOF
 469     my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
 470     my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
 471     if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
 472         NavSectionTitle($Lang->{Hosts});
 473         foreach my $host ( @hosts ) {
 474             NavLink("?host=${EscURI($host)}", $host)
 475                     if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
 476             my $sel = " selected" if ( $host eq $In{host} );
 477             $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
 478                             . "$host</option>";
 479         }
 480     }
 481     if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
 482         print <<EOF;
 483 <br>
 484 <select onChange="document.location=this.value">
 485 $hostSelectbox
 486 </select>
 487 <br><br>
 488 EOF
 489     }
 490     if ( $Conf{CgiSearchBoxEnable} ) {
 491         print <<EOF;
 492 <form action="$MyURL" method="get">
 493     <input type="text" name="host" size="14" maxlength="64">
 494     <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
 495     </form>
 496 EOF
 497     }
 498     NavSectionTitle($Lang->{NavSectionTitle_});
 499     foreach my $l ( @adminLinks ) {
 500         if ( $PrivAdmin || !$l->{priv} ) {
 501             my $txt = defined($l->{lname}) ? $Lang->{$l->{lname}} : $l->{name};
 502             NavLink($l->{link}, $txt);
 503         }
 504     }
 505
 506     print <<EOF;
 507 <br><br><br>
 508 </div>
 509 EOF
 510 }
 511
 512 sub Trailer
 513 {
 514     print <<EOF;
 515 </body></html>
 516 EOF
 517 }
 518
 519
 520 sub NavSectionTitle
 521 {
 522     my($head) = @_;
 523     print <<EOF;
 524 <div class="NavTitle">$head</div>
 525 EOF
 526 }
 527
 528 sub NavSectionStart
 529 {
 530 }
 531
 532 sub NavSectionEnd
 533 {
 534 }
 535
 536 sub NavLink
 537 {
 538     my($link, $text) = @_;
 539     if ( defined($link) ) {
 540         my($class);
 541         $class = " class=\"NavCurrent\""
 542                 if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
 543                     || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
 544         $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
 545         print <<EOF;
 546 <a href="$link"$class>$text</a>
 547 EOF
 548     } else {
 549         print <<EOF;
 550 $text<br>
 551 EOF
 552     }
 553 }
 554
 555 sub h1
 556 {
 557     my($str) = @_;
 558     return \<<EOF;
 559 <div class="h1">$str</div>
 560 EOF
 561 }
 562
 563 sub h2
 564 {
 565     my($str) = @_;
 566     return \<<EOF;
 567 <div class="h2">$str</div>
 568 EOF
 569 }