From d4c7bf3e5f46fa78adbc7d55a2ca260e4748e23a Mon Sep 17 00:00:00 2001 From: Heuzef Date: Fri, 27 Sep 2019 11:16:14 +0200 Subject: [PATCH] get Lib.pm --- Lib.pm | 628 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 628 insertions(+) create mode 100644 Lib.pm diff --git a/Lib.pm b/Lib.pm new file mode 100644 index 0000000..0115359 --- /dev/null +++ b/Lib.pm @@ -0,0 +1,628 @@ +#============================================================= -*-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}, + { link => "?action=check", name => 'Check', + priv => 1}, + @{$Conf{CgiNavBarLinks} || []}, + ); + my $host = $In{host}; + + binmode(select, ":utf8"); + print $Cgi->header(-charset => "utf-8"); + print < + +$title + + +$Conf{CgiHeaders} + + + +