File:
[LON-CAPA] /
loncom /
interface /
loncreateuser.pm
Revision
1.27:
download - view:
text,
annotated -
select for diffs
Tue Feb 12 21:42:18 2002 UTC (22 years, 7 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
Reworked &phase_three, cleaned up logic mostly. Did a little to make it more
intelligent. Added check for MAU permissions before changing user permissions
(it is a superfluous check, but I'll sleep a little easier with this in the
code). Fixed bug introduced in the last commit which reversed the logic on
whether or not the user was able to revoke roles. Many cleanups to indentation
and a few added comments.
1: # The LearningOnline Network with CAPA
2: # Create a user
3: #
4: # $Id: loncreateuser.pm,v 1.27 2002/02/12 21:42:18 matthew Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # (Create a course
29: # (My Desk
30: #
31: # (Internal Server Error Handler
32: #
33: # (Login Screen
34: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
35: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
36: #
37: # YEAR=2001
38: # 3/1/1 Gerd Kortemeyer)
39: #
40: # 3/1 Gerd Kortemeyer)
41: #
42: # 2/14 Gerd Kortemeyer)
43: #
44: # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
45: # April Guy Albertelli
46: # 05/10,10/16 Gerd Kortemeyer
47: # 11/12,11/13,11/15 Scott Harrison
48: # 02/11/02 Matthew Hall
49: #
50: # $Id: loncreateuser.pm,v 1.27 2002/02/12 21:42:18 matthew Exp $
51: ###
52:
53: package Apache::loncreateuser;
54:
55: use strict;
56: use Apache::Constants qw(:common :http);
57: use Apache::lonnet;
58:
59: my $loginscript; # piece of javascript used in two separate instances
60: my $generalrule;
61: my $authformnop;
62: my $authformkrb;
63: my $authformint;
64: my $authformfsys;
65: my $authformloc;
66:
67: BEGIN {
68: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
69: my $krbdefdom=$1;
70: $krbdefdom=~tr/a-z/A-Z/;
71: $authformnop=(<<END);
72: <p>
73: <input type="radio" name="login" value="" checked="checked"
74: onClick="clicknop(this.form);">
75: Do not change login data
76: </p>
77: END
78: $authformkrb=(<<END);
79: <p>
80: <input type=radio name=login value=krb onClick="clickkrb(this.form);">
81: Kerberos authenticated with domain
82: <input type=text size=10 name=krbdom onChange="setkrb(this.form);">
83: </p>
84: END
85: $authformint=(<<END);
86: <p>
87: <input type=radio name=login value=int onClick="clickint(this.form);">
88: Internally authenticated (with initial password
89: <input type=text size=10 name=intpwd onChange="setint(this.form);">)
90: </p>
91: END
92: $authformfsys=(<<END);
93: <p>
94: <input type=radio name=login value=fsys onClick="clickfsys(this.form);">
95: Filesystem authenticated (with initial password
96: <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">)
97: </p>
98: END
99: $authformloc=(<<END);
100: <p>
101: <input type=radio name=login value=loc onClick="clickloc(this.form);" />
102: Local Authentication with argument
103: <input type=text size=10 name=locarg onChange="setloc(this.form);" />
104: </p>
105: END
106: $loginscript=(<<ENDLOGINSCRIPT);
107: <script>
108: function setkrb(vf) {
109: if (vf.krbdom.value!='') {
110: vf.login[0].checked=true;
111: vf.krbdom.value=vf.krbdom.value.toUpperCase();
112: vf.intpwd.value='';
113: vf.fsyspwd.value='';
114: vf.locarg.value='';
115: }
116: }
117:
118: function setint(vf) {
119: if (vf.intpwd.value!='') {
120: vf.login[1].checked=true;
121: vf.krbdom.value='';
122: vf.fsyspwd.value='';
123: vf.locarg.value='';
124: }
125: }
126:
127: function setfsys(vf) {
128: if (vf.fsyspwd.value!='') {
129: vf.login[2].checked=true;
130: vf.krbdom.value='';
131: vf.intpwd.value='';
132: vf.locarg.value='';
133: }
134: }
135:
136: function setloc(vf) {
137: if (vf.locarg.value!='') {
138: vf.login[3].checked=true;
139: vf.krbdom.value='';
140: vf.intpwd.value='';
141: vf.fsyspwd.value='';
142: }
143: }
144:
145: function clicknop(vf) {
146: vf.krbdom.value='';
147: vf.intpwd.value='';
148: vf.fsyspwd.value='';
149: vf.locarg.value='';
150: }
151:
152: function clickkrb(vf) {
153: vf.krbdom.value='$krbdefdom';
154: vf.intpwd.value='';
155: vf.fsyspwd.value='';
156: vf.locarg.value='';
157: }
158:
159: function clickint(vf) {
160: vf.krbdom.value='';
161: vf.fsyspwd.value='';
162: vf.locarg.value='';
163: }
164:
165: function clickfsys(vf) {
166: vf.krbdom.value='';
167: vf.intpwd.value='';
168: vf.locarg.value='';
169: }
170:
171: function clickloc(vf) {
172: vf.krbdom.value='';
173: vf.intpwd.value='';
174: vf.fsyspwd.value='';
175: }
176: </script>
177: ENDLOGINSCRIPT
178: $generalrule=<<END;
179: <p>
180: <i>As a general rule, only authors or co-authors should be filesystem
181: authenticated (which allows access to the server filesystem).</i>
182: </p>
183: END
184: }
185:
186: # =================================================================== Phase one
187:
188: sub phase_one {
189: my $r=shift;
190: my $defdom=$ENV{'user.domain'};
191: $r->print(<<ENDDOCUMENT);
192: <html>
193: <head>
194: <title>The LearningOnline Network with CAPA</title>
195: </head>
196: <body bgcolor="#FFFFFF">
197: <h1>Create User, Change User Privileges</h1>
198: <form action=/adm/createuser method=post>
199: <input type=hidden name=phase value=two>
200: Username: <input type=text size=15 name=ccuname><br>
201: Domain: <input type=text size=15 name=ccdomain value=$defdom><p>
202: <input type=submit value="Continue">
203: </form>
204: </body>
205: </html>
206: ENDDOCUMENT
207: }
208:
209: # =================================================================== Phase two
210: sub phase_two {
211: my $r=shift;
212: my $ccuname=$ENV{'form.ccuname'};
213: my $ccdomain=$ENV{'form.ccdomain'};
214:
215: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
216: my $krbdefdom=$1;
217: $krbdefdom=~tr/a-z/A-Z/;
218:
219: my $defdom=$ENV{'user.domain'};
220:
221: $ccuname=~s/\W//g;
222: $ccdomain=~s/\W//g;
223: my $dochead =<<"ENDDOCHEAD";
224: <html>
225: <head>
226: <title>The LearningOnline Network with CAPA</title>
227: <script>
228:
229: function pclose() {
230: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
231: "height=350,width=350,scrollbars=no,menubar=no");
232: parmwin.close();
233: }
234:
235: function pjump(type,dis,value,marker,ret,call) {
236: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
237: +"&value="+escape(value)+"&marker="+escape(marker)
238: +"&return="+escape(ret)
239: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
240: "height=350,width=350,scrollbars=no,menubar=no");
241:
242: }
243:
244: function dateset() {
245: eval("document.cu."+document.cu.pres_marker.value+
246: ".value=document.cu.pres_value.value");
247: pclose();
248: }
249:
250: </script>
251: </head>
252: <body bgcolor="#FFFFFF">
253: <img align="right" src="/adm/lonIcons/lonlogos.gif">
254: ENDDOCHEAD
255: my $forminfo =<<"ENDFORMINFO";
256: <form action="/adm/createuser" method="post" name="cu">
257: <input type="hidden" name="phase" value="three">
258: <input type="hidden" name="ccuname" value="$ccuname">
259: <input type="hidden" name="ccdomain" value="$ccdomain">
260: <input type="hidden" name="pres_value" value="" >
261: <input type="hidden" name="pres_type" value="" >
262: <input type="hidden" name="pres_marker" value="" >
263: <input type="hidden" name="cuname" value="$ccuname">
264: <input type="hidden" name="cdomain" value="$ccdomain">
265: ENDFORMINFO
266: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
267: my %incdomains;
268: my %inccourses;
269: foreach (%Apache::lonnet::hostdom) {
270: $incdomains{$_}=1;
271: }
272: foreach (keys(%ENV)) {
273: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
274: $inccourses{$1.'_'.$2}=1;
275: }
276: }
277: if ($uhome eq 'no_host') {
278: $r->print(<<ENDNEWUSER);
279: $dochead
280: <h1>Create New User</h1>
281: $forminfo
282: <h2>New user "$ccuname" in domain $ccdomain</h2>
283: $loginscript
284: <input type='hidden' name='makeuser' value='1' />
285: <h3>Personal Data</h3>
286: <p>
287: <table>
288: <tr><td>First Name </td>
289: <td><input type='text' name='cfirst' size='15' /></td></tr>
290: <tr><td>Middle Name </td>
291: <td><input type='text' name='cmiddle' size='15' /></td></tr>
292: <tr><td>Last Name </td>
293: <td><input type='text' name='clast' size='15' /></td></tr>
294: <tr><td>Generation </td>
295: <td><input type='text' name='cgen' size='5' /></td></tr>
296: </table>
297: ID/Student Number <input type='text' name='cstid' size='15' /></p>
298:
299: <hr />
300:
301: <h3>Login Data</h3>
302: $generalrule
303: $authformkrb
304: $authformint
305: $authformfsys
306: $authformloc
307: ENDNEWUSER
308: } else { # user already exists
309: $r->print(<<ENDCHANGEUSER);
310: $dochead
311: <h1>Change User Privileges</h1>
312: $forminfo
313: <h2>User "$ccuname" in domain $ccdomain </h2>
314: ENDCHANGEUSER
315: my $rolesdump=&Apache::lonnet::reply(
316: "dump:$ccdomain:$ccuname:roles",$uhome);
317: # Build up table of user roles to allow revocation of a role.
318: unless ($rolesdump eq 'con_lost' || $rolesdump =~ m/^error/i) {
319: my $now=time;
320: $r->print('<hr /><h3>Revoke Existing Roles</h3>'.
321: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
322: '<th>Start</th><th>End</th>');
323: foreach (split(/&/,$rolesdump)) {
324: if ($_!~/^rolesdef\&/) {
325: my ($area,$role)=split(/=/,$_);
326: my $thisrole=$area;
327: $area=~s/\_\w\w$//;
328: my ($role_code,$role_end_time,$role_start_time)=split(/_/,$role);
329: my $bgcol='ffffff';
330: my $allows=0;
331: if ($area=~/^\/(\w+)\/(\d\w+)/) {
332: my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
333: my $carea='Course: '.$coursedata{'description'};
334: $inccourses{$1.'_'.$2}=1;
335: if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
336: $allows=1;
337: }
338: # Compute the background color based on $area
339: $bgcol=$1.'_'.$2;
340: $bgcol=~s/[^8-9b-e]//g;
341: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
342: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
343: $carea.='<br>Section/Group: '.$3;
344: }
345: $area=$carea;
346: } else {
347: # Determine if current user is able to revoke privileges
348: if ($area=~/^\/(\w+)\//) {
349: if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
350: $allows=1;
351: }
352: } else {
353: if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
354: $allows=1;
355: }
356: }
357: }
358:
359: $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
360: my $active=1;
361: if (($role_end_time) && ($now>$role_end_time)) { $active=0; }
362: if (($active) && ($allows)) {
363: $r->print('<input type="checkbox" name="rev:'
364: .$thisrole.'">');
365: } else {
366: $r->print(' ');
367: }
368: $r->print('</td><td>'.&Apache::lonnet::plaintext($role_code).
369: '</td><td>'.$area.'</td><td>'.
370: ($role_start_time ? localtime($role_start_time)
371: : ' ' )
372: .'</td><td>'.
373: ($role_end_time ? localtime($role_end_time)
374: : ' ' )
375: ."</td></tr>\n");
376: }
377: }
378: $r->print('</table>');
379: }
380: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
381: if ($currentauth=~/^krb4:/) {
382: $currentauth=~/^krb4:(.*)/;
383: my $krbdefdom2=$1;
384: $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;
385: }
386: # Check for a bad authentication type
387: unless ($currentauth=~/^krb4:/ or
388: $currentauth=~/^unix:/ or
389: $currentauth=~/^internal:/ or
390: $currentauth=~/^localauth:/
391: ) { # bad authentication scheme
392: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
393: $r->print(<<ENDBADAUTH);
394: <hr />
395: $loginscript
396: <font color='#ff0000'>ERROR:</font>
397: This user has an unrecognized authentication scheme ($currentauth).
398: Please specify login data below.
399: <h3>Login Data</h3>
400: $generalrule
401: $authformkrb
402: $authformint
403: $authformfsys
404: $authformloc
405: ENDBADAUTH
406: } else {
407: # This user is not allowed to modify the users
408: # authentication scheme, so just notify them of the problem
409: $r->print(<<ENDBADAUTH);
410: <hr />
411: $loginscript
412: <font color="#ff0000"> ERROR: </font>
413: This user has an unrecognized authentication scheme ($currentauth).
414: Please alert a domain coordinator of this situation.
415: <hr />
416: ENDBADAUTH
417: }
418: } else { # Authentication type is valid
419: my $authformcurrent='';
420: my $authform_other='';
421: if ($currentauth=~/^krb4:/) {
422: $authformcurrent=$authformkrb;
423: $authform_other=$authformint.$authformfsys.$authformloc;
424: # embarrassing script hack here
425: $loginscript=~s/login\[3\]/login\[4\]/; # loc
426: $loginscript=~s/login\[2\]/login\[3\]/; # fsys
427: $loginscript=~s/login\[1\]/login\[2\]/; # int
428: $loginscript=~s/login\[0\]/login\[1\]/; # krb4
429: }
430: elsif ($currentauth=~/^internal:/) {
431: $authformcurrent=$authformint;
432: $authform_other=$authformkrb.$authformfsys.$authformloc;
433: # embarrassing script hack here
434: $loginscript=~s/login\[3\]/login\[4\]/; # loc
435: $loginscript=~s/login\[2\]/login\[3\]/; # fsys
436: $loginscript=~s/login\[1\]/login\[1\]/; # int
437: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
438: }
439: elsif ($currentauth=~/^unix:/) {
440: $authformcurrent=$authformfsys;
441: $authform_other=$authformkrb.$authformint.$authformloc;
442: # embarrassing script hack here
443: $loginscript=~s/login\[3\]/login\[4\]/; # loc
444: $loginscript=~s/login\[1\]/login\[3\]/; # int
445: $loginscript=~s/login\[2\]/login\[1\]/; # fsys
446: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
447: }
448: elsif ($currentauth=~/^localauth:/) {
449: $authformcurrent=$authformloc;
450: $authform_other=$authformkrb.$authformint.$authformfsys;
451: # embarrassing script hack here
452: $loginscript=~s/login\[3\]/login\[loc\]/; # loc
453: $loginscript=~s/login\[2\]/login\[4\]/; # fsys
454: $loginscript=~s/login\[1\]/login\[3\]/; # int
455: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
456: $loginscript=~s/login\[loc\]/login\[1\]/; # loc
457: }
458: $authformcurrent=<<ENDCURRENTAUTH;
459: <table border='1'>
460: <tr>
461: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
462: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
463: </tr>
464: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
465: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
466: </table>
467: ENDCURRENTAUTH
468: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
469: # Current user has login modification privileges
470: $r->print(<<ENDOTHERAUTHS);
471: <hr />
472: $loginscript
473: <h3>Change Current Login Data</h3>
474: $generalrule
475: $authformnop
476: $authformcurrent
477: <h3>Enter New Login Data</h3>
478: $authform_other
479: ENDOTHERAUTHS
480: }
481: } ## End of "check for bad authentication type" logic
482: } ## End of new user/old user logic
483: $r->print('<hr /><h3>Add Roles</h3>');
484: #
485: # Co-Author
486: #
487:
488: if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
489: my $cuname=$ENV{'user.name'};
490: my $cudom=$ENV{'user.domain'};
491: $r->print(<<ENDCOAUTH);
492: <h4>Construction Space</h4>
493: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
494: <th>Start</th><th>End</th></tr>
495: <tr>
496: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
497: <td>Co-Author</td>
498: <td>$cudom\_$cuname</td>
499: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
500: <a href=
501: "javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">Set Start Date</a></td>
502: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
503: <a href=
504: "javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">Set End Date</a></td>
505: </tr>
506: </table>
507: ENDCOAUTH
508: }
509: #
510: # Domain level
511: #
512: $r->print('<h4>Domain Level</h4>'.
513: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
514: '<th>Start</th><th>End</th></tr>');
515: foreach ( sort( keys(%incdomains))) {
516: my $thisdomain=$_;
517: foreach ('dc','li','dg','au') {
518: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
519: my $plrole=&Apache::lonnet::plaintext($_);
520: $r->print(<<ENDDROW);
521: <tr>
522: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
523: <td>$plrole</td>
524: <td>$thisdomain</td>
525: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
526: <a href=
527: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
528: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
529: <a href=
530: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
531: </tr>
532: ENDDROW
533: }
534: }
535: }
536: $r->print('</table>');
537: #
538: # Course level
539: #
540: $r->print(&course_level_table(%inccourses));
541: $r->print("<hr /><input type=submit value=\"Modify User\">\n");
542: $r->print("</form></body></html>");
543: }
544:
545: # ================================================================= Phase Three
546: sub phase_three {
547: my $r=shift;
548: # Error messages
549: my $error = '<font color="#ff0000">Error:</font>';
550: my $end = '</body></html>';
551: # Print header
552: $r->print(<<ENDTHREEHEAD);
553: <html>
554: <head>
555: <title>The LearningOnline Network with CAPA</title>
556: </head>
557: <body bgcolor="#FFFFFF">
558: <img align="right" src="/adm/lonIcons/lonlogos.gif">
559: ENDTHREEHEAD
560: # Check Inputs
561: if (! $ENV{'form.cuname'} ) {
562: $r->print($error.'No login name specified.'.$end);
563: return;
564: }
565: if ( $ENV{'form.cuname'} =~/\W/) {
566: $r->print($error.'Invalid login name. '.
567: 'Only letters, numbers, and underscores are valid.'.
568: $end);
569: return;
570: }
571: if (! $ENV{'form.cdomain'} ) {
572: $r->print($error.'No domain specified.'.$end);
573: return;
574: }
575: if ( $ENV{'form.cdomain'} =~/\W/) {
576: $r->print($error.'Invalid domain name. '.
577: 'Only letters, numbers, and underscores are valid.'.
578: $end);
579: return;
580: }
581: # Determine authentication method and password for the user being modified
582: my $amode='';
583: my $genpwd='';
584: if ($ENV{'form.login'} eq 'krb') {
585: $amode='krb4';
586: $genpwd=$ENV{'form.krbdom'};
587: } elsif ($ENV{'form.login'} eq 'int') {
588: $amode='internal';
589: $genpwd=$ENV{'form.intpwd'};
590: } elsif ($ENV{'form.login'} eq 'fsys') {
591: $amode='unix';
592: $genpwd=$ENV{'form.fsyspwd'};
593: } elsif ($ENV{'form.login'} eq 'loc') {
594: $amode='localauth';
595: $genpwd=$ENV{'form.locarg'};
596: $genpwd=" " if (!$genpwd);
597: }
598: if ($ENV{'form.makeuser'}) {
599: # Create a new user
600: $r->print(<<ENDNEWUSERHEAD);
601: <h1>Create User</h1>
602: <h3>Creating user "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2>
603: ENDNEWUSERHEAD
604: # Check for the authentication mode and password
605: if (! $amode || ! $genpwd) {
606: $r->print($error.'Invalid login mode or password'.$end);
607: return;
608: }
609: # Call modifyuser
610: my $result = &Apache::lonnet::modifyuser
611: ($ENV{'form.cdomain'},$ENV{'form.cuname'},
612: $ENV{'form.cstid'},$amode,$genpwd,
613: $ENV{'form.cfirst'},$ENV{'form.cmiddle'},
614: $ENV{'form.clast'},$ENV{'form.cgen'}
615: );
616: $r->print('Generating user: '.$result);
617: $r->print('<br>Home server: '.&Apache::lonnet::homeserver
618: ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
619: } elsif ($ENV{'form.login'} ne '') {
620: # Modify user privileges
621: $r->print(<<ENDMODIFYUSERHEAD);
622: <h1>Change User Privileges</h1>
623: <h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2>
624: ENDMODIFYUSERHEAD
625: if (! $amode || ! $genpwd) {
626: $r->print($error.'Invalid login mode or password'.$end);
627: return;
628: }
629: # Only allow authentification modification if the person has authority
630: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
631: $r->print('Modifying authentication: '.
632: &Apache::lonnet::modifyuserauth(
633: $ENV{'form.cdomain'},$ENV{'form.cuname'},
634: $amode,$genpwd));
635: $r->print('<br>Home server: '.&Apache::lonnet::homeserver
636: ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
637: } else {
638: # Okay, this is a non-fatal error.
639: $r->print($error.'You do not have the authority to modify '.
640: 'this users authentification information.');
641: }
642: }
643: ##
644: my $now=time;
645: $r->print('<h3>Modifying Roles</h3>');
646: foreach (keys (%ENV)) {
647: next if (! $ENV{$_});
648: # Revoke roles
649: if ($_=~/^form\.rev/) {
650: if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
651: $r->print('Revoking '.$2.' in '.$1.': '.
652: &Apache::lonnet::assignrole($ENV{'form.cdomain'},
653: $ENV{'form.cuname'},$1,$2,$now).'<br>');
654: if ($2 eq 'st') {
655: $1=~/^\/(\w+)\/(\w+)/;
656: my $cid=$1.'_'.$2;
657: $r->print('Drop from classlist: '.
658: &Apache::lonnet::critical('put:'.
659: $ENV{'course.'.$cid.'.domain'}.':'.
660: $ENV{'course.'.$cid.'.num'}.':classlist:'.
661: &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
662: $ENV{'form.cdomain'}).'='.
663: &Apache::lonnet::escape($now.':'),
664: $ENV{'course.'.$cid.'.home'}).'<br>');
665: }
666: }
667: } elsif ($_=~/^form\.act/) {
668: if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
669: # Activate roles for sections with 3 id numbers
670: # set start, end times, and the url for the class
671: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ?
672: $ENV{'form.start_'.$1.'_'.$2} :
673: $now );
674: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ?
675: $ENV{'form.end_'.$1.'_'.$2} :
676: 0 );
677: my $url='/'.$1.'/'.$2;
678: if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
679: $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
680: }
681: # Assign the role and report it
682: $r->print('Assigning: '.$3.' in '.$url.': '.
683: &Apache::lonnet::assignrole(
684: $ENV{'form.cdomain'},$ENV{'form.cuname'},
685: $url,$3,$end,$start).
686: '<br>');
687: # Handle students differently
688: if ($3 eq 'st') {
689: $url=~/^\/(\w+)\/(\w+)/;
690: my $cid=$1.'_'.$2;
691: $r->print('Add to classlist: '.
692: &Apache::lonnet::critical(
693: 'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
694: $ENV{'course.'.$cid.'.num'}.':classlist:'.
695: &Apache::lonnet::escape(
696: $ENV{'form.cuname'}.':'.
697: $ENV{'form.cdomain'} ).'='.
698: &Apache::lonnet::escape($end.':'.$start),
699: $ENV{'course.'.$cid.'.home'})
700: .'<br>');
701: }
702: } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
703: # Activate roles for sections with two id numbers
704: # set start, end times, and the url for the class
705: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ?
706: $ENV{'form.start_'.$1.'_'.$2} :
707: $now );
708: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ?
709: $ENV{'form.end_'.$1.'_'.$2} :
710: 0 );
711: my $url='/'.$1.'/';
712: # Assign the role and report it.
713: $r->print('Assigning: '.$2.' in '.$url.': '.
714: &Apache::lonnet::assignrole(
715: $ENV{'form.cdomain'},$ENV{'form.cuname'},
716: $url,$2,$end,$start)
717: .'<br>');
718: }
719: }
720: } # End of foreach (keys(%ENV))
721: $r->print('</body></html>');
722: }
723:
724: # ================================================================ Main Handler
725: sub handler {
726: my $r = shift;
727:
728: if ($r->header_only) {
729: $r->content_type('text/html');
730: $r->send_http_header;
731: return OK;
732: }
733:
734: if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
735: (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||
736: (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||
737: (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
738: (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||
739: (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {
740: $r->content_type('text/html');
741: $r->send_http_header;
742: unless ($ENV{'form.phase'}) {
743: &phase_one($r);
744: }
745: if ($ENV{'form.phase'} eq 'two') {
746: &phase_two($r);
747: } elsif ($ENV{'form.phase'} eq 'three') {
748: &phase_three($r);
749: }
750: } else {
751: $ENV{'user.error.msg'}=
752: "/adm/createuser:mau:0:0:Cannot modify user data";
753: return HTTP_NOT_ACCEPTABLE;
754: }
755: return OK;
756: }
757:
758: #-------------------------------------------------- functions for &phase_two
759: sub course_level_table {
760: my %inccourses = @_;
761: my $table = '';
762: foreach (sort( keys(%inccourses))) {
763: my $thiscourse=$_;
764: my $protectedcourse=$_;
765: $thiscourse=~s:_:/:g;
766: my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
767: my $area=$coursedata{'description'};
768: my $bgcol=$thiscourse;
769: $bgcol=~s/[^8-9b-e]//g;
770: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
771: foreach ('st','ta','ep','ad','in','cc') {
772: if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
773: my $plrole=&Apache::lonnet::plaintext($_);
774: $table .= <<ENDEXTENT;
775: <tr bgcolor="#$bgcol">
776: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
777: <td>$plrole</td>
778: <td>$area</td>
779: ENDEXTENT
780: if ($_ ne 'cc') {
781: $table .= <<ENDSECTION;
782: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
783: ENDSECTION
784: } else {
785: $table .= <<ENDSECTION;
786: <td> </td>
787: ENDSECTION
788: }
789: $table .= <<ENDTIMEENTRY;
790: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
791: <a href=
792: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
793: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
794: <a href=
795: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
796: ENDTIMEENTRY
797: $table.= "</tr>\n";
798: }
799: }
800: }
801: return '' if ($table eq ''); # return nothing if there is nothing
802: # in the table
803: my $result = <<ENDTABLE;
804: <h4>Course Level</h4>
805: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
806: <th>Group/Section</th><th>Start</th><th>End</th></tr>
807: $table
808: </table>
809: ENDTABLE
810: return $result;
811: }
812: #---------------------------------------------- end functions for &phase_two
813:
814: 1;
815: __END__
816:
817:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>