File:
[LON-CAPA] /
loncom /
auth /
lonroles.pm
Revision
1.52:
download - view:
text,
annotated -
select for diffs
Thu Feb 13 18:11:26 2003 UTC (21 years, 4 months ago) by
www
Branches:
MAIN
CVS tags:
HEAD
Steps towards server side menu for handicapper access.
Get activated when logging in with "Accessibility Option"
If not using that entrance, Remote should remain exactly the same pain as it
always was.
1: # The LearningOnline Network with CAPA
2: # User Roles Screen
3: #
4: # $Id: lonroles.pm,v 1.52 2003/02/13 18:11:26 www 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: # (Directory Indexer
29: # (Login Screen
30: # YEAR=1999
31: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
32: # 11/23 Gerd Kortemeyer)
33: # YEAR=2000
34: # 1/14,03/06,06/01,07/22,07/24,07/25,
35: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,
36: # 12/08,12/28,
37: # YEAR=2001
38: # 01/15/01 Gerd Kortemeyer
39: # 03/02,05/03,05/25,05/30,06/01,07/06,08/06 Gerd Kortemeyer
40: # 12/29 Gerd Kortemeyer
41: #
42: ###
43:
44: package Apache::lonroles;
45:
46: use strict;
47: use Apache::lonnet();
48: use Apache::lonuserstate();
49: use Apache::Constants qw(:common);
50: use Apache::File();
51: use Apache::lonmenu;
52: use Apache::loncommon;
53:
54: sub handler {
55:
56: my $r = shift;
57:
58: my $now=time;
59: my $then=$ENV{'user.login.time'};
60: my $envkey;
61:
62:
63: # ================================================================== Roles Init
64:
65: if ($ENV{'form.selectrole'}) {
66: if ($ENV{'request.course.id'}) {
67: my %temp=('logout_'.$ENV{'request.course.id'} => time);
68: &Apache::lonnet::put('email_status',\%temp);
69: }
70: &Apache::lonnet::appenv("request.course.id" => '',
71: "request.course.fn" => '',
72: "request.course.uri" => '',
73: "request.course.sec" => '',
74: "request.role" => 'cm',
75: "request.role.domain" => $ENV{'user.domain'});
76: foreach $envkey (keys %ENV) {
77: next if ($envkey!~/^user\.role\./);
78: my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
79: my $where=join('.',@pwhere);
80: my $trolecode=$role.'.'.$where;
81: if ($ENV{'form.'.$trolecode}) {
82: my ($tstart,$tend)=split(/\./,$ENV{$envkey});
83: my $tstatus='is';
84: if ($tstart) {
85: if ($tstart>$then) {
86: $tstatus='future';
87: }
88: }
89: if ($tend) {
90: if ($tend<$then) { $tstatus='expired'; }
91: if ($tend<$now) { $tstatus='will_not'; }
92: }
93: if ($tstatus eq 'is') {
94: $where=~s/^\///;
95: my ($cdom,$cnum,$csec)=split(/\//,$where);
96: &Apache::lonnet::appenv('request.role' => $trolecode,
97: 'request.role.domain' => $cdom,
98: 'request.course.sec' => $csec);
99: my $msg='Entering course ...';
100: if (($cnum) && ($role ne 'ca')) {
101: my ($furl,$ferr)=
102: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
103: if (($ENV{'form.orgurl'}) &&
104: ($ENV{'form.orgurl'}!~/^\/adm\/flip/)) {
105: $r->internal_redirect($ENV{'form.orgurl'});
106: return OK;
107: } else {
108: unless ($ENV{'request.course.id'}) {
109: &Apache::lonnet::appenv(
110: "request.course.id" => $cdom.'_'.$cnum);
111: $furl='/adm/notfound.html';
112: $msg=
113: '<h1><font color=red>Could not initialize top-level map.</font></h1>';
114: }
115: $r->content_type('text/html');
116: &Apache::loncommon::no_cache($r);
117: $r->send_http_header;
118: my $swinfo=&Apache::lonmenu::rawconfig();
119: my $bodytag=&Apache::loncommon::bodytag('Switching Role');
120: print (<<ENDREDIR);
121: <head><title>Entering Course</title>
122: <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$furl">
123: </head>
124: <html>
125: $bodytag
126: <script>
127: $swinfo
128: </script>
129: <h1>$msg</h1>
130: </body>
131: </html>
132: ENDREDIR
133: return OK;
134: }
135: }
136: }
137: }
138: }
139: }
140:
141:
142: # =============================================================== No Roles Init
143:
144: $r->content_type('text/html');
145: &Apache::loncommon::no_cache($r);
146: $r->send_http_header;
147: return OK if $r->header_only;
148:
149: my $swinfo=&Apache::lonmenu::rawconfig();
150: my $bodytag=&Apache::loncommon::bodytag('User Roles');
151: my $helptag=&Apache::loncommon::help_open_topic
152: ("General_Intro","Click here for help");
153: $r->print(<<ENDHEADER);
154: <html>
155: <head>
156: <title>LON-CAPA User Roles</title>
157: </head>
158: $bodytag
159: $helptag<br />
160: <script>
161: $swinfo
162: window.focus();
163: </script>
164: ENDHEADER
165:
166: # ------------------------------------------ Get Error Message from Environment
167:
168: my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
169: if ($ENV{'user.error.msg'}) {
170: $r->log_reason(
171: "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
172: }
173:
174: # ---------------------------------------------------------------- Who is this?
175:
176: my $advanced=0;
177: foreach $envkey (keys %ENV) {
178: if ($envkey=~/^user\.role\./) {
179: my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
180: if ($role ne 'st') { $advanced=1; }
181: }
182: }
183:
184: # -------------------------------------------------------- Generate Page Output
185: # --------------------------------------------------------------- Error Header?
186: if ($error) {
187: $r->print("<h1>LON-CAPA Access Control</h1>");
188: $r->print("<hr><pre>Access : ".
189: Apache::lonnet::plaintext($priv)."\n");
190: $r->print("Resource: $fn\n");
191: $r->print("Action : $msg\n</pre><hr>");
192: } else {
193: if ($ENV{'user.error.msg'}) {
194: $r->print(
195: '<h3><font color=red>You need to choose another user role or '.
196: 'enter a specific course for this function</font></h3>');
197: }
198: }
199: # -------------------------------------------------------- Choice or no choice?
200: if ($nochoose) {
201: if ($advanced) {
202: $r->print("<h2>Assigned User Roles</h2>\n");
203: } else {
204: $r->print("<h2>Sorry ...</h2>\nThis resource might be part of");
205: if ($ENV{'request.course.id'}) {
206: $r->print(' another');
207: } else {
208: $r->print(' a certain');
209: }
210: $r->print(' course.</body></html>');
211: return OK;
212: }
213: } else {
214: if ($advanced) {
215: $r->print("Your home server is ".
216: $Apache::lonnet::hostname{&Apache::lonnet::homeserver
217: ($ENV{'user.name'},$ENV{'user.domain'})}.
218: "<br />\n");
219: $r->print("Author and Co-Author roles may not be available on ".
220: "servers other than your home server.");
221: } else {
222: $r->print("<h2>Enter a Course</h2>\n");
223: }
224: if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
225: $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
226: }
227: $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
228: $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
229: $r->print('<input type=hidden name=selectrole value=1>');
230: }
231: $r->print('<br>Show all roles: <input type=checkbox name=showall');
232: if ($ENV{'form.showall'}) { $r->print(' checked'); }
233: $r->print('><input type=submit value="Display"><br>');
234: # ----------------------------------------------------------------------- Table
235: $r->print('<table><tr>');
236: unless ($nochoose) { $r->print('<th> </th>'); }
237: $r->print('<th>User Role</th><th colspan=2>Extent</th>'.
238: '<th>Start</th><th>End</th><th>Remark</th></tr>'."\n");
239:
240: foreach $envkey (sort keys %ENV) {
241: my $button = 1;
242: my $switchserver='';
243: if ($envkey=~/^user\.role\./) {
244: my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
245: next if (!defined($role) || $role eq '');
246: my $where=join('.',@pwhere);
247: my $trolecode=$role.'.'.$where;
248: my ($tstart,$tend)=split(/\./,$ENV{$envkey});
249: my $tremark='';
250: my $tstatus='is';
251: my $tpstart=' ';
252: my $tpend=' ';
253: my $tfont='#000000';
254: if ($tstart) {
255: if ($tstart>$then) {
256: $tstatus='future';
257: if ($tstart<$now) { $tstatus='will'; }
258: }
259: $tpstart=localtime($tstart);
260: }
261: if ($tend) {
262: if ($tend<$then) {
263: $tstatus='expired';
264: } elsif ($tend<$now) {
265: $tstatus='will_not';
266: }
267: $tpend=localtime($tend);
268: }
269: if ($ENV{'request.role'} eq $trolecode) {
270: $tstatus='selected';
271: }
272: my $tbg;
273: if (($tstatus eq 'is') || ($tstatus eq 'selected') ||
274: ($ENV{'form.showall'})) {
275: if ($tstatus eq 'is') {
276: $tbg='#77FF77';
277: $tfont='#003300';
278: } elsif ($tstatus eq 'future') {
279: $tbg='#FFFF77';
280: $button=0;
281: } elsif ($tstatus eq 'will') {
282: $tbg='#FFAA77';
283: $tremark.='Active at next login. ';
284: } elsif ($tstatus eq 'expired') {
285: $tbg='#FF7777';
286: $tfont='#330000';
287: $button=0;
288: } elsif ($tstatus eq 'will_not') {
289: $tbg='#AAFF77';
290: $tremark.='Expired after logout. ';
291: } elsif ($tstatus eq 'selected') {
292: $tbg='#11CC55';
293: $tfont='#002200';
294: $tremark.='Currently selected. ';
295: }
296: my $trole;
297: if ($role =~ /^cr\//) {
298: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
299: $tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.';
300: $trole=$rrole;
301: } else {
302: $trole=Apache::lonnet::plaintext($role);
303: }
304: my $ttype;
305: my $twhere;
306: my ($tdom,$trest,$tsection)=
307: split(/\//,Apache::lonnet::declutter($where));
308: # First, Co-Authorship roles
309: if ($role eq 'ca') {
310: my $home = &Apache::lonnet::homeserver($trest,$tdom);
311: if ($home ne $r->dir_config('lonHostID')) {
312: $button=0;
313: $switchserver=&Apache::lonnet::escape('http://'.
314: $Apache::lonnet::hostname{$home}.
315: '/adm/login?domain='.$ENV{'user.domain'}.
316: '&username='.$ENV{'user.name'}.
317: '&firsturl=/priv/'.$trest);
318: }
319: #next if ($home eq 'no_host');
320: $home = $Apache::lonnet::hostname{$home};
321: $ttype='Construction Space';
322: $twhere='User: '.$trest.'<br />Domain: '.$tdom.'<br />'.
323: ' Server: '.$home;
324: $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
325: } elsif ($role eq 'au') {
326: # Authors
327: my $home = &Apache::lonnet::homeserver
328: ($ENV{'user.name'},$ENV{'user.domain'});
329: if ($home ne $r->dir_config('lonHostID')) {
330: $button=0;
331: $switchserver=&Apache::lonnet::escape('http://'.
332: $Apache::lonnet::hostname{$home}.
333: '/adm/login?domain='.$ENV{'user.domain'}.
334: '&username='.$ENV{'user.name'}.
335: '&firsturl=/priv/'.$ENV{'user.name'});
336: }
337: #next if ($home eq 'no_host');
338: $home = $Apache::lonnet::hostname{$home};
339: $ttype='Construction Space';
340: $twhere='Domain: '.$tdom.'<br />Server: '.$home;
341: $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
342: } elsif ($trest) {
343: $ttype='Course';
344: if ($tsection) {
345: $ttype.='<br>Section/Group: '.$tsection;
346: }
347: my $tcourseid=$tdom.'_'.$trest;
348: if ($ENV{'course.'.$tcourseid.'.description'}) {
349: $twhere=$ENV{'course.'.$tcourseid.'.description'};
350: unless ($twhere eq 'Currently not available') {
351: $twhere.=' <font size="-2">'.
352: &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
353: '</font>';
354: }
355: } else {
356: my %newhash=Apache::lonnet::coursedescription
357: ($tcourseid);
358: if (%newhash) {
359: $twhere=$newhash{'description'}.
360: ' <font size="-2">'.
361: &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
362: '</font>';
363: } else {
364: $twhere='Currently not available';
365: $ENV{'course.'.$tcourseid.'.description'}=$twhere;
366: }
367: }
368: if ($role ne 'st') { $twhere.="<br />Domain:".$tdom; }
369: } elsif ($tdom) {
370: $ttype='Domain';
371: $twhere=$tdom;
372: } else {
373: $ttype='System';
374: $twhere='system wide';
375: }
376:
377: # ----- do not trust the indention below here -----
378: $r->print('<tr bgcolor='.$tbg.'>');
379: unless ($nochoose) {
380: if (!$button) {
381: if ($switchserver) {
382: $r->print('<td><a href="/adm/logout?handover='.
383: $switchserver.'">Switch Server</a></td>');
384: } else {
385: $r->print('<td> </td>');
386: }
387: } elsif ($tstatus eq 'is') {
388: $r->print('<td><input type=submit value=Select name="'.
389: $trolecode.'"></td>');
390: } elsif ($ENV{'user.adv'}) {
391: $r->print
392: ('<td><input type=submit value="Re-Initialize"'.
393: ' name="'.$trolecode.'"></td>');
394: } else {
395: $r->print('<td> </td>');
396: }
397: }
398: $r->print('<td><font color="'.$tfont.'">'.$trole.
399: '</font></td><td><font color="'.$tfont.'">'.$ttype.
400: '</font></td><td><font color="'.$tfont.'">'.$twhere.
401: '</font></td><td><font color="'.$tfont.'">'.$tpstart.
402: '</font></td><td><font color="'.$tfont.'">'.$tpend.
403: '</font></td><td><font color="'.$tfont.'">'.$tremark.
404: ' </font></td></tr>'."\n");
405: }
406: }
407: }
408: my $tremark='';
409: my $tfont='#003300';
410: if ($ENV{'request.role'} eq 'cm') {
411: $r->print('<tr bgcolor="#11CC55">');
412: $tremark='Currently selected.';
413: $tfont='#002200';
414: } else {
415: $r->print('<tr bgcolor="#77FF77">');
416: }
417: unless ($nochoose) {
418: if ($ENV{'request.role'} ne 'cm') {
419: $r->print('<td><input type=submit value=Select name="cm"></td>');
420: } else {
421: $r->print('<td> </td>');
422: }
423: }
424: $r->print('<td colspan=5><font color="'.$tfont.'">No role specified'.
425: '</font></td><td><font color="'.$tfont.'">'.$tremark.
426: ' </font></td></tr>'."\n");
427:
428: $r->print('</table>');
429: unless ($nochoose) {
430: $r->print("</form>\n");
431: }
432: # ------------------------------------------------------------ Privileges Info
433: if (($advanced) && (($ENV{'user.error.msg'}) || ($error))) {
434: $r->print('<hr><h2>Current Privileges</h2>');
435:
436: foreach $envkey (sort keys %ENV) {
437: if ($envkey=~/^user\.priv\.$ENV{'request.role'}\./) {
438: my $where=$envkey;
439: $where=~s/^user\.priv\.$ENV{'request.role'}\.//;
440: my $ttype;
441: my $twhere;
442: my ($tdom,$trest,$tsec)=
443: split(/\//,Apache::lonnet::declutter($where));
444: if ($trest) {
445: if ($ENV{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
446: $ttype='Construction Space';
447: $twhere='User: '.$trest.', Domain: '.$tdom;
448: } else {
449: $ttype='Course';
450: $twhere=$ENV{'course.'.$tdom.'_'.$trest.'.description'};
451: if ($tsec) {
452: $twhere.=' (Section/Group: '.$tsec.')';
453: }
454: }
455: } elsif ($tdom) {
456: $ttype='Domain';
457: $twhere=$tdom;
458: } else {
459: $ttype='System';
460: $twhere='/';
461: }
462: $r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
463: foreach (sort split(/:/,$ENV{$envkey})) {
464: if ($_) {
465: my ($prv,$restr)=split(/\&/,$_);
466: my $trestr='';
467: if ($restr ne 'F') {
468: my $i;
469: $trestr.=' (';
470: for ($i=0;$i<length($restr);$i++) {
471: $trestr.=
472: Apache::lonnet::plaintext(substr($restr,$i,1));
473: if ($i<length($restr)-1) { $trestr.=', '; }
474: }
475: $trestr.=')';
476: }
477: $r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr.
478: '</li>');
479: }
480: }
481: $r->print('</ul>');
482: }
483: }
484: }
485:
486: $r->print("</body></html>\n");
487: return OK;
488: }
489:
490: 1;
491: __END__
492:
493: =head1 NAME
494:
495: Apache::lonroles - User Roles Screen
496:
497: =head1 SYNOPSIS
498:
499: Invoked by /etc/httpd/conf/srm.conf:
500:
501: <Location /adm/roles>
502: PerlAccessHandler Apache::lonacc
503: SetHandler perl-script
504: PerlHandler Apache::lonroles
505: ErrorDocument 403 /adm/login
506: ErrorDocument 500 /adm/errorhandler
507: </Location>
508:
509: =head1 INTRODUCTION
510:
511: This module enables a user to select what role he wishes to
512: operate under (instructor, student, teaching assistant, course
513: coordinator, etc). These roles are pre-established by the actions
514: of upper-level users.
515:
516: This is part of the LearningOnline Network with CAPA project
517: described at http://www.lon-capa.org.
518:
519: =head1 HANDLER SUBROUTINE
520:
521: This routine is called by Apache and mod_perl.
522:
523: =over 4
524:
525: =item *
526:
527: Roles Initialization (yes/no)
528:
529: =item *
530:
531: Get Error Message from Environment
532:
533: =item *
534:
535: Who is this?
536:
537: =item *
538:
539: Generate Page Output
540:
541: =item *
542:
543: Choice or no choice
544:
545: =item *
546:
547: Table
548:
549: =item *
550:
551: Privileges
552:
553: =back
554:
555: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonroles.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / auth