File:  [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.49: download - view: text, annotated - select for diffs
Wed Jan 29 15:22:06 2003 UTC (21 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD
Bug #1201
* Syllabus link is separate
* Easy "switch server" link to deal with authoring space
* Does not provide buttons to "re-initialize" expired courses
  (which of course does not work and bounced you back to "Roles".

    1: # The LearningOnline Network with CAPA
    2: # User Roles Screen
    3: #
    4: # $Id: lonroles.pm,v 1.49 2003/01/29 15:22:06 www Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # (Directory Indexer
   29: # (Login Screen
   30: # YEAR=1999
   31: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
   32: # 11/23 Gerd Kortemeyer)
   33: # YEAR=2000
   34: # 1/14,03/06,06/01,07/22,07/24,07/25,
   35: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,
   36: # 12/08,12/28,
   37: # YEAR=2001
   38: # 01/15/01 Gerd Kortemeyer
   39: # 02/27/01 Scott Harrison
   40: # 03/02,05/03,05/25,05/30,06/01,07/06,08/06 Gerd Kortemeyer
   41: # 12/21 Scott Harrison
   42: # 12/29 Gerd Kortemeyer
   43: #
   44: ###
   45: 
   46: package Apache::lonroles;
   47: 
   48: use strict;
   49: use Apache::lonnet();
   50: use Apache::lonuserstate();
   51: use Apache::Constants qw(:common);
   52: use Apache::File();
   53: use Apache::lonmenu;
   54: use Apache::loncommon;
   55: 
   56: sub handler {
   57: 
   58:     my $r = shift;
   59: 
   60:     my $now=time;
   61:     my $then=$ENV{'user.login.time'};
   62:     my $envkey;
   63: 
   64: 
   65: # ================================================================== Roles Init
   66: 
   67:     if ($ENV{'form.selectrole'}) {
   68: 	if ($ENV{'request.course.id'}) {
   69: 	    my %temp=('logout_'.$ENV{'request.course.id'} => time);
   70: 	    &Apache::lonnet::put('email_status',\%temp);
   71:         }
   72:        &Apache::lonnet::appenv("request.course.id"   => '',
   73:                                "request.course.fn"   => '',
   74:                                "request.course.uri"  => '',
   75:                                "request.course.sec"  => '',
   76:                                "request.role"        => 'cm',
   77:                                "request.role.domain" => $ENV{'user.domain'}); 
   78:         foreach $envkey (keys %ENV) {
   79:             next if ($envkey!~/^user\.role\./);
   80: 	    my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
   81:             my $where=join('.',@pwhere);
   82:             my $trolecode=$role.'.'.$where;
   83:             if ($ENV{'form.'.$trolecode}) {
   84:                my ($tstart,$tend)=split(/\./,$ENV{$envkey});
   85:                my $tstatus='is';
   86:                if ($tstart) {
   87:       		  if ($tstart>$then) { 
   88:                      $tstatus='future';
   89:                   }
   90:                }
   91:                if ($tend) {
   92:                   if ($tend<$then) { $tstatus='expired'; }
   93:                   if ($tend<$now) { $tstatus='will_not'; }
   94:                }
   95:                if ($tstatus eq 'is') {
   96:                    $where=~s/^\///;
   97:                    my ($cdom,$cnum,$csec)=split(/\//,$where);
   98:                    &Apache::lonnet::appenv('request.role'        => $trolecode,
   99:                                            'request.role.domain' => $cdom,
  100:                                            'request.course.sec'  => $csec);
  101:                    my $msg='Entering course ...';
  102:                    if (($cnum) && ($role ne 'ca')) {
  103: 		      my ($furl,$ferr)=
  104: 			  &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  105:                       if (($ENV{'form.orgurl'}) && 
  106:                           ($ENV{'form.orgurl'}!~/^\/adm\/flip/)) {
  107:                          $r->internal_redirect($ENV{'form.orgurl'});
  108:                          return OK;
  109: 		     } else {
  110:                          unless ($ENV{'request.course.id'}) {
  111:                              &Apache::lonnet::appenv(
  112: 				 "request.course.id"  => $cdom.'_'.$cnum);
  113:                              $furl='/adm/notfound.html';
  114:                              $msg=
  115: 	 '<h1><font color=red>Could not initialize top-level map.</font></h1>';
  116:                           }
  117: 	                 $r->content_type('text/html');
  118:                          &Apache::loncommon::no_cache($r);
  119:                          $r->send_http_header;
  120:                          my $swinfo=&Apache::lonmenu::rawconfig($r);
  121:                          my $bodytag=&Apache::loncommon::bodytag('Switching Role');
  122:                          print (<<ENDREDIR);
  123: <head><title>Entering Course</title>
  124: <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$furl">
  125: </head>
  126: <html>
  127: $bodytag
  128: <script>
  129: $swinfo
  130: </script>
  131: <h1>$msg</h1>
  132: </body>
  133: </html>
  134: ENDREDIR
  135:                             return OK;
  136:                      }
  137:                    }
  138:                }
  139:             } 
  140:         }
  141:     }
  142: 
  143: 
  144: # =============================================================== No Roles Init
  145: 
  146:     $r->content_type('text/html');
  147:     &Apache::loncommon::no_cache($r);
  148:     $r->send_http_header;
  149:     return OK if $r->header_only;
  150: 
  151:     my $swinfo=&Apache::lonmenu::rawconfig($r);
  152:     my $bodytag=&Apache::loncommon::bodytag('User Roles');
  153:     my $helptag=&Apache::loncommon::help_open_topic
  154:      ("General_Intro","<font size='+1'><b>CLICK HERE FOR HELP</b></font>");
  155:     $r->print(<<ENDHEADER);
  156: <html>
  157: <head>
  158: <title>LON-CAPA User Roles</title>
  159: </head>
  160: $bodytag
  161: $helptag<br />
  162: <script>
  163: $swinfo
  164: window.focus();
  165: </script>
  166: ENDHEADER
  167: 
  168: # ------------------------------------------ Get Error Message from Environment
  169: 
  170:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
  171:     if ($ENV{'user.error.msg'}) {
  172:        $r->log_reason(
  173:      "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
  174:     }
  175: 
  176: # ---------------------------------------------------------------- Who is this?
  177: 
  178:     my $advanced=0;
  179:     foreach $envkey (keys %ENV) {
  180:         if ($envkey=~/^user\.role\./) {
  181: 	    my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
  182:             if ($role ne 'st') { $advanced=1; }
  183:         }
  184:     }
  185: 
  186: # -------------------------------------------------------- Generate Page Output
  187: # --------------------------------------------------------------- Error Header?
  188:     if ($error) {
  189: 	$r->print("<h1>LON-CAPA Access Control</h1>");
  190:         $r->print("<hr><pre>Access  : ".
  191:                   Apache::lonnet::plaintext($priv)."\n");
  192:         $r->print("Resource: $fn\n");
  193:         $r->print("Action  : $msg\n</pre><hr>");
  194:     } else {
  195:         if ($ENV{'user.error.msg'}) {
  196: 	    $r->print(
  197:  '<h3><font color=red>You need to choose another user role or '.
  198:  'enter a specific course for this function</font></h3>');
  199: 	}
  200:     }
  201: # -------------------------------------------------------- Choice or no choice?
  202:     if ($nochoose) {
  203:         if ($advanced) {
  204: 	   $r->print("<h2>Assigned User Roles</h2>\n");
  205:         } else {
  206:            $r->print("<h2>Sorry ...</h2>\nThis resource might be part of");
  207:            if ($ENV{'request.course.id'}) {
  208: 	       $r->print(' another');
  209:            } else {
  210:                $r->print(' a certain');
  211:            } 
  212:            $r->print(' course.</body></html>');
  213:            return OK;
  214:         } 
  215:     } else {
  216:         if ($advanced) {
  217:            $r->print("Your home server is ".
  218:                      $Apache::lonnet::hostname{&Apache::lonnet::homeserver
  219:                      ($ENV{'user.name'},$ENV{'user.domain'})}.
  220: 		     "<br />\n");
  221:            $r->print("Author and Co-Author roles may not be available on ".
  222:                      "servers other than your home server.");
  223:         } else {
  224: 	   $r->print("<h2>Enter a Course</h2>\n");
  225:         }
  226:         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
  227:     	    $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
  228:         }
  229:         $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
  230:         $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
  231:         $r->print('<input type=hidden name=selectrole value=1>');
  232:     }
  233:     $r->print('<br>Show all roles: <input type=checkbox name=showall');
  234:     if ($ENV{'form.showall'}) { $r->print(' checked'); }
  235:     $r->print('><input type=submit value="Display"><br>');
  236: # ----------------------------------------------------------------------- Table
  237:     $r->print('<table><tr>');
  238:     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
  239:        $r->print('<th>User Role</th><th colspan=2>Extent</th>'.
  240:                  '<th>Start</th><th>End</th><th>Remark</th></tr>'."\n");
  241: 
  242:     foreach $envkey (sort keys %ENV) {
  243:         my $button = 1;
  244:         my $switchserver='';
  245:         if ($envkey=~/^user\.role\./) {
  246: 	    my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
  247:             next if (!defined($role) || $role eq '');
  248:             my $where=join('.',@pwhere);
  249:             my $trolecode=$role.'.'.$where;
  250:             my ($tstart,$tend)=split(/\./,$ENV{$envkey});
  251:             my $tremark='';
  252:             my $tstatus='is';
  253:             my $tpstart='&nbsp;';
  254:             my $tpend='&nbsp;';
  255:             my $tfont='#000000';
  256:             if ($tstart) {
  257: 		if ($tstart>$then) { 
  258:                     $tstatus='future';
  259:                     if ($tstart<$now) { $tstatus='will'; }
  260:                 }
  261:                 $tpstart=localtime($tstart);
  262:             }
  263:             if ($tend) {
  264:                 if ($tend<$then) { 
  265:                     $tstatus='expired'; 
  266:                 } elsif ($tend<$now) { 
  267:                     $tstatus='will_not'; 
  268:                 }
  269:                 $tpend=localtime($tend);
  270:             }
  271:             if ($ENV{'request.role'} eq $trolecode) {
  272: 		$tstatus='selected';
  273:             }
  274:             my $tbg;
  275:             if (($tstatus eq 'is') || ($tstatus eq 'selected') ||
  276:                 ($ENV{'form.showall'})) {
  277:                 if ($tstatus eq 'is') {
  278:                     $tbg='#77FF77';
  279:                     $tfont='#003300';
  280:                 } elsif ($tstatus eq 'future') {
  281:                     $tbg='#FFFF77';
  282:                     $button=0;
  283:                 } elsif ($tstatus eq 'will') {
  284:                     $tbg='#FFAA77';
  285:                     $tremark.='Active at next login. ';
  286:                 } elsif ($tstatus eq 'expired') {
  287:                     $tbg='#FF7777';
  288:                     $tfont='#330000';
  289:                     $button=0;
  290:                 } elsif ($tstatus eq 'will_not') {
  291:                     $tbg='#AAFF77';
  292:                     $tremark.='Expired after logout. ';
  293:                 } elsif ($tstatus eq 'selected') {
  294:                     $tbg='#11CC55';
  295:                     $tfont='#002200';
  296:                     $tremark.='Currently selected. ';
  297:                 }
  298:                 my $trole;
  299:                 if ($role =~ /^cr\//) {
  300:                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
  301:                     $tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.';
  302:                     $trole=$rrole;
  303:                 } else {
  304:                     $trole=Apache::lonnet::plaintext($role);
  305:                 }
  306:                 my $ttype;
  307:                 my $twhere;
  308:                 my ($tdom,$trest,$tsection)=
  309:                     split(/\//,Apache::lonnet::declutter($where));
  310:                 # First, Co-Authorship roles
  311:                 if ($role eq 'ca') {
  312:                     my $home = &Apache::lonnet::homeserver($trest,$tdom);
  313:                     if ($home ne $r->dir_config('lonHostID')) {
  314: 			$button=0;
  315:                         $switchserver='http://'.
  316:                          $Apache::lonnet::hostname{$home}.'/priv/'.$trest;
  317:                     }
  318:                     #next if ($home eq 'no_host');
  319:                     $home = $Apache::lonnet::hostname{$home};
  320:                     $ttype='Construction Space';
  321:                     $twhere='User: '.$trest.'<br />Domain: '.$tdom.'<br />'.
  322:                         ' Server:&nbsp;'.$home;
  323:                     $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
  324:                 } elsif ($role eq 'au') {
  325:                     # Authors
  326:                     my $home = &Apache::lonnet::homeserver
  327:                         ($ENV{'user.name'},$ENV{'user.domain'});
  328:                     if ($home ne $r->dir_config('lonHostID')) {
  329: 			$button=0;
  330:                         $switchserver='http://'.
  331:                          $Apache::lonnet::hostname{$home}.'/priv/'.
  332:                          $ENV{'user.name'};
  333:                     }
  334:                     #next if ($home eq 'no_host');
  335:                     $home = $Apache::lonnet::hostname{$home};
  336:                     $ttype='Construction Space';
  337:                     $twhere='Domain: '.$tdom.'<br />Server:&nbsp;'.$home;
  338:                     $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
  339:                 } elsif ($trest) {
  340:                     $ttype='Course';
  341:                     if ($tsection) {
  342:                         $ttype.='<br>Section/Group: '.$tsection;
  343: 		    }
  344:                     my $tcourseid=$tdom.'_'.$trest;
  345:                     if ($ENV{'course.'.$tcourseid.'.description'}) {
  346:                         $twhere=$ENV{'course.'.$tcourseid.'.description'};
  347:                         unless ($twhere eq 'Currently not available') {
  348:                            $twhere.=' <font size="-2">'.
  349:         &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
  350:                                     '</font>';
  351: 		       }
  352:                     } else {
  353:                         my %newhash=Apache::lonnet::coursedescription
  354:                             ($tcourseid);
  355:                         if (%newhash) {
  356:                             $twhere=$newhash{'description'}.
  357:                               ' <font size="-2">'.
  358:         &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
  359:                               '</font>';
  360:                         } else {
  361:                             $twhere='Currently not available';
  362:                             $ENV{'course.'.$tcourseid.'.description'}=$twhere;
  363:                         }
  364:                     }
  365: 		    if ($role ne 'st') { $twhere.="<br />Domain:".$tdom; }
  366:                 } elsif ($tdom) {
  367:                     $ttype='Domain';
  368:                     $twhere=$tdom;
  369:                 } else {
  370:                     $ttype='System';
  371:                     $twhere='system wide';
  372:                 }
  373:  
  374: # ----- do not trust the indention below here -----              
  375:                 $r->print('<tr bgcolor='.$tbg.'>');
  376:                 unless ($nochoose) {
  377:                     if (!$button) {
  378: 			if ($switchserver) {
  379: 			    $r->print('<td><a href="/adm/logout?handover='.
  380:                               $switchserver.'">Switch Server</a></td>');
  381:                         } else {
  382:                             $r->print('<td>&nbsp;</td>');
  383:                         }
  384:                     } elsif ($tstatus eq 'is') {
  385:                         $r->print('<td><input type=submit value=Select name="'.
  386:                                   $trolecode.'"></td>');
  387:                     } elsif ($ENV{'user.adv'}) {
  388:                         $r->print
  389:                             ('<td><input type=submit value="Re-Initialize"'.
  390:                              ' name="'.$trolecode.'"></td>');
  391:                     } else {
  392:                         $r->print('<td>&nbsp;</td>');
  393:                     }
  394:                 }
  395:             $r->print('<td><font color="'.$tfont.'">'.$trole.
  396:                       '</font></td><td><font color="'.$tfont.'">'.$ttype.
  397:                       '</font></td><td><font color="'.$tfont.'">'.$twhere.
  398:                       '</font></td><td><font color="'.$tfont.'">'.$tpstart.
  399:                       '</font></td><td><font color="'.$tfont.'">'.$tpend.
  400:                       '</font></td><td><font color="'.$tfont.'">'.$tremark.
  401:                       '&nbsp;</font></td></tr>'."\n");
  402: 	}
  403:         }
  404:     }
  405:     my $tremark='';
  406:     my $tfont='#003300';
  407:     if ($ENV{'request.role'} eq 'cm') {
  408: 	$r->print('<tr bgcolor="#11CC55">');
  409:         $tremark='Currently selected.';
  410:         $tfont='#002200';
  411:     } else {
  412:         $r->print('<tr bgcolor="#77FF77">');
  413:     }
  414:     unless ($nochoose) {
  415:        if ($ENV{'request.role'} ne 'cm') {
  416:           $r->print('<td><input type=submit value=Select name="cm"></td>');
  417:        } else {
  418:           $r->print('<td>&nbsp;</td>');
  419:        }
  420:     }
  421:     $r->print('<td colspan=5><font color="'.$tfont.'">No role specified'.
  422:       '</font></td><td><font color="'.$tfont.'">'.$tremark.
  423:       '&nbsp;</font></td></tr>'."\n");
  424: 
  425:     $r->print('</table>');
  426:     unless ($nochoose) {
  427: 	$r->print("</form>\n");
  428:     }
  429: # ------------------------------------------------------------ Privileges Info
  430:   if (($advanced) && (($ENV{'user.error.msg'}) || ($error))) {
  431:     $r->print('<hr><h2>Current Privileges</h2>');
  432: 
  433:     foreach $envkey (sort keys %ENV) {
  434:         if ($envkey=~/^user\.priv\.$ENV{'request.role'}\./) {
  435:             my $where=$envkey;
  436:             $where=~s/^user\.priv\.$ENV{'request.role'}\.//;
  437:             my $ttype;
  438:             my $twhere;
  439:             my ($tdom,$trest,$tsec)=
  440:                split(/\//,Apache::lonnet::declutter($where));
  441:             if ($trest) {
  442: 	      if ($ENV{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
  443: 	        $ttype='Construction Space';
  444:                 $twhere='User: '.$trest.', Domain: '.$tdom;
  445:               } else {
  446: 		$ttype='Course';
  447:                 $twhere=$ENV{'course.'.$tdom.'_'.$trest.'.description'};
  448:                 if ($tsec) {
  449: 		    $twhere.=' (Section/Group: '.$tsec.')';
  450:                 }
  451: 	      }
  452:             } elsif ($tdom) {
  453:                 $ttype='Domain';
  454:                 $twhere=$tdom;
  455:             } else {
  456:                 $ttype='System';
  457:                 $twhere='/';
  458:             }
  459:             $r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
  460:             foreach (sort split(/:/,$ENV{$envkey})) {
  461:               if ($_) {
  462: 		  my ($prv,$restr)=split(/\&/,$_);
  463:                   my $trestr='';
  464:                   if ($restr ne 'F') {
  465:                       my $i;
  466:                       $trestr.=' (';
  467:                       for ($i=0;$i<length($restr);$i++) {
  468: 		         $trestr.=
  469:                            Apache::lonnet::plaintext(substr($restr,$i,1));
  470:                          if ($i<length($restr)-1) { $trestr.=', '; }
  471: 		      }
  472:                       $trestr.=')';
  473:                   }
  474:                   $r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr.
  475:                             '</li>');
  476: 	      }
  477:             }
  478:             $r->print('</ul>');
  479:         }
  480:     }
  481:   }
  482: 
  483:     $r->print("</body></html>\n");
  484:     return OK;
  485: } 
  486: 
  487: 1;
  488: __END__
  489: 
  490: =head1 NAME
  491: 
  492: Apache::lonroles - User Roles Screen
  493: 
  494: =head1 SYNOPSIS
  495: 
  496: Invoked by /etc/httpd/conf/srm.conf:
  497: 
  498:  <Location /adm/roles>
  499:  PerlAccessHandler       Apache::lonacc
  500:  SetHandler perl-script
  501:  PerlHandler Apache::lonroles
  502:  ErrorDocument     403 /adm/login
  503:  ErrorDocument	  500 /adm/errorhandler
  504:  </Location>
  505: 
  506: =head1 INTRODUCTION
  507: 
  508: This module enables a user to select what role he wishes to
  509: operate under (instructor, student, teaching assistant, course
  510: coordinator, etc).  These roles are pre-established by the actions
  511: of upper-level users.
  512: 
  513: This is part of the LearningOnline Network with CAPA project
  514: described at http://www.lon-capa.org.
  515: 
  516: =head1 HANDLER SUBROUTINE
  517: 
  518: This routine is called by Apache and mod_perl.
  519: 
  520: =over 4
  521: 
  522: =item *
  523: 
  524: Roles Initialization (yes/no)
  525: 
  526: =item *
  527: 
  528: Get Error Message from Environment
  529: 
  530: =item *
  531: 
  532: Who is this?
  533: 
  534: =item *
  535: 
  536: Generate Page Output
  537: 
  538: =item *
  539: 
  540: Choice or no choice
  541: 
  542: =item *
  543: 
  544: Table
  545: 
  546: =item *
  547: 
  548: Privileges
  549: 
  550: =back
  551: 
  552: =cut

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