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