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