File:  [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.30: download - view: text, annotated - select for diffs
Wed Oct 31 17:47:55 2001 UTC (22 years, 8 months ago) by albertel
Branches: MAIN
CVS tags: stable_2001_fall, HEAD
- no_caching should be enabled for this page now

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

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