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