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