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