version 1.3, 2000/06/12 18:25:03
|
version 1.4, 2000/07/25 15:40:11
|
Line 4
|
Line 4
|
# (Login Screen |
# (Login Screen |
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer) |
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer) |
# 11/23 Gerd Kortemeyer) |
# 11/23 Gerd Kortemeyer) |
# 1/14,03/06,06/01 Gerd Kortemeyer |
# 1/14,03/06,06/01,07/22,07/24,07/25 Gerd Kortemeyer |
# |
# |
package Apache::lonroles; |
package Apache::lonroles; |
|
|
Line 19 sub handler {
|
Line 19 sub handler {
|
$r->send_http_header; |
$r->send_http_header; |
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
# --------------------------------------------------- Read Plain Text for Roles |
|
|
|
my $tabdir = $r->dir_config('lonTabDir'); |
|
|
|
my @rolesplain; |
|
my %plain; |
|
|
|
{ |
|
my $idf=Apache::File->new("$tabdir/rolesplain.tab"); |
|
@rolesplain=<$idf>; |
|
} |
|
map { |
|
my ($short,$long)=split(/:/,$_); |
|
$plain{$short}=$long; |
|
} @rolesplain; |
|
|
|
# ---------------------------------------------------------------- Print Header |
# ---------------------------------------------------------------- Print Header |
$r->print(<<ENDHEADER); |
$r->print(<<ENDHEADER); |
<html> |
<html> |
Line 52 ENDHEADER
|
Line 36 ENDHEADER
|
|
|
if ($error) { |
if ($error) { |
$r->print("<h1>LON-CAPA Access Control</h1>"); |
$r->print("<h1>LON-CAPA Access Control</h1>"); |
$r->print("<hr><pre>Access : $plain{$priv}<br>"); |
$r->print("<hr><pre>Access : ". |
$r->print("Resource: $fn<br>"); |
Apache::lonnet::plaintext($priv)."\n"); |
$r->print("Action : $msg</pre><hr>"); |
$r->print("Resource: $fn\n"); |
|
$r->print("Action : $msg\n</pre><hr>"); |
$r->log_reason( |
$r->log_reason( |
"$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn); |
"$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn); |
} else { |
} else { |
$r->print("<h1>LON-CAPA User Roles</h1>"); |
$r->print("<h1>LON-CAPA User Roles</h1>"); |
} |
} |
|
|
|
my $now=time; |
|
my $then=$ENV{'user.login.time'}; |
|
|
if ($nochoose) { |
if ($nochoose) { |
$r->print("<h2>Assigned User Roles</h2>"); |
$r->print("<h2>Assigned User Roles</h2>\n"); |
} else { |
} else { |
$r->print("<h2>Select a User Role</h2>\n"); |
$r->print("<h2>Select a User Role</h2>\n"); |
$r->print('<form method=get action="'.$fn.'">'); |
$r->print('<form method=get action="'.$fn.'">'); |
$r->print('<input type=hidden name=blue value=green><input type=submit></form>'); |
|
} |
} |
|
|
|
$r->print('<table><tr><th>User Role</th><th colspan=2>Extent</th>'. |
|
'<th>Start</th><th>End</th><th>Remark</th></tr>'."\n"); |
my $envkey; |
my $envkey; |
foreach $envkey (sort keys %ENV) { |
foreach $envkey (sort keys %ENV) { |
$r->print("$envkey ---- $ENV{$envkey}<br>"); |
|
if ($envkey=~/^user\.role\./) { |
if ($envkey=~/^user\.role\./) { |
my ($dum1,$dum2,$role,$where)=split(/\./,$envkey); |
my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); |
$r->print("$plain{$role} for $where<br>"); |
my $where=join('.',@pwhere); |
|
my ($tstart,$tend)=split(/\./,$ENV{$envkey}); |
|
my $tremark=''; |
|
my $tstatus='is'; |
|
my $tpstart=' '; |
|
my $tpend=' '; |
|
if ($tstart) { |
|
if ($tstart>$then) { |
|
$tstatus='future'; |
|
if ($tstart<$now) { $tstatus='will'; } |
|
} |
|
$tpstart=localtime($tstart); |
|
} |
|
if ($tend) { |
|
if ($tend<$then) { $tstatus='expired'; } |
|
if ($tend>$now) { $tstatus='will_not'; } |
|
$tpend=localtime($tend); |
|
} |
|
my $tbg; |
|
if ($tstatus eq 'is') { |
|
$tbg='#77FF77'; |
|
} elsif ($tstatus eq 'future') { |
|
$tbg='#FFFF77'; |
|
} elsif ($tstatus eq 'will') { |
|
$tbg='#FFAA77'; |
|
$tremark.='Active at next login.'; |
|
} elsif ($tstatus eq 'expired') { |
|
$tbg='#FF7777'; |
|
} elsif ($tstatus eq 'will_not') { |
|
$tbg='#AAFF77'; |
|
$tremark.='Expired after logout.'; |
|
} |
|
my $trole; |
|
if ($role =~ /^cr\//) { |
|
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); |
|
$tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.'; |
|
$trole=$rrole; |
|
} else { |
|
$trole=Apache::lonnet::plaintext($role); |
|
} |
|
my $ttype; |
|
my $twhere; |
|
my ($tres,$tdom,@trest)=split(/\//,$where); |
|
if ($where=~/\.course$/) { |
|
$ttype='Course'; |
|
$twhere=$tdom.'/'.join('/',@trest); |
|
} elsif ($tdom) { |
|
$ttype='Domain'; |
|
$twhere=$tdom; |
|
} else { |
|
$ttype='System'; |
|
$twhere='/'; |
|
} |
|
|
|
$r->print('<tr bgcolor='.$tbg.'><td>'.$trole.'</td><td>'. |
|
$ttype.'</td><td>'.$twhere.'</td><td>'.$tpstart. |
|
'</td><td>'.$tpend. |
|
'</td><td>'.$tremark.' </td></tr>'."\n"); |
|
} |
|
} |
|
|
|
$r->print('</table>'); |
|
unless ($nochoose) { |
|
$r->print("</form>\n"); |
|
} |
|
# ----------------------------------------------------------------- Priviledges |
|
|
|
$r->print('<hr><h2>Priviledges</h2>'); |
|
|
|
foreach $envkey (sort keys %ENV) { |
|
if ($envkey=~/^user\.priv\./) { |
|
my ($dum1,$dum2,@pwhere)=split(/\./,$envkey); |
|
my $where=join('.',@pwhere); |
|
my $ttype; |
|
my $twhere; |
|
my ($tres,$tdom,@trest)=split(/\//,$where); |
|
if ($where=~/\.course$/) { |
|
$ttype='Course'; |
|
$twhere=$tdom.'/'.join('/',@trest); |
|
} elsif ($tdom) { |
|
$ttype='Domain'; |
|
$twhere=$tdom; |
|
} else { |
|
$ttype='System'; |
|
$twhere='/'; |
|
} |
|
$r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>'); |
|
map { |
|
if ($_) { |
|
my ($prv,$restr)=split(/\&/,$_); |
|
my $trestr=''; |
|
if ($restr ne 'F') { |
|
my $i; |
|
for ($i=0;$i<length($restr);$i++) { |
|
$trestr=' ('. |
|
Apache::lonnet::plaintext(substr($restr,$i,1)).') '; |
|
} |
|
} |
|
$r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr. |
|
'</li>'); |
|
} |
|
} sort split(/:/,$ENV{$envkey}); |
|
$r->print('</ul>'); |
} |
} |
} |
} |
|
|
|
# -------------------------------------------------------------- Debug - remove |
|
|
|
$->print("<hr><h1>Debugging</h1><hr>\n"); |
|
|
|
foreach $envkey (sort keys %ENV) { |
|
$r->print("$envkey ---- $ENV{$envkey}<br>"); |
|
} |
|
|
$r->print("</body></html>\n"); |
$r->print("</body></html>\n"); |
return OK; |
return OK; |
} |
} |