Annotation of loncom/lcinstallfile, revision 1.1

1.1     ! foxr        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: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>