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