version 1.1, 2009/02/20 11:26:34
|
version 1.5, 2010/10/12 10:14:25
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# |
# |
## Copyright Michigan State University Board of Trustees |
# Copyright Michigan State University Board of Trustees |
|
# |
|
# $Id$ |
# |
# |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# |
# |
Line 22
|
Line 24
|
# |
# |
# |
# |
# |
# |
# 2/17/2009 - Ron FOx |
# 2/17/2009 - Ron Fox |
# |
# |
|
# http://www.lon-capa.org/ |
http://www.lon-capa.org/ |
|
# |
# |
# This file is a setuid script that allows lond or other www programs to install |
# This file is a setuid script that allows lond or other www programs to install |
# a file in the lon capa table directory. |
# a file in the lon capa table directory. |
Line 41 http://www.lon-capa.org/
|
Line 42 http://www.lon-capa.org/
|
|
|
use strict; |
use strict; |
|
|
my $LONCAPAHOME = '/home/httpd; # Adjust if loncapa isn't installed here. |
use lib "/home/httpd/lib/perl"; # Adjust if loncapa lib isn't installed here. |
|
|
use lib "$LONCAPAHOME/perl/lib"; |
|
use LONCAPA; |
use LONCAPA; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use IO::File; |
use IO::File; |
|
use File::Copy; |
|
|
|
|
|
|
# |
# |
# Exit codes: |
# Exit codes: |
Line 57 use IO::File;
|
Line 59 use IO::File;
|
# 4 - source_file_name does not exist. |
# 4 - source_file_name does not exist. |
# 5 - destination file does not exist (not allowed to create new files). |
# 5 - destination file does not exist (not allowed to create new files). |
# 6 - Some file operation failed. |
# 6 - Some file operation failed. |
|
# 7 - Invalid table filename. |
# |
# |
$noprint = 0; |
my $noprint = 1; |
# |
# |
# Ensure we are www: |
# Ensure we are www: |
# |
# |
# |
# |
|
print ("In lcinstallfile\n") unless $noprint; |
|
|
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
&disable_root_capability; |
#&disable_root_capability; |
if ($wwwid!=$>) { |
if ($wwwid!=$<) { |
print("User ID mismatch. This program must be run as user 'www'\n") |
print("User ID mismatch. This program must be run as user 'www'\n") |
unless $noprint; |
unless $noprint; |
exit 1; |
exit 1; |
Line 76 if ($wwwid!=$>) {
|
Line 80 if ($wwwid!=$>) {
|
# |
# |
my $argc = scalar(@ARGV); |
my $argc = scalar(@ARGV); |
if ($argc != 2) { |
if ($argc != 2) { |
print("Usage: lcinstallfile sourcepath destfile\n") unlesss $noprint; |
print("Usage: lcinstallfile sourcepath destfile had $argc parameters\n") unless $noprint; |
exit 2; |
exit 2; |
} |
} |
my $sorcepath = $ARGV[0]; |
my $sourcepath = $ARGV[0]; |
my $destfile = $ARGV[1]; |
my $destfile = $ARGV[1]; |
|
|
|
print("From: $sourcepath to: $destfile\n") unless $noprint; |
|
|
|
|
# Ensure the source file exists, and root can write it.: |
# Ensure the source file exists, and root can write it.: |
|
|
&enable_root_capability; |
# since this is a setuid program, the sourcepath and destfile |
|
# must be pattern extracted else they are considered insecure and |
|
# therefore not validated. |
|
# loncapa table files are all of the form. |
|
# something.tab where something is all letters and _'s. |
|
# |
|
if ($sourcepath =~ /^([\w\/]+\.\w+)$/) { |
|
$sourcepath = $1; |
|
} else { |
|
print ("Invalid characters in filename '$sourcepath' \n") unless $noprint; |
|
exit 7; |
|
} |
|
|
|
|
if (! -r $sourcepath) { |
if (! -r $sourcepath) { |
&disable_root_capability; |
|
print("File $sourcepath either does not exist or cannot be read") unless $noprint; |
print("File $sourcepath either does not exist or cannot be read") unless $noprint; |
exit 4; |
exit 4; |
|
|
} |
} |
|
&enable_root_capability; |
|
|
# |
# |
# Figure out where the lontab directory is and create the destinationfile name: |
# Figure out where the lontab directory is and create the destinationfile name: |
# |
# |
# We're not allowed to create new files, only replace existing files |
# We're not allowed to create new files, only replace existing files |
# so ensure that the final destination file actually exists. |
# so ensure that the final destination file actually exists. |
# |
# |
my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
my %config = %{$configvars}; |
|
my $tab_dir = $config{'lonTabDir'}; |
|
|
|
my $final_file = $tabdir.'/'.$destfile; |
|
|
# |
|
# Now sanitize the final file: |
|
|
|
my $final_file; |
|
if ($destfile =~ /^([\w\/]+\.\w+)$/) { |
|
$final_file = $1; |
|
} else { |
|
print ("'$final_file' failed regexp match\n") unless $noprint; |
|
exit 7; |
|
} |
|
|
if (! -w $final_file) { |
if (! -w $final_file) { |
&disable_root_capability; |
&disable_root_capability; |
Line 111 if (! -w $final_file) {
|
Line 139 if (! -w $final_file) {
|
# |
# |
# Copy the destination file to a backup: |
# Copy the destination file to a backup: |
# |
# |
if (!File::Copy($final_file, $final_file.'.backup')) { |
if (!copy($final_file, $final_file.'.backup')) { |
&disable_root_capability; |
&disable_root_capability; |
print ("Failed to create backup copy of $final_file\n") unless $noprint; |
print ("Failed to create backup copy of $final_file\n") unless $noprint; |
exit 6; |
exit 6; |
} |
} |
|
&enable_root_capability; |
|
|
# Install the new file to a temp file in the same dir so it can be mv'd in place |
# Install the new file to a temp file in the same dir so it can be mv'd in place |
# this prevents the possibility we wind up with a partial file.: |
# this prevents the possibility we wind up with a partial file.: |
|
|
if (!File::Copy($sourcepath, $final_file.'.new')) { |
if (!copy($sourcepath, $final_file.'.new')) { |
&disable_root_capability; |
&disable_root_capability; |
print("Failed to copy $sourcepath to a tempfile\n") unless $noprint; |
print("Failed to copy $sourcepath to a tempfile\n") unless $noprint; |
exit 6; |
exit 6; |
Line 128 if (!File::Copy($sourcepath, $final_file
|
Line 157 if (!File::Copy($sourcepath, $final_file
|
# |
# |
# Move the temp file to the final file |
# Move the temp file to the final file |
# |
# |
if (!rename($final_path.'.new', $final_path)) { |
if (!rename($final_file.'.new', $final_file)) { |
&disable_root_capability; |
&disable_root_capability; |
print ("Failed to move installed file $final_path.new to final resting place\n") |
print ("Failed to move installed file $final_file.new to final resting place\n") |
unless $noprint; |
unless $noprint; |
exit 6; |
exit 6; |
} |
} |
|
|
# Ready to exit with success |
# Ready to exit with success |
|
|
&disble_root_capability; |
&disable_root_capability; |
print ("$sourcepaht installed to $final_file\n") unless $noprint; |
print ("$sourcepath installed to $final_file\n") unless $noprint; |
exit 0; |
exit 0; |
|
|
|
|
#------------------------------------------------------------------------- |
#------------------------------------------------------------------------- |
# |
# |
# subs that control the setuid-edness of the program. |
# subs that control the setuid-edness of the program. |
|
|
# ---------------------------------------------- have setuid script run as root |
# have setuid script run as root |
sub enable_root_capability { |
sub enable_root_capability { |
if ($wwwid==$>) { |
if ($wwwid==$>) { |
($<,$>)=($>,0); |
($<,$>)=($>,0); |
($(,$))=($),0); |
($(,$))=($),0); |
} |
} else { |
else { |
|
# root capability is already enabled |
# root capability is already enabled |
} |
} |
|
print ("Effective uid = $>\n"); |
return $>; |
return $>; |
} |
} |
|
|
# ----------------------------------------------- have setuid script run as www |
# have setuid script run as www |
sub disable_root_capability { |
sub disable_root_capability { |
if ($wwwid==$<) { |
if ($wwwid==$<) { |
($<,$>)=($>,$<); |
($<,$>)=($>,$<); |
($(,$))=($),$(); |
($(,$))=($),$(); |
} |
} else { |
else { |
|
# root capability is already disabled |
# root capability is already disabled |
} |
} |
} |
} |