lib.pm

老外写的linux下的文件备份软件

#============================================================= -*-perl-*-
#
# BackupPC::CGI::Lib package
#
# DESCRIPTION
#
#   This library defines a BackupPC::Lib class and a variety of utility
#   functions used by BackupPC.
#
# AUTHOR
#   Craig Barratt  <[e-mail]>
#
# COPYRIGHT
#   Copyright (C) 2003-2007  Craig Barratt
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#========================================================================
#
# Version 3.1.0, released 25 Nov 2007.
#
# See http://backuppc.sourceforge.net.
#
#========================================================================

package BackupPC::CGI::Lib;

use strict;
use BackupPC::Lib;

require Exporter;

use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );

use vars qw($Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc);
use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
            %QueueLen %StatusHost);
use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin);
use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq);
use vars qw($Lang);

@ISA = qw(Exporter);

@EXPORT    = qw( );

@EXPORT_OK = qw(
		    timeStamp2
		    HostLink
		    UserLink
		    EscHTML
		    EscURI
		    ErrorExit
		    ServerConnect
		    GetStatusInfo
		    ReadUserEmailInfo
		    CheckPermission
		    GetUserHosts
		    ConfirmIPAddress
		    Header
		    Trailer
		    NavSectionTitle
		    NavSectionStart
		    NavSectionEnd
		    NavLink
		    h1
		    h2
		    $Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc
		    %Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
		    %QueueLen %StatusHost
		    $Hosts $HostsMTime $ConfigMTime $PrivAdmin
		    %UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq
		    $Lang
             );

%EXPORT_TAGS = (
    'all'    => [ @EXPORT_OK ],
);

sub NewRequest
{
    $Cgi = new CGI;
    %In = $Cgi->Vars;

    if ( !defined($bpc) ) {
	ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log})
	    if ( !($bpc = BackupPC::Lib->new(undef, undef, undef, 1)) );
	$TopDir = $bpc->TopDir();
	$LogDir = $bpc->LogDir();
	$BinDir = $bpc->BinDir();
	%Conf   = $bpc->Conf();
	$Lang   = $bpc->Lang();
	$ConfigMTime = $bpc->ConfigMTime();
        umask($Conf{UmaskMode});
    } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) {
        $bpc->ConfigRead();
	$TopDir = $bpc->TopDir();
	$LogDir = $bpc->LogDir();
	$BinDir = $bpc->BinDir();
        %Conf   = $bpc->Conf();
        $Lang   = $bpc->Lang();
        $ConfigMTime = $bpc->ConfigMTime();
        umask($Conf{UmaskMode});
    }

    #
    # Default REMOTE_USER so in a miminal installation the user
    # has a sensible default.
    #
    $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );

    #
    # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
    # The latter requires .ht_access style authentication.  Replace this
    # code if you are using some other type of authentication, and have
    # a different way of getting the user name.
    #
    $MyURL  = $ENV{SCRIPT_NAME};
    $User   = $ENV{REMOTE_USER};

    #
    # Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint
    #
    $User   = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ );

    #
    # Clean up %ENV for taint checking
    #
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
    $ENV{PATH} = $Conf{MyPath};

    #
    # Verify we are running as the correct user
    #
    if ( $Conf{BackupPCUserVerify}
	    && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) {
	ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF);
This script needs to run as the user specified in \$Conf{BackupPCUser},
which is set to $Conf{BackupPCUser}.
<p>
This is an installation problem.  If you are using mod_perl then
it appears that Apache is not running as user $Conf{BackupPCUser}.
If you are not using mod_perl, then most like setuid is not working
properly on BackupPC_Admin.  Check the permissions on
$Conf{CgiDir}/BackupPC_Admin and look at the documentation.
EOF
    }

    if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
	$HostsMTime = $bpc->HostsMTime();
	$Hosts = $bpc->HostInfoRead();

	# turn moreUsers list into a hash for quick lookups
	foreach my $host (keys %$Hosts) {
	   $Hosts->{$host}{moreUsers} =
	       {map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) }
	}
    }

    #
    # Untaint the host name
    #
    if ( $In{host} =~ /^([\w.\s-]+)$/ ) {
	$In{host} = $1;
    } else {
	delete($In{host});
    }
}

sub timeStamp2
{
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
              = localtime($_[0] == 0 ? time : $_[0] );
    $mon++;
    if ( $Conf{CgiDateFormatMMDD} == 2 ) {
        $year += 1900;
        return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $min);
    } elsif ( $Conf{CgiDateFormatMMDD} ) {
        return sprintf("$mon/$mday %02d:%02d", $hour, $min);
    } else {
        return sprintf("$mday/$mon %02d:%02d", $hour, $min);
    }
}

sub HostLink
{
    my($host) = @_;
    my($s);
    if ( defined($Hosts->{$host}) || defined($Status{$host}) ) {
        $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
    } else {
        $s = $host;
    }
    return \$s;
}

sub UserLink
{
    my($user) = @_;
    my($s);

    return \$user if ( $user eq ""
                    || $Conf{CgiUserUrlCreate} eq "" );
    if ( $Conf{CgiUserHomePageCheck} eq ""
            || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
        $s = "<a href=\""
             . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
             . "\">$user</a>";
    } else {
        $s = $user;
    }
    return \$s;
}

sub EscHTML
{
    my($s) = @_;
    $s =~ s/&/&amp;/g;
    $s =~ s/\"/&quot;/g;
    $s =~ s/>/&gt;/g;
    $s =~ s/</&lt;/g;
    ### $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
    return \$s;
}

sub EscURI
{
    my($s) = @_;
    $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
    return \$s;
}

sub ErrorExit
{
    my(@mesg) = @_;
    my($head) = shift(@mesg);
    my($mesg) = join("</p>\n<p>", @mesg);

    if ( !defined($ENV{REMOTE_USER}) ) {
	$mesg .= <<EOF;
<p>
Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
installation problem.  BackupPC_Admin expects Apache to authenticate
the user and pass their user name into this script as the REMOTE_USER
environment variable.  See the documentation.
EOF
    }

    $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
                            if ( defined($bpc) );
    if ( !defined($Lang->{Error}) ) {
        $mesg = <<EOF if ( !defined($mesg) );
There is some problem with the BackupPC installation.
Please check the permissions on BackupPC_Admin.
EOF
        my $content = <<EOF;
${h1("Error: Unable to read config.pl or language strings!!")}
<p>$mesg</p>
EOF
        Header("BackupPC: Error", $content);
	Trailer();
    } else {
        my $content = eval("qq{$Lang->{Error____head}}");
        Header(eval("qq{$Lang->{Error}}"), $content);
	Trailer();
    }
    exit(1);
}

sub ServerConnect
{
    #
    # Verify that the server connection is ok
    #
    return if ( $bpc->ServerOK() );
    $bpc->ServerDisconnect();
    if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
        if ( CheckPermission() 
          && -f $Conf{ServerInitdPath}
          && $Conf{ServerInitdStartCmd} ne "" ) {
            my $content = eval("qq{$Lang->{Admin_Start_Server}}");
            Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content);
            Trailer();
            exit(1);
        } else {
            ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"));
        }
    }
}

sub GetStatusInfo