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