Annotation of loncom/auth/lonroles.pm, revision 1.26
1.1 harris41 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)
1.7 www 7: # 1/14,03/06,06/01,07/22,07/24,07/25,
1.19 www 8: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,
1.20 www 9: # 12/08,12/28,
10: # 01/15/01 Gerd Kortemeyer
1.22 harris41 11: # 02/27/01 Scott Harrison
1.26 ! www 12: # 03/02,05/03,05/25,05/30,06/01 Gerd Kortemeyer
1.22 harris41 13:
1.1 harris41 14: package Apache::lonroles;
15:
16: use strict;
17: use Apache::lonnet();
1.7 www 18: use Apache::lonuserstate();
1.1 harris41 19: use Apache::Constants qw(:common);
1.2 www 20: use Apache::File();
1.26 ! www 21: use Apache::lonmenu;
1.1 harris41 22:
23: sub handler {
1.10 www 24:
1.1 harris41 25: my $r = shift;
26:
1.6 www 27: my $now=time;
28: my $then=$ENV{'user.login.time'};
29: my $envkey;
30:
1.10 www 31:
1.6 www 32: # ================================================================== Roles Init
33:
34: if ($ENV{'form.selectrole'}) {
1.13 www 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\./) {
1.6 www 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'; }
1.19 www 55: if ($tend<$now) { $tstatus='will_not'; }
1.6 www 56: }
57: if ($tstatus eq 'is') {
1.13 www 58: $where=~s/^\///;
59: my ($cdom,$cnum,$csec)=split(/\//,$where);
60: &Apache::lonnet::appenv('request.role' => $trolecode,
1.14 www 61: 'request.course.sec' => $csec);
1.25 www 62: if (($cnum) && ($role ne 'ca')) {
1.19 www 63: my ($furl,$ferr)=
64: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.20 www 65: if (($ENV{'form.orgurl'}) &&
66: ($ENV{'form.orgurl'}!~/^\/adm\/flip/)) {
1.11 www 67: $r->internal_redirect($ENV{'form.orgurl'});
68: return OK;
1.19 www 69: } else {
1.20 www 70: $r->content_type('text/html');
71: $r->send_http_header;
1.26 ! www 72: my $swinfo=&Apache::lonmenu::rawconfig;
1.20 www 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">
1.26 ! www 79: <script>
! 80: $swinfo
! 81: </script>
1.20 www 82: Entering course ...
83: </body>
84: </html>
85: ENDREDIR
86: return OK;
1.19 www 87: }
1.7 www 88: }
1.6 www 89: }
90: }
91: }
92: }
1.20 www 93: }
1.6 www 94:
1.10 www 95:
1.6 www 96: # =============================================================== No Roles Init
1.10 www 97:
98: $r->content_type('text/html');
99: $r->send_http_header;
100: return OK if $r->header_only;
101:
1.26 ! www 102: my $swinfo=&Apache::lonmenu::rawconfig;
! 103:
1.10 www 104: $r->print(<<ENDHEADER);
105: <html>
106: <head>
107: <title>LON-CAPA User Roles</title>
108: </head><body bgcolor="#FFFFFF">
1.26 ! www 109: <script>
! 110: $swinfo
! 111: window.focus();
! 112: </script>
1.10 www 113: ENDHEADER
1.6 www 114:
1.2 www 115: # ------------------------------------------ Get Error Message from Environment
116:
117: my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
1.12 www 118: if ($ENV{'user.error.msg'}) {
119: $r->log_reason(
120: "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
121: }
1.1 harris41 122:
1.6 www 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:
1.2 www 133: # -------------------------------------------------------- Generate Page Output
1.6 www 134: # --------------------------------------------------------------- Error Header?
1.2 www 135: if ($error) {
136: $r->print("<h1>LON-CAPA Access Control</h1>");
1.4 www 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>");
1.2 www 141: } else {
142: $r->print("<h1>LON-CAPA User Roles</h1>");
1.25 www 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: }
1.2 www 148: }
1.6 www 149: # -------------------------------------------------------- Choice or no choice?
1.2 www 150: if ($nochoose) {
1.6 www 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");
1.17 www 168: }
1.18 www 169: if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
170: $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6 www 171: }
1.11 www 172: $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
1.6 www 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");
1.4 www 181:
1.3 albertel 182: foreach $envkey (sort keys %ENV) {
1.2 www 183: if ($envkey=~/^user\.role\./) {
1.4 www 184: my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
185: my $where=join('.',@pwhere);
1.6 www 186: my $trolecode=$role.'.'.$where;
1.4 www 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) {
1.23 www 200: if ($tend<$then) {
201: $tstatus='expired';
202: } elsif ($tend<$now) {
203: $tstatus='will_not';
204: }
1.4 www 205: $tpend=localtime($tend);
206: }
1.6 www 207: if ($ENV{'request.role'} eq $trolecode) {
208: $tstatus='selected';
209: }
1.4 www 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';
1.6 www 217: $tremark.='Active at next login. ';
1.4 www 218: } elsif ($tstatus eq 'expired') {
219: $tbg='#FF7777';
220: } elsif ($tstatus eq 'will_not') {
221: $tbg='#AAFF77';
1.6 www 222: $tremark.='Expired after logout. ';
223: } elsif ($tstatus eq 'selected') {
1.19 www 224: $tbg='#11CC55';
1.6 www 225: $tremark.='Currently selected. ';
1.4 www 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;
1.13 www 237: my ($tdom,$trest,$tsection)=
1.8 www 238: split(/\//,Apache::lonnet::declutter($where));
1.6 www 239: if ($trest) {
1.24 www 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 {
1.4 www 245: $ttype='Course';
1.13 www 246: if ($tsection) {
247: $ttype.='<br>Section/Group: '.$tsection;
248: }
1.16 www 249: my $tcourseid=$tdom.'_'.$trest;
250: if ($ENV{'course.'.$tcourseid.'.description'}) {
251: $twhere=$ENV{'course.'.$tcourseid.'.description'};
1.8 www 252: } else {
253: my %newhash=Apache::lonnet::coursedescription($tcourseid);
254: if (%newhash) {
255: $twhere=$newhash{'description'};
256: } else {
257: $twhere='Currently not available';
1.16 www 258: $ENV{'course.'.$tcourseid.'.description'}=$twhere;
1.8 www 259: }
1.13 www 260: }
1.24 www 261: }
1.4 www 262: } elsif ($tdom) {
263: $ttype='Domain';
264: $twhere=$tdom;
265: } else {
266: $ttype='System';
1.8 www 267: $twhere='system wide';
1.4 www 268: }
269:
1.6 www 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>'.
1.4 www 280: $ttype.'</td><td>'.$twhere.'</td><td>'.$tpstart.
281: '</td><td>'.$tpend.
282: '</td><td>'.$tremark.' </td></tr>'."\n");
283: }
284: }
1.14 www 285: my $tremark='';
286: if ($ENV{'request.role'} eq 'cm') {
1.19 www 287: $r->print('<tr bgcolor="#11CC55">');
1.14 www 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");
1.4 www 301:
302: $r->print('</table>');
303: unless ($nochoose) {
304: $r->print("</form>\n");
305: }
1.22 harris41 306: # ------------------------------------------------------------ Privileges Info
1.6 www 307: if ($advanced) {
1.22 harris41 308: $r->print('<hr><h2>Current Privileges</h2>');
1.4 www 309:
310: foreach $envkey (sort keys %ENV) {
1.15 www 311: if ($envkey=~/^user\.priv\.$ENV{'request.role'}\./) {
312: my $where=$envkey;
313: $where=~s/^user\.priv\.$ENV{'request.role'}\.//;
1.4 www 314: my $ttype;
315: my $twhere;
1.15 www 316: my ($tdom,$trest,$tsec)=
1.8 www 317: split(/\//,Apache::lonnet::declutter($where));
1.6 www 318: if ($trest) {
1.24 www 319: if ($ENV{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
320: $ttype='Construction Space';
321: $twhere='User: '.$trest.', Domain: '.$tdom;
322: } else {
1.4 www 323: $ttype='Course';
1.16 www 324: $twhere=$ENV{'course.'.$tdom.'_'.$trest.'.description'};
1.15 www 325: if ($tsec) {
326: $twhere.=' (Section/Group: '.$tsec.')';
327: }
1.24 www 328: }
1.4 www 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;
1.5 www 343: $trestr.=' (';
1.4 www 344: for ($i=0;$i<length($restr);$i++) {
1.5 www 345: $trestr.=
346: Apache::lonnet::plaintext(substr($restr,$i,1));
347: if ($i<length($restr)-1) { $trestr.=', '; }
348: }
349: $trestr.=')';
1.4 www 350: }
351: $r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr.
352: '</li>');
353: }
354: } sort split(/:/,$ENV{$envkey});
355: $r->print('</ul>');
1.2 www 356: }
1.4 www 357: }
1.6 www 358: }
1.2 www 359:
1.1 harris41 360: $r->print("</body></html>\n");
361: return OK;
362: }
363:
364: 1;
365: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>