File:  [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.27: download - view: text, annotated - select for diffs
Fri Jul 6 15:11:19 2001 UTC (22 years, 11 months ago) by www
Branches: MAIN
CVS tags: HEAD
Deals with non-existing top-level maps and hides inactive roles

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

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