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