1: # The LearningOnline Network with CAPA
2: # User Roles Screen
3: # (Directory Indexer
4: # (Login Screen
5: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
6: # 11/23 Gerd Kortemeyer)
7: # 1/14,03/06,06/01,07/22,07/24,07/25,
8: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,
9: # 12/08,12/28,
10: # 01/15/01 Gerd Kortemeyer
11: # 02/27/01 Scott Harrison
12: # 03/02,05/03,05/25,05/30,06/01 Gerd Kortemeyer
13:
14: package Apache::lonroles;
15:
16: use strict;
17: use Apache::lonnet();
18: use Apache::lonuserstate();
19: use Apache::Constants qw(:common);
20: use Apache::File();
21: use Apache::lonmenu;
22:
23: sub handler {
24:
25: my $r = shift;
26:
27: my $now=time;
28: my $then=$ENV{'user.login.time'};
29: my $envkey;
30:
31:
32: # ================================================================== Roles Init
33:
34: if ($ENV{'form.selectrole'}) {
35: &Apache::lonnet::appenv("request.course.id" => '',
36: "request.course.fn" => '',
37: "request.course.uri" => '',
38: "request.course.sec" => '',
39: "request.role" => 'cm');
40: foreach $envkey (keys %ENV) {
41: if ($envkey=~/^user\.role\./) {
42: my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
43: my $where=join('.',@pwhere);
44: my $trolecode=$role.'.'.$where;
45: if ($ENV{'form.'.$trolecode}) {
46: my ($tstart,$tend)=split(/\./,$ENV{$envkey});
47: my $tstatus='is';
48: if ($tstart) {
49: if ($tstart>$then) {
50: $tstatus='future';
51: }
52: }
53: if ($tend) {
54: if ($tend<$then) { $tstatus='expired'; }
55: if ($tend<$now) { $tstatus='will_not'; }
56: }
57: if ($tstatus eq 'is') {
58: $where=~s/^\///;
59: my ($cdom,$cnum,$csec)=split(/\//,$where);
60: &Apache::lonnet::appenv('request.role' => $trolecode,
61: 'request.course.sec' => $csec);
62: if (($cnum) && ($role ne 'ca')) {
63: my ($furl,$ferr)=
64: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
65: if (($ENV{'form.orgurl'}) &&
66: ($ENV{'form.orgurl'}!~/^\/adm\/flip/)) {
67: $r->internal_redirect($ENV{'form.orgurl'});
68: return OK;
69: } else {
70: $r->content_type('text/html');
71: $r->send_http_header;
72: my $swinfo=&Apache::lonmenu::rawconfig;
73: print (<<ENDREDIR);
74: <head><title>Entering Course</title>
75: <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$furl">
76: </head>
77: <html>
78: <body bgcolor="#FFFFFF">
79: <script>
80: $swinfo
81: </script>
82: Entering course ...
83: </body>
84: </html>
85: ENDREDIR
86: return OK;
87: }
88: }
89: }
90: }
91: }
92: }
93: }
94:
95:
96: # =============================================================== No Roles Init
97:
98: $r->content_type('text/html');
99: $r->send_http_header;
100: return OK if $r->header_only;
101:
102: my $swinfo=&Apache::lonmenu::rawconfig;
103:
104: $r->print(<<ENDHEADER);
105: <html>
106: <head>
107: <title>LON-CAPA User Roles</title>
108: </head><body bgcolor="#FFFFFF">
109: <script>
110: $swinfo
111: window.focus();
112: </script>
113: ENDHEADER
114:
115: # ------------------------------------------ Get Error Message from Environment
116:
117: my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
118: if ($ENV{'user.error.msg'}) {
119: $r->log_reason(
120: "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
121: }
122:
123: # ---------------------------------------------------------------- Who is this?
124:
125: my $advanced=0;
126: foreach $envkey (keys %ENV) {
127: if ($envkey=~/^user\.role\./) {
128: my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
129: if ($role ne 'st') { $advanced=1; }
130: }
131: }
132:
133: # -------------------------------------------------------- Generate Page Output
134: # --------------------------------------------------------------- Error Header?
135: if ($error) {
136: $r->print("<h1>LON-CAPA Access Control</h1>");
137: $r->print("<hr><pre>Access : ".
138: Apache::lonnet::plaintext($priv)."\n");
139: $r->print("Resource: $fn\n");
140: $r->print("Action : $msg\n</pre><hr>");
141: } else {
142: $r->print("<h1>LON-CAPA User Roles</h1>");
143: if ($ENV{'user.error.msg'}) {
144: $r->print(
145: '<h3><font color=red>You need to choose another user role or '.
146: 'enter a specific course for this function</font></h3>');
147: }
148: }
149: # -------------------------------------------------------- Choice or no choice?
150: if ($nochoose) {
151: if ($advanced) {
152: $r->print("<h2>Assigned User Roles</h2>\n");
153: } else {
154: $r->print("<h2>Sorry ...</h2>\nThis resource might be part of");
155: if ($ENV{'request.course.id'}) {
156: $r->print(' another');
157: } else {
158: $r->print(' a certain');
159: }
160: $r->print(' course.</body></html>');
161: return OK;
162: }
163: } else {
164: if ($advanced) {
165: $r->print("<h2>Select a User Role</h2>\n");
166: } else {
167: $r->print("<h2>Enter a Course</h2>\n");
168: }
169: if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
170: $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
171: }
172: $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
173: $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
174: $r->print('<input type=hidden name=selectrole value=1>');
175: }
176: # ----------------------------------------------------------------------- Table
177: $r->print('<table><tr>');
178: unless ($nochoose) { $r->print('<th> </th>'); }
179: $r->print('<th>User Role</th><th colspan=2>Extent</th>'.
180: '<th>Start</th><th>End</th><th>Remark</th></tr>'."\n");
181:
182: foreach $envkey (sort keys %ENV) {
183: if ($envkey=~/^user\.role\./) {
184: my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
185: my $where=join('.',@pwhere);
186: my $trolecode=$role.'.'.$where;
187: my ($tstart,$tend)=split(/\./,$ENV{$envkey});
188: my $tremark='';
189: my $tstatus='is';
190: my $tpstart=' ';
191: my $tpend=' ';
192: if ($tstart) {
193: if ($tstart>$then) {
194: $tstatus='future';
195: if ($tstart<$now) { $tstatus='will'; }
196: }
197: $tpstart=localtime($tstart);
198: }
199: if ($tend) {
200: if ($tend<$then) {
201: $tstatus='expired';
202: } elsif ($tend<$now) {
203: $tstatus='will_not';
204: }
205: $tpend=localtime($tend);
206: }
207: if ($ENV{'request.role'} eq $trolecode) {
208: $tstatus='selected';
209: }
210: my $tbg;
211: if ($tstatus eq 'is') {
212: $tbg='#77FF77';
213: } elsif ($tstatus eq 'future') {
214: $tbg='#FFFF77';
215: } elsif ($tstatus eq 'will') {
216: $tbg='#FFAA77';
217: $tremark.='Active at next login. ';
218: } elsif ($tstatus eq 'expired') {
219: $tbg='#FF7777';
220: } elsif ($tstatus eq 'will_not') {
221: $tbg='#AAFF77';
222: $tremark.='Expired after logout. ';
223: } elsif ($tstatus eq 'selected') {
224: $tbg='#11CC55';
225: $tremark.='Currently selected. ';
226: }
227: my $trole;
228: if ($role =~ /^cr\//) {
229: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
230: $tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.';
231: $trole=$rrole;
232: } else {
233: $trole=Apache::lonnet::plaintext($role);
234: }
235: my $ttype;
236: my $twhere;
237: my ($tdom,$trest,$tsection)=
238: split(/\//,Apache::lonnet::declutter($where));
239: if ($trest) {
240: if ($role eq 'ca') {
241: $ttype='Construction Space';
242: $twhere='User: '.$trest.'<br>Domain: '.$tdom;
243: $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
244: } else {
245: $ttype='Course';
246: if ($tsection) {
247: $ttype.='<br>Section/Group: '.$tsection;
248: }
249: my $tcourseid=$tdom.'_'.$trest;
250: if ($ENV{'course.'.$tcourseid.'.description'}) {
251: $twhere=$ENV{'course.'.$tcourseid.'.description'};
252: } else {
253: my %newhash=Apache::lonnet::coursedescription($tcourseid);
254: if (%newhash) {
255: $twhere=$newhash{'description'};
256: } else {
257: $twhere='Currently not available';
258: $ENV{'course.'.$tcourseid.'.description'}=$twhere;
259: }
260: }
261: }
262: } elsif ($tdom) {
263: $ttype='Domain';
264: $twhere=$tdom;
265: } else {
266: $ttype='System';
267: $twhere='system wide';
268: }
269:
270: $r->print('<tr bgcolor='.$tbg.'>');
271: unless ($nochoose) {
272: if ($tstatus eq 'is') {
273: $r->print('<td><input type=submit value=Select name="'.
274: $trolecode.'"></td>');
275: } else {
276: $r->print('<td> </td>');
277: }
278: }
279: $r->print('<td>'.$trole.'</td><td>'.
280: $ttype.'</td><td>'.$twhere.'</td><td>'.$tpstart.
281: '</td><td>'.$tpend.
282: '</td><td>'.$tremark.' </td></tr>'."\n");
283: }
284: }
285: my $tremark='';
286: if ($ENV{'request.role'} eq 'cm') {
287: $r->print('<tr bgcolor="#11CC55">');
288: $tremark='Currently selected.';
289: } else {
290: $r->print('<tr bgcolor="#77FF77">');
291: }
292: unless ($nochoose) {
293: if ($ENV{'request.role'} ne 'cm') {
294: $r->print('<td><input type=submit value=Select name="cm"></td>');
295: } else {
296: $r->print('<td> </td>');
297: }
298: }
299: $r->print('<td colspan=5>No role specified'.
300: '</td><td>'.$tremark.' </td></tr>'."\n");
301:
302: $r->print('</table>');
303: unless ($nochoose) {
304: $r->print("</form>\n");
305: }
306: # ------------------------------------------------------------ Privileges Info
307: if ($advanced) {
308: $r->print('<hr><h2>Current Privileges</h2>');
309:
310: foreach $envkey (sort keys %ENV) {
311: if ($envkey=~/^user\.priv\.$ENV{'request.role'}\./) {
312: my $where=$envkey;
313: $where=~s/^user\.priv\.$ENV{'request.role'}\.//;
314: my $ttype;
315: my $twhere;
316: my ($tdom,$trest,$tsec)=
317: split(/\//,Apache::lonnet::declutter($where));
318: if ($trest) {
319: if ($ENV{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
320: $ttype='Construction Space';
321: $twhere='User: '.$trest.', Domain: '.$tdom;
322: } else {
323: $ttype='Course';
324: $twhere=$ENV{'course.'.$tdom.'_'.$trest.'.description'};
325: if ($tsec) {
326: $twhere.=' (Section/Group: '.$tsec.')';
327: }
328: }
329: } elsif ($tdom) {
330: $ttype='Domain';
331: $twhere=$tdom;
332: } else {
333: $ttype='System';
334: $twhere='/';
335: }
336: $r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
337: map {
338: if ($_) {
339: my ($prv,$restr)=split(/\&/,$_);
340: my $trestr='';
341: if ($restr ne 'F') {
342: my $i;
343: $trestr.=' (';
344: for ($i=0;$i<length($restr);$i++) {
345: $trestr.=
346: Apache::lonnet::plaintext(substr($restr,$i,1));
347: if ($i<length($restr)-1) { $trestr.=', '; }
348: }
349: $trestr.=')';
350: }
351: $r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr.
352: '</li>');
353: }
354: } sort split(/:/,$ENV{$envkey});
355: $r->print('</ul>');
356: }
357: }
358: }
359:
360: $r->print("</body></html>\n");
361: return OK;
362: }
363:
364: 1;
365: __END__
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