#!/usr/bin/perl
#
## Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA 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.
#
# LON-CAPA 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 LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
#
#
# 2/17/2009 - Ron FOx
# $Id:

http://www.lon-capa.org/
#
#  This file is a setuid script that allows lond or other www programs to install
#  a file in the lon capa table directory.
#
#  Invocation is as follows:
#    lcinstallfile  source_file_name dest_name
#
#  source_file_name - The full path for the source file.
#  dest_name        - The destination filename.  This will always be in the
#                     table file directory for this server.
#


use strict;

my $LONCAPAHOME = '/home/httpd;	     # Adjust if loncapa isn't installed here.

use lib "$LONCAPAHOME/perl/lib";
use LONCAPA;
use LONCAPA::Configuration;
use IO::File;

#
# Exit codes:
#
# 0    - ok
# 1    - Initial user ID was not www
# 3    - Usage error not enough command line arguments.
# 4    - source_file_name does not exist.
# 5    - destination file does not exist (not allowed to create new files).
# 6    - Some file operation failed.
#
$noprint = 0;
#
#   Ensure we are www:
#
# 

my $wwwid=getpwnam('www');
&disable_root_capability;
if ($wwwid!=$>) {
    print("User ID mismatch.  This program must be run as user 'www'\n")
	unless $noprint;
    exit 1;
}
#
#  Ensure we have the right number of command args:
#
my $argc = scalar(@ARGV);
if ($argc != 2) {
    print("Usage: lcinstallfile sourcepath destfile\n") unlesss $noprint;
    exit 2;
}
my $sorcepath = $ARGV[0];
my $destfile  = $ARGV[1];

# Ensure the source file exists, and root can write it.:

&enable_root_capability;
if (! -r $sourcepath) {
    &disable_root_capability;
    print("File $sourcepath either does not exist or cannot be read") unless $noprint;
    exit 4;
    
}
#
#  Figure out where the lontab directory is and create the destinationfile name:
#
#  We're not allowed to create new files, only replace existing files
#  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;

if (! -w $final_file) {
    &disable_root_capability;
    print("The $final_file is either not writable, or does not exist.\n") unless $noprint;
    exit 5;
}
#
# Copy the destination file to a backup:
#
if (!File::Copy($final_file, $final_file.'.backup')) {
    &disable_root_capability;
    print ("Failed to create backup copy of $final_file\n") unless $noprint;
    exit 6;
}

#  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.:

if (!File::Copy($sourcepath, $final_file.'.new')) {
    &disable_root_capability;
    print("Failed to copy $sourcepath to a tempfile\n") unless $noprint;
    exit 6;
}
#
#  Move the temp file to the final file
#
if (!rename($final_path.'.new', $final_path)) {
    &disable_root_capability;
    print ("Failed to move installed file $final_path.new to final resting place\n")
	unless $noprint;
    exit 6;
}

#  Ready to exit with success

&disble_root_capability;
print ("$sourcepaht installed to $final_file\n") unless $noprint;
exit 0;

#-------------------------------------------------------------------------
#
#  subs that control the setuid-edness of the program.

# ---------------------------------------------- have setuid script run as root
sub enable_root_capability {
    if ($wwwid==$>) {
	($<,$>)=($>,0);
	($(,$))=($),0);
    }
    else {
	# root capability is already enabled
    }
    return $>;
}

# ----------------------------------------------- have setuid script run as www
sub disable_root_capability {
    if ($wwwid==$<) {
	($<,$>)=($>,$<);
	($(,$))=($),$();
    }
    else {
	# root capability is already disabled
    }
}