version 1.2, 2009/02/24 11:52:03
|
version 1.4, 2009/05/13 15:04:03
|
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/ |
# |
# |
Line 41
|
Line 42
|
|
|
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 "/home/httpd/lib/perl"; |
|
use LONCAPA; |
use LONCAPA; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use IO::File; |
use IO::File; |
Line 62 use File::Copy;
|
Line 61 use File::Copy;
|
# 6 - Some file operation failed. |
# 6 - Some file operation failed. |
# 7 - Invalid table filename. |
# 7 - Invalid table filename. |
# |
# |
my $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; |
Line 80 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") unless $noprint; |
print("Usage: lcinstallfile sourcepath destfile had $argc parameters\n") unless $noprint; |
exit 2; |
exit 2; |
} |
} |
my $sourcepath = $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.: |
Line 96 my $destfile = $ARGV[1];
|
Line 97 my $destfile = $ARGV[1];
|
# loncapa table files are all of the form. |
# loncapa table files are all of the form. |
# something.tab where something is all letters and _'s. |
# something.tab where something is all letters and _'s. |
# |
# |
if ($sourcepath =~ /^(\w+\.tab)$/) { |
if ($sourcepath =~ /^([\w\/]+\.\w+)$/) { |
$sourcepath = $1; |
$sourcepath = $1; |
} else { |
} else { |
print ("Invalid characters in filename $sourcepath \n") unless $noprint; |
print ("Invalid characters in filename '$sourcepath' \n") unless $noprint; |
exit 7; |
exit 7; |
} |
} |
|
|
Line 117 if (! -r $sourcepath) {
|
Line 118 if (! -r $sourcepath) {
|
# 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 = %{$config_vars}; |
|
my $tab_dir = $config{'lonTabDir'}; |
|
|
|
my $final_file = $tab_dir.'/'.$destfile; |
|
|
|
# |
# |
# Now sanitize the final file: |
# Now sanitize the final file: |
|
|
if ($final_file =~ /^([\w\/]+\.tab)$/) { |
my $final_file; |
|
if ($destfile =~ /^([\w\/]+\.\w+)$/) { |
$final_file = $1; |
$final_file = $1; |
} else { |
} else { |
print ("$final_file failed regexp match\n") unless $noprint; |
print ("'$final_file' failed regexp match\n") unless $noprint; |
exit 7; |
exit 7; |
} |
} |
|
|
Line 182 sub enable_root_capability {
|
Line 180 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 $>; |
} |
} |
|
|
Line 194 sub disable_root_capability {
|
Line 192 sub disable_root_capability {
|
if ($wwwid==$<) { |
if ($wwwid==$<) { |
($<,$>)=($>,$<); |
($<,$>)=($>,$<); |
($(,$))=($),$(); |
($(,$))=($),$(); |
} |
} else { |
else { |
|
# root capability is already disabled |
# root capability is already disabled |
} |
} |
} |
} |