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     %Status = ()     if ( $status =~ /\bhosts\b/ );
 293     %StatusHost = () if ( $status =~ /\bhost\(/ );
 294     my $reply = $bpc->ServerMesg("status $status");
 295     $reply = $1 if ( $reply =~ /(.*)/s );
 296     eval($reply);
 297     # ignore status related to admin and trashClean jobs
 298     if ( $status =~ /\bhosts\b/ ) {
 299         foreach my $host ( grep(/admin/, keys(%Status)) ) {
 300             delete($Status{$host}) if ( $bpc->isAdminJob($host) );
 301         }
 302         delete($Status{$bpc->trashJob});
 303     }
 304 }
 305
 306 sub ReadUserEmailInfo
 307 {
 308     if ( (stat("$TopDir/log/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
 309         do "$TopDir/log/UserEmailInfo.pl";
 310         $UserEmailInfoMTime = (stat("$TopDir/log/UserEmailInfo.pl"))[9];
 311     }
 312 }
 313
 314 #
 315 # Check if the user is privileged.  A privileged user can access
 316 # any information (backup files, logs, status pages etc).
 317 #
 318 # A user is privileged if they belong to the group
 319 # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
 320 # or they are the user assigned to a host in the host file.
 321 #
 322 sub CheckPermission
 323 {
 324     my($host) = @_;
 325     my $Privileged = 0;
 326
 327     return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
 328                || $host ne "" && !defined($Hosts->{$host}) );
 329     if ( $Conf{CgiAdminUserGroup} ne "" ) {
 330         my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
 331         $Privileged ||= ($mem =~ /\b$User\b/);
 332     }
 333     if ( $Conf{CgiAdminUsers} ne "" ) {
 334         $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b$User\b/);
 335         $Privileged ||= $Conf{CgiAdminUsers} eq "*";
 336     }
 337     $PrivAdmin = $Privileged;
 338     return $Privileged if ( !defined($host) );
 339
 340     $Privileged ||= $User eq $Hosts->{$host}{user};
 341     $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
 342     return $Privileged;
 343 }
 344
 345 #
 346 # Returns the list of hosts that should appear in the navigation bar
 347 # for this user.  If $getAll is set, the admin gets all the hosts.
 348 # Otherwise, regular users get hosts for which they are the user or
 349 # are listed in the moreUsers column in the hosts file.
 350 #
 351 sub GetUserHosts
 352 {
 353     my($getAll) = @_;
 354     my @hosts;
 355
 356     if ( $getAll && CheckPermission() ) {
 357         @hosts = sort keys %$Hosts;
 358     } else {
 359         @hosts = sort grep { $Hosts->{$_}{user} eq $User ||
 360                        defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
 361     }
 362     return @hosts;
 363 }
 364
 365 #
 366 # Given a host name tries to find the IP address.  For non-dhcp hosts
 367 # we just return the host name.  For dhcp hosts we check the address
 368 # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
 369 # address for $host.  (Later we should replace this with a broadcast
 370 # nmblookup.)
 371 #
 372 sub ConfirmIPAddress
 373 {
 374     my($host) = @_;
 375     my $ipAddr = $host;
 376
 377     if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
 378                && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
 379         $ipAddr = $1;
 380         my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
 381         if ( $netBiosHost ne $host ) {
 382             my($tryIP);
 383             GetStatusInfo("host(${EscURI($host)})");
 384             if ( defined($StatusHost{dhcpHostIP})
 385                         && $StatusHost{dhcpHostIP} ne $ipAddr ) {
 386                 $tryIP = eval("qq{$Lang->{tryIP}}");
 387                 ($netBiosHost, $netBiosUser)
 388                         = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
 389             }
 390             if ( $netBiosHost ne $host ) {
 391                 ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
 392                           eval("qq{$Lang->{host_is_a_DHCP_host}}"));
 393             }
 394             $ipAddr = $StatusHost{dhcpHostIP};
 395         }
 396     }
 397     return $ipAddr;
 398 }
 399
 400 ###########################################################################
 401 # HTML layout subroutines
 402 ###########################################################################
 403
 404 sub Header
 405 {
 406     my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
 407     my @adminLinks = (
 408         { link => "",                         name => $Lang->{Status}},
 409         { link => "?action=adminOpts",        name => $Lang->{Admin_Options},
 410                                               priv => 1},
 411         { link => "?action=editConfig",       name => "Edit Config",
 412                                               priv => 1},
 413         { link => "?action=editHosts",        name => "Edit Hosts",
 414                                               priv => 1},
 415         { link => "?action=summary",          name => $Lang->{PC_Summary}},
 416         { link => "?action=view&type=LOG",    name => $Lang->{LOG_file},
 417                                               priv => 1},
 418         { link => "?action=LOGlist",          name => $Lang->{Old_LOGs},
 419                                               priv => 1},
 420         { link => "?action=emailSummary",     name => $Lang->{Email_summary},
 421                                               priv => 1},
 422         { link => "?action=view&type=config", name => $Lang->{Config_file},
 423                                               priv => 1},
 424         { link => "?action=view&type=hosts",  name => $Lang->{Hosts_file},
 425                                               priv => 1},
 426         { link => "?action=queue",            name => $Lang->{Current_queues},
 427                                               priv => 1},
 428         @{$Conf{CgiNavBarLinks} || []},
 429     );
 430     my $host = $In{host};
 431
 432     print $Cgi->header();
 433     print <<EOF;
 434 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
 435 <html><head>
 436 <title>$title</title>
 437 <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
 438 $Conf{CgiHeaders}
 439 </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
 440 <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
 441 EOF
 442
 443     if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
 444         print "<div class=\"NavMenu\">";
 445         NavSectionTitle("${EscHTML($host)}");
 446         print <<EOF;
 447 </div>
 448 <div class="NavMenu">
 449 EOF
 450         NavLink("?host=${EscURI($host)}",
 451                 "$host $Lang->{Home}", " class=\"navbar\"");
 452         NavLink("?action=browse&host=${EscURI($host)}",
 453                 $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
 454         NavLink("?action=view&type=LOG&host=${EscURI($host)}",
 455                 $Lang->{LOG_file}, " class=\"navbar\"");
 456         NavLink("?action=LOGlist&host=${EscURI($host)}",
 457                 $Lang->{LOG_files}, " class=\"navbar\"");
 458         if ( -f "$TopDir/pc/$host/SmbLOG.bad"
 459                     || -f "$TopDir/pc/$host/SmbLOG.bad.z"
 460                     || -f "$TopDir/pc/$host/XferLOG.bad"
 461                     || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
 462            NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
 463                     $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
 464            NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
 465                     $Lang->{Last_bad_XferLOG_errors_only},
 466                     " class=\"navbar\"");
 467         }
 468         if ( -f "$TopDir/pc/$host/config.pl" ) {
 469             NavLink("?action=editConfig&host=${EscURI($host)}",
 470                     "Edit Config", " class=\"navbar\"");
 471         }
 472         print "</div>\n";
 473     }
 474     print("<div id=\"Content\">\n$content\n");
 475     if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
 476         while ( (my $s = &$contentSub()) ne "" ) {
 477             print($s);
 478         }
 479     }
 480     print($contentPost) if ( defined($contentPost) );
 481     print <<EOF;
 482 <br><br><br>
 483 </div>
 484 <div class="NavMenu" id="NavMenu" style="height:100%">
 485 EOF
 486     my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
 487     my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
 488     if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
 489         NavSectionTitle($Lang->{Hosts});
 490         foreach my $host ( @hosts ) {
 491             NavLink("?host=${EscURI($host)}", $host)
 492                     if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
 493             my $sel = " selected" if ( $host eq $In{host} );
 494             $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
 495                             . "$host</option>";
 496         }
 497     }
 498     if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
 499         print <<EOF;
 500 <br>
 501 <select onChange="document.location=this.value">
 502 $hostSelectbox
 503 </select>
 504 <br><br>
 505 EOF
 506     }
 507     if ( $Conf{CgiSearchBoxEnable} ) {
 508         print <<EOF;
 509 <form action="$MyURL" method="get">
 510     <input type="text" name="host" size="14" maxlength="64">
 511     <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
 512     </form>
 513 EOF
 514     }
 515     NavSectionTitle($Lang->{NavSectionTitle_});
 516     foreach my $l ( @adminLinks ) {
 517         if ( $PrivAdmin || !$l->{priv} ) {
 518             my $txt = $l->{lname} ne "" ? $Lang->{$l->{lname}} : $l->{name};
 519             NavLink($l->{link}, $txt);
 520         }
 521     }
 522
 523     print <<EOF;
 524 <br><br><br>
 525 </div>
 526 EOF
 527 }
 528
 529 sub Trailer
 530 {
 531     print <<EOF;
 532 </body></html>
 533 EOF
 534 }
 535
 536
 537 sub NavSectionTitle
 538 {
 539     my($head) = @_;
 540     print <<EOF;
 541 <div class="NavTitle">$head</div>
 542 EOF
 543 }
 544
 545 sub NavSectionStart
 546 {
 547 }
 548
 549 sub NavSectionEnd
 550 {
 551 }
 552
 553 sub NavLink
 554 {
 555     my($link, $text) = @_;
 556     if ( defined($link) ) {
 557         my($class);
 558         $class = " class=\"NavCurrent\""
 559                 if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
 560                     || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
 561         $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
 562         print <<EOF;
 563 <a href="$link"$class>$text</a>
 564 EOF
 565     } else {
 566         print <<EOF;
 567 $text<br>
 568 EOF
 569     }
 570 }
 571
 572 sub h1
 573 {
 574     my($str) = @_;
 575     return \<<EOF;
 576 <div class="h1">$str</div>
 577 EOF
 578 }
 579
 580 sub h2
 581 {
 582     my($str) = @_;
 583     return \<<EOF;
 584 <div class="h2">$str</div>
 585 EOF
 586 }