From d4dbe7f512bae83c09b7cdbb64aa9fac54673778 Mon Sep 17 00:00:00 2001 From: Heuzef Date: Fri, 4 Oct 2019 10:34:08 +0200 Subject: [PATCH] Remove Lib.pm --- Lib.pm | 626 -------------------------------------------------------------- update.sh | 1 - 2 files changed, 627 deletions(-) delete mode 100644 Lib.pm diff --git a/Lib.pm b/Lib.pm deleted file mode 100644 index 73fa85c..0000000 --- a/Lib.pm +++ /dev/null @@ -1,626 +0,0 @@ -#============================================================= -*-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 -# -# COPYRIGHT -# Copyright (C) 2003-2019 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 3 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, see . -# -#======================================================================== -# -# Version 4.3.1, released 14 Jul 2019. -# -# 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})) ) { - ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), < -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 $now = $_[0] == 0 ? time : $_[0]; - my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) - = localtime($now); - $mon++; - if ( $Conf{CgiDateFormatMMDD} == 2 ) { - $year += 1900; - return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $min); - } elsif ( $Conf{CgiDateFormatMMDD} ) { - # - # Add the year if the time is more than 330 days ago - # - if ( time - $now > 330 * 24 * 3600 ) { - $year -= 100; - return sprintf("$mon/$mday/%02d %02d:%02d", $year, $hour, $min); - } else { - return sprintf("$mon/$mday %02d:%02d", $hour, $min); - } - } else { - # - # Add the year if the time is more than 330 days ago - # - if ( time - $now > 330 * 24 * 3600 ) { - $year -= 100; - return sprintf("$mday/$mon/%02d %02d:%02d", $year, $hour, $min); - } else { - return sprintf("$mday/$mon %02d:%02d", $hour, $min); - } - } -} - -sub HostLink -{ - my($host) = @_; - my($s); - if ( defined($Hosts->{$host}) ) { - $s = "$host"; - } 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 = "$user"; - } else { - $s = $user; - } - return \$s; -} - -sub EscHTML -{ - my($s) = @_; - $s =~ s/&/&/g; - $s =~ s/\"/"/g; - $s =~ s/>/>/g; - $s =~ s/\n

", @mesg); - - if ( !defined($ENV{REMOTE_USER}) ) { - $mesg .= < -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 = <$mesg

-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}}"), - eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_error_message}}")); - } - } -} - -sub GetStatusInfo -{ - my($status) = @_; - ServerConnect(); - %Status = () if ( $status =~ /\bhosts\b/ ); - %StatusHost = () if ( $status =~ /\bhost\(/ ); - my $reply = $bpc->ServerMesg("status $status"); - $reply = $1 if ( $reply =~ /(.*)/s ); - eval($reply); - # ignore status related to admin jobs - if ( $status =~ /\bhosts\b/ ) { - foreach my $host ( grep(/admin/, keys(%Status)) ) { - delete($Status{$host}) if ( $bpc->isAdminJob($host) ); - } - delete($Status{$bpc->scgiJob}); - } -} - -sub ReadUserEmailInfo -{ - if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) { - do "$LogDir/UserEmailInfo.pl"; - $UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9]; - } -} - -# -# Check if the user is privileged. A privileged user can access -# any information (backup files, logs, status pages etc). -# -# A user is privileged if they belong to the group -# $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers} -# or they are the user assigned to a host in the host file. -# -sub CheckPermission -{ - my($host) = @_; - my $Privileged = 0; - - return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*" - || $host ne "" && !defined($Hosts->{$host}) ); - if ( $Conf{CgiAdminUserGroup} ne "" ) { - for ( split(/\s+/, $Conf{CgiAdminUserGroup}) ) { - my ($n, $p, $gid, $mem) = getgrnam($_); - $Privileged ||= ( $mem =~ /\b\Q$User\E\b/ ); - last if ( $Privileged ); - } - } - if ( $Conf{CgiAdminUsers} ne "" ) { - $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/); - $Privileged ||= $Conf{CgiAdminUsers} eq "*"; - } - $PrivAdmin = $Privileged; - return $Privileged if ( !defined($host) ); - - $Privileged ||= $User eq $Hosts->{$host}{user}; - $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User}); - return $Privileged; -} - -# -# Returns the list of hosts that should appear in the navigation bar -# for this user. If $getAll is set, the admin gets all the hosts. -# Otherwise, regular users get hosts for which they are the user or -# are listed in the moreUsers column in the hosts file. -# -sub GetUserHosts -{ - my($getAll) = @_; - my @hosts; - - if ( $getAll && CheckPermission() ) { - @hosts = sort keys %$Hosts; - } else { - @hosts = sort grep { $Hosts->{$_}{user} eq $User || - defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts); - } - return @hosts; -} - -# -# Given a host name tries to find the IP address. For non-dhcp hosts -# we just return the host name. For dhcp hosts we check the address -# the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP -# address for $host. (Later we should replace this with a broadcast -# nmblookup.) -# -sub ConfirmIPAddress -{ - my($host) = @_; - my $ipAddr = $host; - - if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp} - && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) { - $ipAddr = $1; - my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr); - if ( $netBiosHost ne $host ) { - my($tryIP); - GetStatusInfo("host(${EscURI($host)})"); - if ( defined($StatusHost{dhcpHostIP}) - && $StatusHost{dhcpHostIP} ne $ipAddr ) { - $tryIP = eval("qq{$Lang->{tryIP}}"); - ($netBiosHost, $netBiosUser) - = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP}); - } - if ( $netBiosHost ne $host ) { - ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"), - eval("qq{$Lang->{host_is_a_DHCP_host}}")); - } - $ipAddr = $StatusHost{dhcpHostIP}; - } - } - return $ipAddr; -} - -########################################################################### -# HTML layout subroutines -########################################################################### - -sub Header -{ - my($title, $content, $noBrowse, $contentSub, $contentPost) = @_; - my @adminLinks = ( - { link => "?action=status", name => $Lang->{Status}}, - { link => "?action=summary", name => $Lang->{PC_Summary}}, - { link => "?action=editConfig", name => $Lang->{CfgEdit_Edit_Config}, - priv => 1}, - { link => "?action=editConfig&newMenu=hosts", - name => $Lang->{CfgEdit_Edit_Hosts}, - priv => 1}, - { link => "?action=adminOpts", name => $Lang->{Admin_Options}, - priv => 1}, - { link => "?action=view&type=LOG", name => $Lang->{LOG_file}, - priv => 1}, - { link => "?action=LOGlist", name => $Lang->{Old_LOGs}, - priv => 1}, - { link => "?action=emailSummary", name => $Lang->{Email_summary}, - priv => 1}, - { link => "?action=queue", name => $Lang->{Current_queues}, - priv => 1}, - @{$Conf{CgiNavBarLinks} || []}, - ); - my $host = $In{host}; - - binmode(select, ":utf8"); - print $Cgi->header(-charset => "utf-8"); - print < - -$title - - -$Conf{CgiHeaders} - - - -