#============================================================= -*-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-2009 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.2.0beta0, released 5 April 2009. # # 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___}}"), < 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 = "$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 and trashClean jobs if ( $status =~ /\bhosts\b/ ) { foreach my $host ( grep(/admin/, keys(%Status)) ) { delete($Status{$host}) if ( $bpc->isAdminJob($host) ); } delete($Status{$bpc->trashJob}); } } 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 "" ) { my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup}); $Privileged ||= ($mem =~ /\b\Q$User\E\b/); } 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 => "", 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(STDOUT, ":utf8"); print $Cgi->header(-charset => "utf-8"); print < $title $Conf{CgiHeaders}
EOF if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) { print "
"; NavSectionTitle("${EscHTML($host)}"); print < \n"; } print("
\n$content\n"); if ( defined($contentSub) && ref($contentSub) eq "CODE" ) { while ( (my $s = &$contentSub()) ne "" ) { print($s); } } print($contentPost) if ( defined($contentPost) ); print <

EOF } sub Trailer { print < EOF } sub NavSectionTitle { my($head) = @_; print <$head
EOF } sub NavSectionStart { } sub NavSectionEnd { } sub NavLink { my($link, $text) = @_; if ( defined($link) ) { my($class); $class = " class=\"NavCurrent\"" if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/ || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ ); $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ ); print <$text EOF } else { print < EOF } } sub h1 { my($str) = @_; return \<$str EOF } sub h2 { my($str) = @_; return \<$str EOF }