Return to lcinstallfile CVS log

Up to [LON-CAPA] / loncom

Debugged lond/lcinstallfile support for cluster administration of
dns_hosts.tab and dns_domain.tab  see also clusteradmin in this directory..

    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 "/home/httpd/lib/perl";
   47: use LONCAPA;
   48: use LONCAPA::Configuration;
   49: use IO::File;
   50: use File::Copy;
   51: 
   52: 
   53: 
   54: #
   55: # Exit codes:
   56: #
   57: # 0    - ok
   58: # 1    - Initial user ID was not www
   59: # 3    - Usage error not enough command line arguments.
   60: # 4    - source_file_name does not exist.
   61: # 5    - destination file does not exist (not allowed to create new files).
   62: # 6    - Some file operation failed.
   63: # 7    - Invalid table filename.
   64: #
   65: my $noprint = 1;
   66: #
   67: #   Ensure we are www:
   68: #
   69: # 
   70: print ("In lcinstallfile\n") unless $noprint;
   71: 
   72: my $wwwid=getpwnam('www');
   73: &disable_root_capability;
   74: if ($wwwid!=$>) {
   75:     print("User ID mismatch.  This program must be run as user 'www'\n")
   76: 	unless $noprint;
   77:     exit 1;
   78: }
   79: #
   80: #  Ensure we have the right number of command args:
   81: #
   82: my $argc = scalar(@ARGV);
   83: if ($argc != 2) {
   84:     print("Usage: lcinstallfile sourcepath destfile had $argc parameters\n") unless $noprint;
   85:     exit 2;
   86: }
   87: my $sourcepath = $ARGV[0];
   88: my $destfile  = $ARGV[1];
   89: 
   90: print("From: $sourcepath to: $destfile\n") unless $noprint;
   91: 
   92: 
   93: # Ensure the source file exists, and root can write it.:
   94: 
   95: # since this is a setuid program, the sourcepath and destfile
   96: # must be pattern extracted else they are considered insecure and
   97: # therefore not validated.  
   98: # loncapa table files are all of the form.
   99: #  something.tab where something is all letters and _'s.
  100: #
  101: if ($sourcepath =~ /^([\w\/]+\.\w+)$/) {
  102:     $sourcepath = $1;
  103: } else {
  104:     print ("Invalid characters in filename '$sourcepath' \n") unless $noprint;
  105:     exit 7;
  106: }
  107: 
  108: 
  109: if (! -r $sourcepath) {
  110:     print("File $sourcepath either does not exist or cannot be read") unless $noprint;
  111:     exit 4;
  112:     
  113: }
  114: &enable_root_capability;
  115: 
  116: #
  117: #  Figure out where the lontab directory is and create the destinationfile name:
  118: #
  119: #  We're not allowed to create new files, only replace existing files
  120: #  so ensure that the final destination file actually exists.
  121: #
  122: 
  123: 
  124: #
  125: # Now sanitize the final file:
  126: 
  127: my $final_file;
  128: if ($destfile =~ /^([\w\/]+\.\w+)$/) {
  129:     $final_file = $1;
  130: } else {
  131:     print ("'$final_file' failed regexp match\n") unless $noprint;
  132:     exit 7;
  133: }
  134: 
  135: if (! -w $final_file) {
  136:     &disable_root_capability;
  137:     print("The $final_file is either not writable, or does not exist.\n") unless $noprint;
  138:     exit 5;
  139: }
  140: #
  141: # Copy the destination file to a backup:
  142: #
  143: if (!copy($final_file, $final_file.'.backup')) {
  144:     &disable_root_capability;
  145:     print ("Failed to create backup copy of $final_file\n") unless $noprint;
  146:     exit 6;
  147: }
  148: &enable_root_capability;
  149: 
  150: #  Install the new file to a temp file in the same dir so it can be mv'd in place
  151: #  this prevents the possibility we wind up with a partial file.:
  152: 
  153: if (!copy($sourcepath, $final_file.'.new')) {
  154:     &disable_root_capability;
  155:     print("Failed to copy $sourcepath to a tempfile\n") unless $noprint;
  156:     exit 6;
  157: }
  158: #
  159: #  Move the temp file to the final file
  160: #
  161: if (!rename($final_file.'.new', $final_file)) {
  162:     &disable_root_capability;
  163:     print ("Failed to move installed file $final_file.new to final resting place\n")
  164: 	unless $noprint;
  165:     exit 6;
  166: }
  167: 
  168: #  Ready to exit with success
  169: 
  170: &disable_root_capability;
  171: print ("$sourcepath installed to $final_file\n") unless $noprint;
  172: exit 0;
  173: 
  174: 
  175: #-------------------------------------------------------------------------
  176: #
  177: #  subs that control the setuid-edness of the program.
  178: 
  179: #  have setuid script run as root
  180: sub enable_root_capability {
  181:     if ($wwwid==$>) {
  182: 	($<,$>)=($>,0);
  183: 	($(,$))=($),0);
  184:     }
  185:     else {
  186: 	# root capability is already enabled
  187:     }
  188:     print ("Effective uid = $>\n");
  189:     return $>;
  190: }
  191: 
  192: #  have setuid script run as www
  193: sub disable_root_capability {
  194:     if ($wwwid==$<) {
  195: 	($<,$>)=($>,$<);
  196: 	($(,$))=($),$();
  197:     }
  198:     else {
  199: 	# root capability is already disabled
  200:     }
  201: }