Return to lcinstallfile CVS log

Up to [LON-CAPA] / loncom

Initial un-debugged version.

    1: #!/usr/bin/perl
    2: #
    3: ## Copyright Michigan State University Board of Trustees
    4: #
    5: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    6: #
    7: # LON-CAPA is free software; you can redistribute it and/or modify
    8: # it under the terms of the GNU General Public License as published by
    9: # the Free Software Foundation; either version 2 of the License, or 
   10: # (at your option) any later version.
   11: #
   12: # LON-CAPA is distributed in the hope that it will be useful,
   13: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: # GNU General Public License for more details.
   16: #
   17: # You should have received a copy of the GNU General Public License
   18: # along with LON-CAPA; if not, write to the Free Software
   19: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   20: #
   21: # /home/httpd/html/adm/gpl.txt
   22: #
   23: #
   24: #
   25: # 2/17/2009 - Ron FOx
   26: # $Id:
   27: 
   28: http://www.lon-capa.org/
   29: #
   30: #  This file is a setuid script that allows lond or other www programs to install
   31: #  a file in the lon capa table directory.
   32: #
   33: #  Invocation is as follows:
   34: #    lcinstallfile  source_file_name dest_name
   35: #
   36: #  source_file_name - The full path for the source file.
   37: #  dest_name        - The destination filename.  This will always be in the
   38: #                     table file directory for this server.
   39: #
   40: 
   41: 
   42: use strict;
   43: 
   44: my $LONCAPAHOME = '/home/httpd;	     # Adjust if loncapa isn't installed here.
   45: 
   46: use lib "$LONCAPAHOME/perl/lib";
   47: use LONCAPA;
   48: use LONCAPA::Configuration;
   49: use IO::File;
   50: 
   51: #
   52: # Exit codes:
   53: #
   54: # 0    - ok
   55: # 1    - Initial user ID was not www
   56: # 3    - Usage error not enough command line arguments.
   57: # 4    - source_file_name does not exist.
   58: # 5    - destination file does not exist (not allowed to create new files).
   59: # 6    - Some file operation failed.
   60: #
   61: $noprint = 0;
   62: #
   63: #   Ensure we are www:
   64: #
   65: # 
   66: 
   67: my $wwwid=getpwnam('www');
   68: &disable_root_capability;
   69: if ($wwwid!=$>) {
   70:     print("User ID mismatch.  This program must be run as user 'www'\n")
   71: 	unless $noprint;
   72:     exit 1;
   73: }
   74: #
   75: #  Ensure we have the right number of command args:
   76: #
   77: my $argc = scalar(@ARGV);
   78: if ($argc != 2) {
   79:     print("Usage: lcinstallfile sourcepath destfile\n") unlesss $noprint;
   80:     exit 2;
   81: }
   82: my $sorcepath = $ARGV[0];
   83: my $destfile  = $ARGV[1];
   84: 
   85: # Ensure the source file exists, and root can write it.:
   86: 
   87: &enable_root_capability;
   88: if (! -r $sourcepath) {
   89:     &disable_root_capability;
   90:     print("File $sourcepath either does not exist or cannot be read") unless $noprint;
   91:     exit 4;
   92:     
   93: }
   94: #
   95: #  Figure out where the lontab directory is and create the destinationfile name:
   96: #
   97: #  We're not allowed to create new files, only replace existing files
   98: #  so ensure that the final destination file actually exists.
   99: #
  100: my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
  101: my %config      = %{$configvars};
  102: my $tab_dir     = $config{'lonTabDir'};
  103: 
  104: my $final_file  = $tabdir.'/'.$destfile;
  105: 
  106: if (! -w $final_file) {
  107:     &disable_root_capability;
  108:     print("The $final_file is either not writable, or does not exist.\n") unless $noprint;
  109:     exit 5;
  110: }
  111: #
  112: # Copy the destination file to a backup:
  113: #
  114: if (!File::Copy($final_file, $final_file.'.backup')) {
  115:     &disable_root_capability;
  116:     print ("Failed to create backup copy of $final_file\n") unless $noprint;
  117:     exit 6;
  118: }
  119: 
  120: #  Install the new file to a temp file in the same dir so it can be mv'd in place
  121: #  this prevents the possibility we wind up with a partial file.:
  122: 
  123: if (!File::Copy($sourcepath, $final_file.'.new')) {
  124:     &disable_root_capability;
  125:     print("Failed to copy $sourcepath to a tempfile\n") unless $noprint;
  126:     exit 6;
  127: }
  128: #
  129: #  Move the temp file to the final file
  130: #
  131: if (!rename($final_path.'.new', $final_path)) {
  132:     &disable_root_capability;
  133:     print ("Failed to move installed file $final_path.new to final resting place\n")
  134: 	unless $noprint;
  135:     exit 6;
  136: }
  137: 
  138: #  Ready to exit with success
  139: 
  140: &disble_root_capability;
  141: print ("$sourcepaht installed to $final_file\n") unless $noprint;
  142: exit 0;
  143: 
  144: #-------------------------------------------------------------------------
  145: #
  146: #  subs that control the setuid-edness of the program.
  147: 
  148: # ---------------------------------------------- have setuid script run as root
  149: sub enable_root_capability {
  150:     if ($wwwid==$>) {
  151: 	($<,$>)=($>,0);
  152: 	($(,$))=($),0);
  153:     }
  154:     else {
  155: 	# root capability is already enabled
  156:     }
  157:     return $>;
  158: }
  159: 
  160: # ----------------------------------------------- have setuid script run as www
  161: sub disable_root_capability {
  162:     if ($wwwid==$<) {
  163: 	($<,$>)=($>,$<);
  164: 	($(,$))=($),$();
  165:     }
  166:     else {
  167: 	# root capability is already disabled
  168:     }
  169: }