1: # The LearningOnline Network with CAPA
2: # Create a user
3: #
4: # (Create a course
5: # (My Desk
6: #
7: # (Internal Server Error Handler
8: #
9: # (Login Screen
10: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
11: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
12: #
13: # YEAR=2001
14: # 3/1/1 Gerd Kortemeyer)
15: #
16: # 3/1 Gerd Kortemeyer)
17: #
18: # 2/14 Gerd Kortemeyer)
19: #
20: # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
21: # April Guy Albertelli
22: # 05/10,10/16 Gerd Kortemeyer
23: # 11/12,11/13,11/15 Scott Harrison
24: #
25: # $Id: loncreateuser.pm,v 1.21 2001/11/16 07:00:53 harris41 Exp $
26: ###
27:
28: package Apache::loncreateuser;
29:
30: use strict;
31: use Apache::Constants qw(:common :http);
32: use Apache::lonnet;
33:
34: my $loginscript; # piece of javascript used in two separate instances
35: my $generalrule;
36: my $authformnop;
37: my $authformkrb;
38: my $authformint;
39: my $authformfsys;
40: my $authformloc;
41:
42: sub BEGIN {
43: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
44: my $krbdefdom=$1;
45: $krbdefdom=~tr/a-z/A-Z/;
46: $authformnop=(<<END);
47: <p>
48: <input type=radio name=login value=nop checked='checked'
49: onClick="clicknop(this.form);">
50: Do not change login data
51: </p>
52: END
53: $authformkrb=(<<END);
54: <p>
55: <input type=radio name=login value=krb onClick="clickkrb(this.form);">
56: Kerberos authenticated with domain
57: <input type=text size=10 name=krbdom onChange="setkrb(this.form);">
58: </p>
59: END
60: $authformint=(<<END);
61: <p>
62: <input type=radio name=login value=int onClick="clickint(this.form);">
63: Internally authenticated (with initial password
64: <input type=text size=10 name=intpwd onChange="setint(this.form);">)
65: </p>
66: END
67: $authformfsys=(<<END);
68: <p>
69: <input type=radio name=login value=fsys onClick="clickfsys(this.form);">
70: Filesystem authenticated (with initial password
71: <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">)
72: </p>
73: END
74: $authformloc=(<<END);
75: <p>
76: <input type=radio name=login value=loc onClick="clickloc(this.form);" />
77: Local Authentication with argument
78: <input type=text size=10 name=locarg onChange="setloc(this.form);" />
79: </p>
80: END
81: $loginscript=(<<ENDLOGINSCRIPT);
82: <script>
83: function setkrb(vf) {
84: if (vf.krbdom.value!='') {
85: vf.login[0].checked=true;
86: vf.krbdom.value=vf.krbdom.value.toUpperCase();
87: vf.intpwd.value='';
88: vf.fsyspwd.value='';
89: vf.locarg.value='';
90: }
91: }
92:
93: function setint(vf) {
94: if (vf.intpwd.value!='') {
95: vf.login[1].checked=true;
96: vf.krbdom.value='';
97: vf.fsyspwd.value='';
98: vf.locarg.value='';
99: }
100: }
101:
102: function setfsys(vf) {
103: if (vf.fsyspwd.value!='') {
104: vf.login[2].checked=true;
105: vf.krbdom.value='';
106: vf.intpwd.value='';
107: vf.locarg.value='';
108: }
109: }
110:
111: function setloc(vf) {
112: if (vf.locarg.value!='') {
113: vf.login[3].checked=true;
114: vf.krbdom.value='';
115: vf.intpwd.value='';
116: vf.fsyspwd.value='';
117: }
118: }
119:
120: function clicknop(vf) {
121: vf.krbdom.value='';
122: vf.intpwd.value='';
123: vf.fsyspwd.value='';
124: vf.locarg.value='';
125: }
126:
127: function clickkrb(vf) {
128: vf.krbdom.value='$krbdefdom';
129: vf.intpwd.value='';
130: vf.fsyspwd.value='';
131: vf.locarg.value='';
132: }
133:
134: function clickint(vf) {
135: vf.krbdom.value='';
136: vf.fsyspwd.value='';
137: vf.locarg.value='';
138: }
139:
140: function clickfsys(vf) {
141: vf.krbdom.value='';
142: vf.intpwd.value='';
143: vf.locarg.value='';
144: }
145:
146: function clickloc(vf) {
147: vf.krbdom.value='';
148: vf.intpwd.value='';
149: vf.fsyspwd.value='';
150: }
151: </script>
152: ENDLOGINSCRIPT
153: $generalrule=<<END;
154: <p>
155: <i>As a general rule, only authors or co-authors should be filesystem
156: authenticated (which allows access to the server filesystem).</i>
157: </p>
158: END
159: }
160:
161: # =================================================================== Phase one
162:
163: sub phase_one {
164: my $r=shift;
165: my $defdom=$ENV{'user.domain'};
166: $r->print(<<ENDDOCUMENT);
167: <html>
168: <head>
169: <title>The LearningOnline Network with CAPA</title>
170: </head>
171: <body bgcolor="#FFFFFF">
172: <h1>Create User, Change User Privileges</h1>
173: <form action=/adm/createuser method=post>
174: <input type=hidden name=phase value=two>
175: Username: <input type=text size=15 name=ccuname><br>
176: Domain: <input type=text size=15 name=ccdomain value=$defdom><p>
177: <input type=submit value="Continue">
178: </form>
179: </body>
180: </html>
181: ENDDOCUMENT
182: }
183:
184: # =================================================================== Phase two
185:
186: sub phase_two {
187: my $r=shift;
188: my $ccuname=$ENV{'form.ccuname'};
189: my $ccdomain=$ENV{'form.ccdomain'};
190:
191: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
192: my $krbdefdom=$1;
193: $krbdefdom=~tr/a-z/A-Z/;
194:
195: my $defdom=$ENV{'user.domain'};
196:
197: $ccuname=~s/\W//g;
198: $ccdomain=~s/\W//g;
199: $r->print(<<ENDENHEAD);
200: <html>
201: <head>
202: <title>The LearningOnline Network with CAPA</title>
203: <script>
204:
205: function pclose() {
206: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
207: "height=350,width=350,scrollbars=no,menubar=no");
208: parmwin.close();
209: }
210:
211: function pjump(type,dis,value,marker,ret,call) {
212: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
213: +"&value="+escape(value)+"&marker="+escape(marker)
214: +"&return="+escape(ret)
215: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
216: "height=350,width=350,scrollbars=no,menubar=no");
217:
218: }
219:
220: function dateset() {
221: eval("document.cu."+document.cu.pres_marker.value+
222: ".value=document.cu.pres_value.value");
223: pclose();
224: }
225:
226: </script>
227: </head>
228: <body bgcolor="#FFFFFF">
229: <img align=right src=/adm/lonIcons/lonlogos.gif>
230: <h1>Create User, Change User Privileges</h1>
231: <form action=/adm/createuser method=post name=cu>
232: <input type=hidden name=phase value=three>
233: <input type=hidden name=ccuname value=$ccuname>
234: <input type=hidden name=ccdomain value=$ccdomain>
235: <input type="hidden" value='' name="pres_value">
236: <input type="hidden" value='' name="pres_type">
237: <input type="hidden" value='' name="pres_marker">
238: <input type=hidden name=cuname value="$ccuname">
239: <input type=hidden name=cdomain value="$ccdomain">
240:
241: ENDENHEAD
242: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
243: my %incdomains;
244: my %inccourses;
245: map {
246: $incdomains{$_}=1;
247: } values %Apache::lonnet::hostdom;
248: map {
249: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
250: $inccourses{$1.'_'.$2}=1;
251: }
252: } %ENV;
253: if ($uhome eq 'no_host') {
254: $r->print(<<ENDNUSER);
255: <h2>New user $ccuname at $ccdomain</h2>
256: ENDNUSER
257: $r->print(<<ENDNUSER);
258: $loginscript
259: <input type='hidden' name='makeuser' value='1' />
260: <h3>Personal Data</h3>
261: First Name: <input type='text' name='cfirst' size='15' /><br />
262: Middle Name: <input type='text' name='cmiddle' size='15' /><br />
263: Last Name: <input type='text' name='clast' size='15' /><br />
264: Generation: <input type='text' name='cgen' size='5' /><p>
265:
266: ID/Student Number: <input type='text' name='cstid' size='10' /></p>
267:
268: <h3>Login Data</h3>
269: $generalrule
270: $authformkrb
271: $authformint
272: $authformfsys
273: $authformloc
274: ENDNUSER
275: } else {
276: $r->print('<h2>Existing user '.$ccuname.' at '.$ccdomain.'</h2>');
277:
278: my $rolesdump=&Apache::lonnet::reply(
279: "dump:$ccdomain:$ccuname:roles",$uhome);
280: unless ($rolesdump eq 'con_lost') {
281: my $now=time;
282: $r->print('<h4>Revoke Existing Roles</h4>'.
283: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
284: '<th>Start</th><th>End</th>');
285: map {
286: if ($_!~/^rolesdef\&/) {
287:
288: my ($area,$role)=split(/=/,$_);
289: my $thisrole=$area;
290: $area=~s/\_\w\w$//;
291: my ($trole,$tend,$tstart)=split(/_/,$role);
292: my $bgcol='ffffff';
293: my $allows=0;
294: if ($area=~/^\/(\w+)\/(\d\w+)/) {
295: my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
296: my $carea='Course: '.$coursedata{'description'};
297: $inccourses{$1.'_'.$2}=1;
298: if (&Apache::lonnet::allowed('c'.$trole,$1.'/'.$2)) {
299: $allows=1;
300: }
301: $bgcol=$1.'_'.$2;
302: $bgcol=~s/[^8-9b-e]//g;
303: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
304: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
305: $carea.='<br>Section/Group: '.$3;
306: }
307: $area=$carea;
308: } else {
309: if ($area=~/^\/(\w+)\//) {
310: if (&Apache::lonnet::allowed('c'.$trole,$1)) {
311: $allows=1;
312: }
313: } else {
314: if (&Apache::lonnet::allowed('c'.$trole,'/')) {
315: $allows=1;
316: }
317: }
318: }
319:
320: my $active=1;
321: if (($tend) && ($now>$tend)) { $active=0; }
322:
323: $r->print('<tr bgcolor=#'.$bgcol.'><td>');
324: if ($active) {
325: if ($allows) {
326: $r->print(
327: '<input type=checkbox name="rev:'.$thisrole.'">');
328: } else {
329: $r->print(' ');
330: }
331: } else {
332: $r->print(' ');
333: }
334: $r->print('</td><td>'.&Apache::lonnet::plaintext($trole).
335: '</td><td>'.$area.'</td><td>'.
336: ($tstart?localtime($tstart):' ').'</td><td>'.
337: ($tend?localtime($tend):' ')."</td></tr>\n");
338: }
339: } split(/&/,$rolesdump);
340: $r->print('</table>');
341: }
342: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
343: if ($currentauth=~/^krb4:/) {
344: $currentauth=~/^krb4:(.*)/;
345: my $krbdefdom2=$1;
346: $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;
347: }
348: # minor script hack here
349: # $loginscript=~s/login\[3\]/login\[4\]/; # loc
350: # $loginscript=~s/login\[2\]/login\[3\]/; # fsys
351: # $loginscript=~s/login\[1\]/login\[2\]/; # int
352: # $loginscript=~s/login\[0\]/login\[1\]/; # krb4
353:
354: unless ($currentauth=~/^krb4:/ or
355: $currentauth=~/^unix:/ or
356: $currentauth=~/^internal:/ or
357: $currentauth=~/^localauth:/
358: ) {
359: $r->print(<<END);
360: <hr />
361: $loginscript
362: <font color='#ff0000'>ERROR:</font>
363: This user has an unrecognized authentication scheme ($currentauth).
364: Please specify login data below.
365: <h3>Login Data</h3>
366: $generalrule
367: $authformkrb
368: $authformint
369: $authformfsys
370: $authformloc
371: END
372: }
373: else {
374: my $authformcurrent='';
375: my $authformother='';
376: if ($currentauth=~/^krb4:/) {
377: $authformcurrent=$authformkrb;
378: $authformother=$authformint.$authformfsys.$authformloc;
379: # embarrassing script hack here
380: $loginscript=~s/login\[3\]/login\[4\]/; # loc
381: $loginscript=~s/login\[2\]/login\[3\]/; # fsys
382: $loginscript=~s/login\[1\]/login\[2\]/; # int
383: $loginscript=~s/login\[0\]/login\[1\]/; # krb4
384: }
385: elsif ($currentauth=~/^internal:/) {
386: $authformcurrent=$authformint;
387: $authformother=$authformkrb.$authformfsys.$authformloc;
388: # embarrassing script hack here
389: $loginscript=~s/login\[3\]/login\[4\]/; # loc
390: $loginscript=~s/login\[2\]/login\[3\]/; # fsys
391: $loginscript=~s/login\[1\]/login\[1\]/; # int
392: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
393: }
394: elsif ($currentauth=~/^unix:/) {
395: $authformcurrent=$authformfsys;
396: $authformother=$authformkrb.$authformint.$authformloc;
397: # embarrassing script hack here
398: $loginscript=~s/login\[3\]/login\[4\]/; # loc
399: $loginscript=~s/login\[1\]/login\[3\]/; # int
400: $loginscript=~s/login\[2\]/login\[1\]/; # fsys
401: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
402: }
403: elsif ($currentauth=~/^localauth:/) {
404: $authformcurrent=$authformloc;
405: $authformother=$authformkrb.$authformint.$authformfsys;
406: # embarrassing script hack here
407: $loginscript=~s/login\[3\]/login\[loc\]/; # loc
408: $loginscript=~s/login\[2\]/login\[4\]/; # fsys
409: $loginscript=~s/login\[1\]/login\[3\]/; # int
410: $loginscript=~s/login\[0\]/login\[2\]/; # krb4
411: $loginscript=~s/login\[loc\]/login\[1\]/; # loc
412: }
413: $authformcurrent=<<END;
414: <table border='1'>
415: <tr>
416: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
417: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
418: </tr>
419: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
420: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
421: </table>
422: END
423: $r->print(<<END);
424: <hr />
425: $loginscript
426: <h3>Change Current Login Data</h3>
427: $generalrule
428: $authformnop
429: $authformcurrent
430: <h3>Enter New Login Data</h3>
431: $authformother
432: END
433: }
434: }
435: $r->print('<hr /><h3>Add Roles</h3>');
436: #
437: # Co-Author
438: #
439:
440: if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
441: my $cuname=$ENV{'user.name'};
442: my $cudom=$ENV{'user.domain'};
443: $r->print(<<ENDCOAUTH);
444: <h4>Construction Space</h4>
445: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
446: <th>Start</th><th>End</th></tr>
447: <tr>
448: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
449: <td>Co-Author</td>
450: <td>$cudom\_$cuname</td>
451: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
452: <a href=
453: "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>
454: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
455: <a href=
456: "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>
457: </tr>
458: </table>
459: ENDCOAUTH
460: }
461: #
462: # Domain level
463: #
464: $r->print('<h4>Domain Level</h4>'.
465: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
466: '<th>Start</th><th>End</th></tr>');
467: map {
468: my $thisdomain=$_;
469: map {
470: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
471: my $plrole=&Apache::lonnet::plaintext($_);
472: $r->print(<<ENDDROW);
473: <tr>
474: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
475: <td>$plrole</td>
476: <td>$thisdomain</td>
477: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
478: <a href=
479: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
480: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
481: <a href=
482: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
483: </tr>
484: ENDDROW
485: }
486: } ('dc','li','dg','au');
487: } sort keys %incdomains;
488: $r->print('</table>');
489: #
490: # Course level
491: #
492: $r->print('<h4>Course Level</h4>'.
493: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
494: '<th>Group/Section</th><th>Start</th><th>End</th></tr>');
495: map {
496: my $thiscourse=$_;
497: my $protectedcourse=$_;
498: $thiscourse=~s:_:/:g;
499: my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
500: my $area=$coursedata{'description'};
501: my $bgcol=$thiscourse;
502: $bgcol=~s/[^8-9b-e]//g;
503: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
504: map {
505: if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
506: my $plrole=&Apache::lonnet::plaintext($_);
507: $r->print("
508: <tr bgcolor=#$bgcol>
509: <td><input type=checkbox name=\"act_$protectedcourse\_$_\"></td>
510: <td>$plrole</td>
511: <td>$area</td>
512: <td>");
513: if ($_ ne 'cc') {
514: $r->print("<input type=text size=5 name=\"sec_$protectedcourse\_$_\">");
515: } else { $r->print(" "); }
516: $r->print(<<ENDROW);
517: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
518: <a href=
519: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
520: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
521: <a href=
522: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
523: </tr>
524: ENDROW
525: }
526: } ('st','ta','ep','ad','in','cc');
527: } sort keys %inccourses;
528: $r->print('</table>');
529: $r->print('<input type=submit value="Modify User">');
530: $r->print('</form></body></html>');
531: }
532:
533: # ================================================================= Phase Three
534:
535: sub phase_three {
536: my $r=shift;
537: $r->print(<<ENDTHREEHEAD);
538: <html>
539: <head>
540: <title>The LearningOnline Network with CAPA</title>
541: </head>
542: <body bgcolor="#FFFFFF">
543: <img align=right src=/adm/lonIcons/lonlogos.gif>
544: <h1>Create User, Change User Privileges</h1>
545: ENDTHREEHEAD
546: $r->print('<h2>'.$ENV{'form.cuname'}.' at '.$ENV{'form.cdomain'}.'</h2>');
547: if ($ENV{'form.makeuser'}) {
548: $r->print('<h3>Creating User</h3>');
549: if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&
550: ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {
551: my $amode='';
552: my $genpwd='';
553: if ($ENV{'form.login'} eq 'krb') {
554: $amode='krb4';
555: $genpwd=$ENV{'form.krbdom'};
556: } elsif ($ENV{'form.login'} eq 'int') {
557: $amode='internal';
558: $genpwd=$ENV{'form.intpwd'};
559: } elsif ($ENV{'form.login'} eq 'fsys') {
560: $amode='unix';
561: $genpwd=$ENV{'form.fsyspwd'};
562: } elsif ($ENV{'form.login'} eq 'loc') {
563: $amode='localauth';
564: $genpwd=$ENV{'form.locarg'};
565: if (!$genpwd) { $genpwd=" "; }
566: }
567: if (($amode) && ($genpwd)) {
568: $r->print('Generating user: '.&Apache::lonnet::modifyuser(
569: $ENV{'form.cdomain'},$ENV{'form.cuname'},
570: $ENV{'form.cstid'},$amode,$genpwd,
571: $ENV{'form.cfirst'},$ENV{'form.cmiddle'},
572: $ENV{'form.clast'},$ENV{'form.cgen'}));
573: $r->print('<br>Home server: '.&Apache::lonnet::homeserver
574: ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
575:
576: } else {
577: $r->print('Invalid login mode or password');
578: }
579: } else {
580: $r->print('Invalid username or domain');
581: }
582: }
583: if (!$ENV{'form.makeuser'} and $ENV{'form.login'} ne 'nop') {
584: $r->print('<h3>Changing User Login Data</h3>');
585: if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&
586: ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {
587: my $amode='';
588: my $genpwd='';
589: if ($ENV{'form.login'} eq 'krb') {
590: $amode='krb4';
591: $genpwd=$ENV{'form.krbdom'};
592: } elsif ($ENV{'form.login'} eq 'int') {
593: $amode='internal';
594: $genpwd=$ENV{'form.intpwd'};
595: } elsif ($ENV{'form.login'} eq 'fsys') {
596: $amode='unix';
597: $genpwd=$ENV{'form.fsyspwd'};
598: } elsif ($ENV{'form.login'} eq 'loc') {
599: $amode='localauth';
600: $genpwd=$ENV{'form.locarg'};
601: if (!$genpwd) { $genpwd=" "; }
602: }
603: if (($amode) && ($genpwd)) {
604: $r->print('Modifying authentication: '.
605: &Apache::lonnet::modifyuserauth(
606: $ENV{'form.cdomain'},$ENV{'form.cuname'},
607: $amode,$genpwd));
608: $r->print('<br>Home server: '.&Apache::lonnet::homeserver
609: ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
610:
611: } else {
612: $r->print('Invalid login mode or password');
613: }
614: } else {
615: $r->print('Invalid username or domain');
616: }
617: }
618: my $now=time;
619: $r->print('<h3>Modifying Roles</h3>');
620: map {
621: if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
622: $r->print('Revoking '.$2.' in '.$1.': '.
623: &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
624: $1,$2,$now).'<br>');
625: if ($2 eq 'st') {
626: $1=~/^\/(\w+)\/(\w+)/;
627: my $cid=$1.'_'.$2;
628: $r->print('Drop from classlist: '.
629: &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
630: $ENV{'course.'.$cid.'.num'}.':classlist:'.
631: &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
632: $ENV{'form.cdomain'}).'='.
633: &Apache::lonnet::escape($now.':'),
634: $ENV{'course.'.$cid.'.home'}).'<br>');
635: }
636: }
637: } keys %ENV;
638: map {
639: if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
640: my $url='/'.$1.'/'.$2;
641: if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
642: $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
643: }
644: my $start=$now;
645: if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {
646: $start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};
647: }
648: my $end=0;
649: if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {
650: $end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};
651: }
652: $r->print('Assigning: '.$3.' in '.$url.': '.
653: &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
654: $url,$3,$end,$start).'<br>');
655: if ($3 eq 'st') {
656: $url=~/^\/(\w+)\/(\w+)/;
657: my $cid=$1.'_'.$2;
658: $r->print('Add to classlist: '.
659: &Apache::lonnet::critical('put:'.$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($end.':'.$start),
664: $ENV{'course.'.$cid.'.home'}).'<br>');
665: }
666: } elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
667: my $url='/'.$1.'/';
668: my $start=$now;
669: if ($ENV{'form.start_'.$1.'_'.$2}) {
670: $start=$ENV{'form.start_'.$1.'_'.$2};
671: }
672: my $end=0;
673: if ($ENV{'form.end_'.$1.'_'.$2}) {
674: $end=$ENV{'form.end_'.$1.'_'.$2};
675: }
676: $r->print('Assigning: '.$2.' in '.$url.': '.
677: &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
678: $url,$2,$end,$start).'<br>');
679: }
680: } keys %ENV;
681: $r->print('</body></html>');
682: }
683:
684: # ================================================================ Main Handler
685: sub handler {
686: my $r = shift;
687:
688: if ($r->header_only) {
689: $r->content_type('text/html');
690: $r->send_http_header;
691: return OK;
692: }
693:
694: if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
695: (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||
696: (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||
697: (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
698: (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||
699: (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {
700: $r->content_type('text/html');
701: $r->send_http_header;
702: unless ($ENV{'form.phase'}) {
703: &phase_one($r);
704: }
705: if ($ENV{'form.phase'} eq 'two') {
706: &phase_two($r);
707: } elsif ($ENV{'form.phase'} eq 'three') {
708: &phase_three($r);
709: }
710: } else {
711: $ENV{'user.error.msg'}=
712: "/adm/createuser:mau:0:0:Cannot modify user data";
713: return HTTP_NOT_ACCEPTABLE;
714: }
715: return OK;
716: }
717:
718: 1;
719: __END__
720:
721:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>