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