Annotation of loncom/lchtmldir, revision 1.21

1.7       albertel    1: #!/usr/bin/perl
1.1       foxr        2: 
                      3: # The Learning Online Network with CAPA
                      4: #
1.21    ! raeburn     5: # $Id: lchtmldir,v 1.20 2007/08/22 19:53:22 albertel Exp $
1.20      albertel    6: #
1.1       foxr        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
1.17      foxr       46: #
1.1       foxr       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: #
1.17      foxr       66: #
1.1       foxr       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; 
1.10      foxr       72: use Fcntl qw(:mode);
                     73: use DirHandle;
1.12      foxr       74: use POSIX;
1.18      raeburn    75: use lib '/home/httpd/lib/perl/';
                     76: use LONCAPA qw(:match);
1.1       foxr       77: 
                     78: $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';
                     79: delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};
                     80: 
1.12      foxr       81: my $DEBUG = 1;                         # .nonzero -> Debug printing enabled.
1.10      foxr       82: my $path_sep = "/";		# Unix like operating systems.
1.1       foxr       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: 
1.2       foxr      126: if( $authentication ne "unix:"     &&
                    127:     $authentication ne "internal:" &&
1.4       matthew   128:     $authentication !~ /^krb(4|5):(.*)/ &&
1.2       foxr      129:     $authentication ne "localauth:") {
1.1       foxr      130:     if($DEBUG) {
                    131: 	print("Invalid authentication parameter: ".$authentication."\n");
1.21    ! raeburn   132: 	print("Should be one of-- unix: internal: krb4: krb5: localauth:\n");
1.1       foxr      133:     }
                    134:     exit 3;
                    135: }
                    136: 
                    137: # Untaint the username.
                    138: 
1.18      raeburn   139: my $match = $username =~ /^($match_username)$/;
1.1       foxr      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: }
1.18      raeburn   151: if($username ne $safeuser) {
1.1       foxr      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: 
1.19      albertel  163: my ($allowed_dir) = ($dir =~ m{(^([/]|$match_username)+)});
1.1       foxr      164: 
1.19      albertel  165: my $has_correct_end = ($dir =~ m{/\Q$safeuser\E$});
                    166: 
                    167: if(($allowed_dir ne $dir) or (!$has_correct_end)) {
1.1       foxr      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: 
1.19      albertel  176: my $homedir = $allowed_dir;
1.9       foxr      177: my $fulldir = $homedir."/public_html";
                    178: 
1.1       foxr      179: if($DEBUG) {
                    180:     print("Full directory path is: $fulldir \n");
                    181: }
1.19      albertel  182: if(!( -e $homedir)) {
1.1       foxr      183:     if($DEBUG) {
1.19      albertel  184: 	print("User's home directory $homedir does not exist\n");
1.1       foxr      185:     }
1.4       matthew   186:     if ($authentication eq "unix:") {
                    187:         exit 6;
                    188:     }
1.1       foxr      189: }
1.16      albertel  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: 
1.17      foxr      201: 
                    202: 
1.1       foxr      203: &EnableRoot;
                    204: 
1.17      foxr      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: 
1.3       foxr      212: &System("/bin/mkdir -p $fulldir")   unless (-e $fulldir);
1.1       foxr      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>
1.5       www       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>
1.1       foxr      225:           <p>
1.5       www       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.
1.1       foxr      228:           </p>
                    229:           <p>
1.5       www       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.
1.1       foxr      232:           </p>
                    233:         </body>
                    234:        </html>
                    235: END
                    236:     close OUT;
                    237:     }
1.9       foxr      238: 
1.13      foxr      239: &System("/bin/chmod  02770  $fulldir");
                    240: &System("/bin/chmod  0770  $fulldir"."/index.html");
1.1       foxr      241: 
                    242: 
                    243: # Based on the authentiation mode, set the ownership of the directory.
                    244: 
1.2       foxr      245: if($authentication eq "unix:") {	# Unix mode authentication...
1.15      foxr      246:     print "Unix auth\n";
1.14      foxr      247:     &System("/bin/chown -R   $safeuser:$safeuser"." ".$fulldir);
1.6       albertel  248:     &JoinGroup($safeuser);
1.4       matthew   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
1.9       foxr      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:") {
1.11      foxr      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: 
1.12      foxr      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:     }
1.11      foxr      284: 
1.1       foxr      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) {
1.4       matthew   309: 	print("Enable Root - id =  $> $<\n");
1.1       foxr      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: }
1.15      foxr      326: #
                    327: #  Join the www user to the user's group.
                    328: #  we must be running with euid as root at this time.
                    329: #
1.1       foxr      330: sub JoinGroup {
                    331:     my $usergroup = shift;
                    332: 
                    333:     my $groups = `/usr/bin/groups www`;
1.6       albertel  334:     # untaint
1.8       albertel  335:     my ($safegroups)=($groups=~/:\s+([\s\w]+)/);
1.6       albertel  336:     $groups=$safegroups;
1.1       foxr      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:     }
1.15      foxr      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:     }
1.1       foxr      358: }
                    359: 
                    360: 
                    361: 
                    362: sub System {
1.6       albertel  363:     my ($command,@args) = @_;
1.1       foxr      364:     if($DEBUG) {
1.6       albertel  365: 	print("system: $command with args ".join(' ',@args)."\n");
1.1       foxr      366:     }
1.6       albertel  367:     system($command,@args);
1.1       foxr      368: }
                    369: 
                    370: 
                    371: 
                    372: 
1.10      foxr      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: #
1.11      foxr      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: #
1.10      foxr      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: }
1.11      foxr      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: }
1.10      foxr      500: 
                    501: 
                    502: 
                    503: 

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