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