File:  [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.29: download - view: text, annotated - select for diffs
Fri Oct 26 17:09:04 2001 UTC (22 years, 10 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- added some meta tags to prevent caching

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

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