Return to lchtmldir CVS log

Up to [LON-CAPA] / loncom

Bug 5721.
Debug message should show the correct format for the expected arg.

    1: #!/usr/bin/perl
    2: 
    3: # The Learning Online Network with CAPA
    4: #
    5: # $Id: lchtmldir,v 1.21 2008/05/30 13:37:48 raeburn Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: #  lchtmldir - LONC-CAPA setuid script to:
   30: #              o If necessary, add a public_html directory 
   31: #                to the specified user home directory.
   32: #              o Set the permissions according to the authentication type.
   33: #
   34: #  Motivations:
   35: #     Originally, account creation would create a public_html
   36: #     directory for unix authorized people only.  It is possible to have
   37: #     Kerberos, internal and locally authorized 'users' which may be authors
   38: #     and hence need a properly owned an protected public_html directory
   39: #     to serve as their construction space.
   40: #
   41: #  Author:
   42: #    Ron Fox
   43: #    NSCL
   44: #    Michigan State University8
   45: #    East Lansing, MI 48824-1321
   46: #
   47: #   General flow of control:
   48: #   1. Validate process state (must be run as www).
   49: #   2. Validate parameters:  Need two parameters:
   50: #         o Homedir  - Home diretory of user 
   51: #         o Username - Name of the user.
   52: #         o AuthMode - Authentication mode, can be:
   53: #                      - unix
   54: #                      - internal
   55: #                      - krb4
   56: #                      - localauth
   57: #  3. Untaint the usename and home directory
   58: #
   59: #  4. As root if necessary, create $Homedir/public_html
   60: #  5. Set ownership/permissions according to authentication mode (AuthMode)
   61: #       - unix - ~owner:www/2775
   62: #       - krb4 - ~owner:www/2775
   63: #       - internal - www:www/2775
   64: #       - local    - www:www/2775
   65: #
   66: #
   67: #
   68: #   Take a few precautions to be sure that we're not vulnerable to trojan
   69: #   horses and other fine issues:
   70: #
   71: use strict; 
   72: use Fcntl qw(:mode);
   73: use DirHandle;
   74: use POSIX;
   75: use lib '/home/httpd/lib/perl/';
   76: use LONCAPA qw(:match);
   77: 
   78: $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';
   79: delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};
   80: 
   81: my $DEBUG = 1;                         # .nonzero -> Debug printing enabled.
   82: my $path_sep = "/";		# Unix like operating systems.
   83: 
   84: 
   85: # If the UID of the running process is not www exit with error.
   86: 
   87: if ($DEBUG) {
   88:     print("Checking uid...\n");
   89: }
   90: my $wwwid = getpwnam('www');
   91: &DisableRoot;
   92: if($wwwid != $>) {
   93:     if ($DEBUG) {
   94: 	print("User ID incorrect.  This program must be run as user 'www'\n");
   95:     }
   96:     exit 1;			# Exit with error status.
   97: }
   98: 
   99: # There must be three 'command line' parameters.  The first
  100: # is the home directory of the user.
  101: # The second is the name of the user.  This is only referenced
  102: # in code branches dealing with unix mode authentication.
  103: # The last is the authentication mode which must be one of unix, internal
  104: # krb4 or localauth.
  105: #   If there is an error in the argument count or countents, we exit with an
  106: # error.
  107: 
  108: if ($DEBUG) {
  109:     print("Checking parameters: \n");
  110: }
  111: if(@ARGV != 3) {
  112:     if($DEBUG) {
  113: 	print("Error: lchtmldir need 3 parameters \n");
  114:     }
  115:     exit 2;
  116: }
  117: my ($dir,$username,$authentication) = @ARGV;
  118: 
  119: if($DEBUG) {
  120:     print ("Directory = $dir \n");
  121:     print ("User      = $username \n");
  122:     print ("Authmode  = $authentication \n");
  123: 
  124: }
  125: 
  126: if( $authentication ne "unix:"     &&
  127:     $authentication ne "internal:" &&
  128:     $authentication !~ /^krb(4|5):(.*)/ &&
  129:     $authentication ne "localauth:") {
  130:     if($DEBUG) {
  131: 	print("Invalid authentication parameter: ".$authentication."\n");
  132: 	print("Should be one of-- unix: internal: krb4: krb5: localauth:\n");
  133:     }
  134:     exit 3;
  135: }
  136: 
  137: # Untaint the username.
  138: 
  139: my $match = $username =~ /^($match_username)$/;
  140: my $patt  = $1;
  141:  
  142: if($DEBUG) {
  143:    print("Username word match flag = ".$match."\n");
  144:     print("Match value = ".$patt."\n");
  145: }
  146: 
  147: my $safeuser = $patt;
  148: if($DEBUG) {
  149:     print("Save username = $safeuser \n");
  150: }
  151: if($username ne $safeuser) {
  152:     if($DEBUG) {
  153: 	print("User name $username had illegal characters\n");
  154:     }
  155:     exit 4;
  156: }
  157: 
  158: #untaint the base directory require that the dir contain only 
  159: # alphas, / numbers or underscores, and end in /$safeuser
  160: 
  161: 
  162: 
  163: my ($allowed_dir) = ($dir =~ m{(^([/]|$match_username)+)});
  164: 
  165: my $has_correct_end = ($dir =~ m{/\Q$safeuser\E$});
  166: 
  167: if(($allowed_dir ne $dir) or (!$has_correct_end)) {
  168:     if ($DEBUG) {
  169: 	print("Directory $dir is not a valid home for $safeuser\n");
  170:     }
  171:     exit 5;
  172: }
  173: 
  174: # As root, create the directory.
  175: 
  176: my $homedir = $allowed_dir;
  177: my $fulldir = $homedir."/public_html";
  178: 
  179: if($DEBUG) {
  180:     print("Full directory path is: $fulldir \n");
  181: }
  182: if(!( -e $homedir)) {
  183:     if($DEBUG) {
  184: 	print("User's home directory $homedir does not exist\n");
  185:     }
  186:     if ($authentication eq "unix:") {
  187:         exit 6;
  188:     }
  189: }
  190: if ($authentication eq "unix:") {
  191:     # check whether group $safeuser exists.
  192:     my $usergroups = `id -nG $safeuser`;
  193:     if (! grep /^$safeuser$/, split(/\s+/,$usergroups)) { 
  194:         if($DEBUG) {
  195:             print("Group \"$safeuser\" does not exist or $safeuser is not a member of that group.\n");
  196:         }
  197:         exit 7;
  198:     }
  199: }
  200: 
  201: 
  202: 
  203: &EnableRoot;
  204: 
  205: #  If authentication is internal and the top level directory exists
  206: #  give it the right permissions (in case this is a modification.
  207: 
  208: if ($authentication eq "internal:") {
  209:     chmod(0711, $homedir);	# so www can enter ~/public_html.
  210: }
  211: 
  212: &System("/bin/mkdir -p $fulldir")   unless (-e $fulldir);
  213:     unless(-e $fulldir."/index.html") {
  214: 	open OUT,">".$fulldir."/index.html";
  215: 	print OUT<<END;
  216: 	<html>
  217: 	<head>
  218: 	<title>$safeuser</title>
  219:         </head>
  220:         <body bgcolor="#ccffdd">
  221:         <h1>$safeuser Construction Space</h1>
  222:           <h2>
  223:             The Learning<i>Online</i> Network with Computer-Assisted Personalized Approach
  224:           </h2>
  225:           <p>
  226: This is your construction space within LON-CAPA, where you would construct resources which are meant to be
  227: used across courses and institutions.
  228:           </p>
  229:           <p>
  230: Material within this area can only be seen and edited by $safeuser and designated co-authors. To make
  231: it available to students and other instructors, the material needs to be published.
  232:           </p>
  233:         </body>
  234:        </html>
  235: END
  236:     close OUT;
  237:     }
  238: 
  239: &System("/bin/chmod  02770  $fulldir");
  240: &System("/bin/chmod  0770  $fulldir"."/index.html");
  241: 
  242: 
  243: # Based on the authentiation mode, set the ownership of the directory.
  244: 
  245: if($authentication eq "unix:") {	# Unix mode authentication...
  246:     print "Unix auth\n";
  247:     &System("/bin/chown -R   $safeuser:$safeuser"." ".$fulldir);
  248:     &JoinGroup($safeuser);
  249: } else {
  250:     # Internal, Kerberos, and Local authentication are for users
  251:     # who do not have unix accounts on the system.  Therefore we
  252:     # will give ownership of their public_html directories to www:www
  253:     # If the user is an internal auth user, the rest of the directory tree
  254:     # gets owned by root.  This chown is needed in case what's really happening
  255:     # is that a file system user is being demoted to internal user...
  256: 
  257:     if($authentication eq "internal:") {
  258: 	#  In case the user was a unix/filesystem authenticated user,
  259: 	#  we'll take a bit of time here to write  a script in the
  260: 	#  user's home directory that can reset ownerships and permissions
  261: 	#  back the way the used to be.
  262: 
  263: 	# This can take long enough for lond to time out, so we'll do it
  264: 	# in a separate process that we'll not wait for.
  265: 	#
  266: 	my $fpid = fork;
  267: 	if($fpid) {
  268: 	    &DisableRoot;
  269: 	    exit 0;
  270: 	} else {
  271: 	    print "Forked\n";
  272: 	    POSIX::setsid();	# Disassociate from parent.
  273: 	    print "Separate session\n";
  274: 	    &write_restore_script($homedir);
  275: 	    print "Restore script written\n";
  276: 	    &System("/bin/chown -R root:root ".$homedir);
  277: 	    &System("/bin/chown -R www:www  ".$fulldir);
  278: 	    print "Exiting\n";
  279: 	    exit 0;
  280: 	}
  281:     } else {
  282: 	&System("/bin/chown -R www:www  ".$fulldir);
  283:     }
  284: 
  285: }
  286: &DisableRoot;
  287: 
  288: exit 0;
  289: 
  290: #----------------------------------------------------------------------
  291: #
  292: #  Local utility procedures.
  293: #  These include:
  294: #     EnableRoot - Start running as root.
  295: #     DisableRoot- Stop running as root.
  296: #     JoinGroup  - Join www to the specified group.
  297: 
  298: # Turn on as root:
  299: 
  300: sub EnableRoot {
  301:     if ($wwwid==$>) {
  302: 	($<,$>)=($>,$<);
  303: 	($(,$))=($),$();
  304:     }
  305:     else {
  306: 	# root capability is already enabled
  307:     }
  308:     if($DEBUG) {
  309: 	print("Enable Root - id =  $> $<\n");
  310:     }
  311:     return $>;  
  312: }
  313: 
  314: sub DisableRoot {
  315:     if ($wwwid==$<) {
  316: 	($<,$>)=($>,$<);
  317: 	($(,$))=($),$();
  318:     }
  319:     else {
  320: 	# root capability is already disabled
  321:     }
  322:     if($DEBUG) {
  323: 	print("Disable root: id = ".$>."\n");
  324:     }
  325: }
  326: #
  327: #  Join the www user to the user's group.
  328: #  we must be running with euid as root at this time.
  329: #
  330: sub JoinGroup {
  331:     my $usergroup = shift;
  332: 
  333:     my $groups = `/usr/bin/groups www`;
  334:     # untaint
  335:     my ($safegroups)=($groups=~/:\s+([\s\w]+)/);
  336:     $groups=$safegroups;
  337:     chomp $groups; $groups=~s/^\S+\s+\:\s+//;
  338:     my @grouplist=split(/\s+/,$groups);
  339:     my @ugrouplist=grep {!/www|$usergroup/} @grouplist;
  340:     my $gl=join(',',(@ugrouplist,$usergroup));
  341:     if (&System('/usr/sbin/usermod','-G',$gl,'www')) {
  342: 	if($DEBUG) {
  343: 	    print "Error. Could not make www a member of the group ".
  344: 		"\"$usergroup\".\n";
  345: 	}
  346: 	exit 6;
  347:     }
  348:     if (-e '/var/run/httpd.pid') {
  349: 	open(PID,'/var/run/httpd.pid');
  350: 	my $pid=<PID>;
  351: 	close(PID);
  352: 	my ($safepid) = $pid=~ /(\d+)/;
  353: 	$pid = $safepid;
  354: 	if ($pid) {
  355: 	    my $status = system("kill -USR1 $safepid");
  356: 	}
  357:     }
  358: }
  359: 
  360: 
  361: 
  362: sub System {
  363:     my ($command,@args) = @_;
  364:     if($DEBUG) {
  365: 	print("system: $command with args ".join(' ',@args)."\n");
  366:     }
  367:     system($command,@args);
  368: }
  369: 
  370: 
  371: 
  372: 
  373: 
  374: #
  375: #   This file contains code to recursively process
  376: #   a Directory.  This is a bit more powerful
  377: #   than File::Find in that we pass the full
  378: #   stat info to the processing function.
  379: #     For each file in the specified directory subtree, 
  380: #   The user's Code reference is invoked for all files, regular and otherwise
  381: #   except:
  382: #      ., ..
  383: #
  384: #  Parameters:
  385: #     code_ref    - Code reference, invoked for each file in the tree.
  386: #                   as follows:  CodeRef(directory, name, statinfo)
  387: #                   directory the path to the directory holding the file.
  388: #                   name      the name of the file within Directory.
  389: #                   statinfo  a reference to the stat of the file.
  390: #     start_dir   - The starting point of the directory walk.
  391: #
  392: # NOTE:
  393: #   Yes, we could have just used File::Find, but since we have to get the
  394: #   stat anyway, this is actually simpler, as File::Find would have gotten
  395: #   the stat to figure out the file type and then we would have gotten it
  396: #   again.
  397: #
  398: 
  399: sub process_tree {
  400:     my ($code_ref, $start_dir)  = @_;
  401: 
  402:     my $dir = new DirHandle $start_dir; 
  403:     if (!defined($dir)) {
  404:         print "Failed to  open dirhandle: $start_dir\n";
  405:     }
  406: 
  407:     # Now iterate through this level of the tree:
  408: 
  409:     while (defined (my $name = $dir->read)) {
  410: 	next if $name =~/^\.\.?$/;       # Skip ., .. (see cookbook pg 319)
  411: 	
  412: 	my $full_name   = $start_dir.$path_sep.$name; # Full filename path.
  413: 	my @stat_info  = lstat($full_name);
  414: 	my $mode       = $stat_info[2];
  415: 	my $type       = $mode & 0170000; #  File type.
  416: 
  417: 	# Unless the file type is a symlink, call the user code:
  418: 
  419: 	unless ($type == S_IFLNK) {
  420: 	    &$code_ref($start_dir, $name, \@stat_info);
  421: 	}
  422: 
  423: 	# If the entry is a directory, we need to recurse:
  424: 
  425: 
  426: 	if (($type ==  S_IFDIR) != 0) {
  427: 	    &process_tree($code_ref, $full_name);
  428: 	}
  429:     }
  430: 
  431: }
  432: #
  433: #   Callback from process_tree to write the script lines
  434: #   requried to restore files to current ownership and permission.
  435: # Parameters:
  436: #    dir         - Name of the directory the file lives in.
  437: #    name        - Name of the file itself.
  438: #    statinfo    - Array from lstat called on the file.
  439: #
  440: #
  441: sub write_script {
  442:     my ($dir, $name, $statinfo) = @_;
  443: 
  444:     my $fullname = $dir.$path_sep.$name;
  445: 
  446:     #  We're going to '' the name, but we need to deal with embedded
  447:     #  ' characters.  Using " is much worse as we'd then have to
  448:     #  escape all the shell escapes too.  This way all we need
  449:     #  to do is replace ' with '\''
  450: 
  451:     $fullname =~ s/\'/\'\\\'\'/g;
  452: 
  453:     my $perms    = $statinfo->[2] & 0777; # Just permissions.
  454:     printf CHMODSCRIPT "chmod 0%o '%s'\n", $perms, $fullname;
  455:     printf CHMODSCRIPT "chown %d:%d '%s'\n", $statinfo->[4], $statinfo->[5], 
  456:                                          $fullname
  457: 
  458: 
  459: }
  460: # 
  461: #    Write a script in the user's home directory that can restore
  462: #    the permissions and ownerhips of all the files in the directory
  463: #    tree to their current ownerships and permissions.  This is done
  464: #    prior to making the user into an internally authenticated user
  465: #    in case they were previously file system authenticated and
  466: #    need to go back.
  467: #      The file we will create will be of the form
  468: #        restore_n.sh  Where n is a number that we will keep
  469: #   incrementing as needed until there isn't a file by that name.
  470: #   
  471: # Parameters:
  472: #    dir      - Path to the user's home directory.
  473: #
  474: sub write_restore_script {
  475:     my ($dir)   = @_;
  476: 
  477:     #   Create a unique file:
  478: 
  479:     my $version_number     = 0;
  480:     my $filename           = 'restore_'.$version_number.'.sh';
  481:     my $full_name           = $dir.$path_sep.$filename;
  482: 
  483:     while(-e $full_name) {
  484: 	$version_number++;
  485: 	$filename         = 'restore_'.$version_number.'.sh';
  486: 	$full_name        = $dir.$path_sep.$filename;
  487:     }
  488:     # $full_name is the full path of a file that does not yet exist
  489:     # of the form we want:
  490: 
  491:     open(CHMODSCRIPT, "> $full_name");
  492: 
  493:     &process_tree(\&write_script, $dir);
  494: 
  495:     close(CHMODSCRIPT);
  496: 
  497:     chmod(0750, $full_name);
  498: 
  499: }
  500: 
  501: 
  502: 
  503: