[BACK]Return to lonroles.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonroles.pm between versions 1.1 and 1.3

version 1.1, 2000/02/22 21:36:44 version 1.3, 2000/06/12 18:25:03
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 Gerd Kortemeyer  # 1/14,03/06,06/01 Gerd Kortemeyer
 #  #
 package Apache::lonroles;  package Apache::lonroles;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet();
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use CGI::Cookie();  use Apache::File();
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
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;
   
     my $iconpath= $r->dir_config('lonIconsURL');  # --------------------------------------------------- Read Plain Text for Roles
     my $domain  = $r->dir_config('lonDefDomain');  
     my $role    = $r->dir_config('lonRole');  
     my $loadlim = $r->dir_config('lonLoadLim');  
     my $servadm = $r->dir_config('lonAdmEMail');  
     my $sysadm  = $r->dir_config('lonSysEMail');  
     my $lonhost = $r->dir_config('lonHostID');  
     my $tabdir  = $r->dir_config('lonTabDir');      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 37  sub handler { Line 44  sub handler {
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
 ENDHEADER  ENDHEADER
   
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));  # ------------------------------------------ Get Error Message from Environment
     my $lonurl=$cookies{'lonURL'};  
     my $lowerurl=$lonurl->value;      my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
   
   # -------------------------------------------------------- Generate Page Output
   
       if ($error) {
    $r->print("<h1>LON-CAPA Access Control</h1>");
           $r->print("<hr><pre>Access  : $plain{$priv}<br>");
           $r->print("Resource: $fn<br>");
           $r->print("Action  : $msg</pre><hr>");
           $r->log_reason(
    "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
       } else {
           $r->print("<h1>LON-CAPA User Roles</h1>");
       }
   
       if ($nochoose) {
    $r->print("<h2>Assigned User Roles</h2>");
       } else {
           $r->print("<h2>Select a User Role</h2>\n");
           $r->print('<form method=get action="'.$fn.'">');
   $r->print('<input type=hidden name=blue value=green><input type=submit></form>');
       }
     my $envkey;      my $envkey;
     foreach $envkey (sort keys %ENV) {      foreach $envkey (sort keys %ENV) {
  $r->print("$envkey: $ENV{$envkey}<br>\n");   $r->print("$envkey ---- $ENV{$envkey}<br>");
           if ($envkey=~/^user\.role\./) {
       my ($dum1,$dum2,$role,$where)=split(/\./,$envkey);
               $r->print("$plain{$role} for $where<br>");
           }
     }      }
     $r->print("<p>URL: $lowerurl");  
     $r->print("</body></html>\n");      $r->print("</body></html>\n");
     return OK;      return OK;
 }   } 
Removed from v.1.1  
changed lines
  Added in v.1.3

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>