Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Now also replicate metadata files, filename.meta

    1: # The LearningOnline Network
    2: # TCP networking package
    3: #
    4: # Functions for use by content handlers:
    5: #
    6: # plaintext(short)   : plain text explanation of short term
    7: # allowed(short,url) : returns codes for allowed actions
    8: # appendenv(hash)    : adds hash to session environment
    9: # store(hash)        : stores hash permanently for this url
   10: # restore            : returns hash for this url
   11: # eget(namesp,array) : returns hash with keys from array filled in from namesp
   12: # get(namesp,array)  : returns hash with keys from array filled in from namesp
   13: # put(namesp,hash)   : stores hash in namesp
   14: # dump(namesp)       : dumps the complete namespace into a hash
   15: # ssi(url)           : does a complete request cycle on url to localhost
   16: #
   17: # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
   18: # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
   19: # 11/8,11/16,11/18,11/22,11/23,12/22,
   20: # 01/06,01/13,02/24,02/28,02/29,
   21: # 03/01,03/02,03/06,03/07,03/13,
   22: # 04/05,05/29,05/31,06/01,
   23: # 06/05,06/26 Gerd Kortemeyer
   24: # 06/26 Ben Tyszka
   25: # 06/30 Gerd Kortemeyer
   26: 
   27: package Apache::lonnet;
   28: 
   29: use strict;
   30: use Apache::File;
   31: use LWP::UserAgent();
   32: use HTTP::Headers;
   33: use vars 
   34: qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp $readit);
   35: use IO::Socket;
   36: use Apache::Constants qw(:common :http);
   37: 
   38: # --------------------------------------------------------------------- Logging
   39: 
   40: sub logthis {
   41:     my $message=shift;
   42:     my $execdir=$perlvar{'lonDaemons'};
   43:     my $now=time;
   44:     my $local=localtime($now);
   45:     my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
   46:     print $fh "$local ($$): $message\n";
   47:     return 1;
   48: }
   49: 
   50: sub logperm {
   51:     my $message=shift;
   52:     my $execdir=$perlvar{'lonDaemons'};
   53:     my $now=time;
   54:     my $local=localtime($now);
   55:     my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");
   56:     print $fh "$now:$message:$local\n";
   57:     return 1;
   58: }
   59: 
   60: # -------------------------------------------------- Non-critical communication
   61: sub subreply {
   62:     my ($cmd,$server)=@_;
   63:     my $peerfile="$perlvar{'lonSockDir'}/$server";
   64:     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
   65:                                      Type    => SOCK_STREAM,
   66:                                      Timeout => 10)
   67:        or return "con_lost";
   68:     print $client "$cmd\n";
   69:     my $answer=<$client>;
   70:     if (!$answer) { $answer="con_lost"; }
   71:     chomp($answer);
   72:     return $answer;
   73: }
   74: 
   75: sub reply {
   76:     my ($cmd,$server)=@_;
   77:     my $answer=subreply($cmd,$server);
   78:     if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
   79:     if (($answer=~/^error:/) || ($answer=~/^refused/) || 
   80:         ($answer=~/^rejected/)) {
   81:        &logthis("<font color=blue>WARNING:".
   82:                 " $cmd to $server returned $answer</font>");
   83:     }
   84:     return $answer;
   85: }
   86: 
   87: # ----------------------------------------------------------- Send USR1 to lonc
   88: 
   89: sub reconlonc {
   90:     my $peerfile=shift;
   91:     &logthis("Trying to reconnect for $peerfile");
   92:     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
   93:     if (my $fh=Apache::File->new("$loncfile")) {
   94: 	my $loncpid=<$fh>;
   95:         chomp($loncpid);
   96:         if (kill 0 => $loncpid) {
   97: 	    &logthis("lonc at pid $loncpid responding, sending USR1");
   98:             kill USR1 => $loncpid;
   99:             sleep 1;
  100:             if (-e "$peerfile") { return; }
  101:             &logthis("$peerfile still not there, give it another try");
  102:             sleep 5;
  103:             if (-e "$peerfile") { return; }
  104:             &logthis(
  105:   "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
  106:         } else {
  107: 	    &logthis(
  108:                "<font color=blue>WARNING:".
  109:                " lonc at pid $loncpid not responding, giving up</font>");
  110:         }
  111:     } else {
  112:      &logthis('<font color=blue>WARNING: lonc not running, giving up</font>');
  113:     }
  114: }
  115: 
  116: # ------------------------------------------------------ Critical communication
  117: 
  118: sub critical {
  119:     my ($cmd,$server)=@_;
  120:     my $answer=reply($cmd,$server);
  121:     if ($answer eq 'con_lost') {
  122:         my $pingreply=reply('ping',$server);
  123: 	&reconlonc("$perlvar{'lonSockDir'}/$server");
  124:         my $pongreply=reply('pong',$server);
  125:         &logthis("Ping/Pong for $server: $pingreply/$pongreply");
  126:         $answer=reply($cmd,$server);
  127:         if ($answer eq 'con_lost') {
  128:             my $now=time;
  129:             my $middlename=$cmd;
  130:             $middlename=substr($middlename,0,16);
  131:             $middlename=~s/\W//g;
  132:             my $dfilename=
  133:              "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
  134:             {
  135:              my $dfh;
  136:              if ($dfh=Apache::File->new(">$dfilename")) {
  137:                 print $dfh "$cmd\n";
  138: 	     }
  139:             }
  140:             sleep 2;
  141:             my $wcmd='';
  142:             {
  143: 	     my $dfh;
  144:              if ($dfh=Apache::File->new("$dfilename")) {
  145:                 $wcmd=<$dfh>;
  146: 	     }
  147:             }
  148:             chomp($wcmd);
  149:             if ($wcmd eq $cmd) {
  150: 		&logthis("<font color=blue>WARNING: ".
  151:                          "Connection buffer $dfilename: $cmd</font>");
  152:                 &logperm("D:$server:$cmd");
  153: 	        return 'con_delayed';
  154:             } else {
  155:                 &logthis("<font color=red>CRITICAL:"
  156:                         ." Critical connection failed: $server $cmd</font>");
  157:                 &logperm("F:$server:$cmd");
  158:                 return 'con_failed';
  159:             }
  160:         }
  161:     }
  162:     return $answer;
  163: }
  164: 
  165: # ---------------------------------------------------------- Append Environment
  166: 
  167: sub appenv {
  168:     my %newenv=@_;
  169:     my @oldenv;
  170:     {
  171:      my $fh;
  172:      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
  173: 	return 'error';
  174:      }
  175:      @oldenv=<$fh>;
  176:     }
  177:     for (my $i=0; $i<=$#oldenv; $i++) {
  178:         chomp($oldenv[$i]);
  179:         if ($oldenv[$i] ne '') {
  180:            my ($name,$value)=split(/=/,$oldenv[$i]);
  181: 	   $newenv{$name}=$value;
  182:         }
  183:     }
  184:     {
  185:      my $fh;
  186:      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
  187: 	return 'error';
  188:      }
  189:      my $newname;
  190:      foreach $newname (keys %newenv) {
  191: 	 print $fh "$newname=$newenv{$newname}\n";
  192:      }
  193:     }
  194:     return 'ok';
  195: }
  196: 
  197: # ------------------------------ Find server with least workload from spare.tab
  198: 
  199: sub spareserver {
  200:     my $tryserver;
  201:     my $spareserver='';
  202:     my $lowestserver=100;
  203:     foreach $tryserver (keys %spareid) {
  204:        my $answer=reply('load',$tryserver);
  205:        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
  206: 	   $spareserver="http://$hostname{$tryserver}";
  207:            $lowestserver=$answer;
  208:        }
  209:     }    
  210:     return $spareserver;
  211: }
  212: 
  213: # --------- Try to authenticate user from domain's lib servers (first this one)
  214: 
  215: sub authenticate {
  216:     my ($uname,$upass,$udom)=@_;
  217:     $upass=escape($upass);
  218:     if (($perlvar{'lonRole'} eq 'library') && 
  219:         ($udom eq $perlvar{'lonDefDomain'})) {
  220:     my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
  221:         if ($answer =~ /authorized/) {
  222:               if ($answer eq 'authorized') {
  223:                  &logthis("User $uname at $udom authorized by local server"); 
  224:                  return $perlvar{'lonHostID'}; 
  225:               }
  226:               if ($answer eq 'non_authorized') {
  227:                  &logthis("User $uname at $udom rejected by local server"); 
  228:                  return 'no_host'; 
  229:               }
  230: 	}
  231:     }
  232: 
  233:     my $tryserver;
  234:     foreach $tryserver (keys %libserv) {
  235: 	if ($hostdom{$tryserver} eq $udom) {
  236:            my $answer=reply("encrypt:auth:$udom:$uname:$upass",$tryserver);
  237:            if ($answer =~ /authorized/) {
  238:               if ($answer eq 'authorized') {
  239:                  &logthis("User $uname at $udom authorized by $tryserver"); 
  240:                  return $tryserver; 
  241:               }
  242:               if ($answer eq 'non_authorized') {
  243:                  &logthis("User $uname at $udom rejected by $tryserver");
  244:                  return 'no_host';
  245:               } 
  246: 	   }
  247:        }
  248:     }
  249:     &logthis("User $uname at $udom could not be authenticated");    
  250:     return 'no_host';
  251: }
  252: 
  253: # ---------------------- Find the homebase for a user from domain's lib servers
  254: 
  255: sub homeserver {
  256:     my ($uname,$udom)=@_;
  257: 
  258:     my $index="$uname:$udom";
  259:     if ($homecache{$index}) { return "$homecache{$index}"; }
  260: 
  261:     my $tryserver;
  262:     foreach $tryserver (keys %libserv) {
  263: 	if ($hostdom{$tryserver} eq $udom) {
  264:            my $answer=reply("home:$udom:$uname",$tryserver);
  265:            if ($answer eq 'found') { 
  266: 	      $homecache{$index}=$tryserver;
  267:               return $tryserver; 
  268: 	   }
  269:        }
  270:     }    
  271:     return 'no_host';
  272: }
  273: 
  274: # ----------------------------- Subscribe to a resource, return URL if possible
  275: 
  276: sub subscribe {
  277:     my $fname=shift;
  278:     my $author=$fname;
  279:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  280:     my ($udom,$uname)=split(/\//,$author);
  281:     my $home=homeserver($uname,$udom);
  282:     if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
  283:         return 'not_found'; 
  284:     }
  285:     my $answer=reply("sub:$fname",$home);
  286:     return $answer;
  287: }
  288:     
  289: # -------------------------------------------------------------- Replicate file
  290: 
  291: sub repcopy {
  292:     my $filename=shift;
  293:     my $transname="$filename.in.transfer";
  294:     my $remoteurl=subscribe($filename);
  295:     if ($remoteurl eq 'con_lost') {
  296: 	   &logthis("Subscribe returned con_lost: $filename");
  297:            return HTTP_SERVICE_UNAVAILABLE;
  298:     } elsif ($remoteurl eq 'not_found') {
  299: 	   &logthis("Subscribe returned not_found: $filename");
  300: 	   return HTTP_NOT_FOUND;
  301:     } elsif ($remoteurl eq 'forbidden') {
  302: 	   &logthis("Subscribe returned forbidden: $filename");
  303:            return FORBIDDEN;
  304:     } else {
  305:            my @parts=split(/\//,$filename);
  306:            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
  307:            if ($path ne "$perlvar{'lonDocRoot'}/res") {
  308:                &logthis("Malconfiguration for replication: $filename");
  309: 	       return HTTP_BAD_REQUEST;
  310:            }
  311:            my $count;
  312:            for ($count=5;$count<$#parts;$count++) {
  313:                $path.="/$parts[$count]";
  314:                if ((-e $path)!=1) {
  315: 		   mkdir($path,0777);
  316:                }
  317:            }
  318:            my $ua=new LWP::UserAgent;
  319:            my $request=new HTTP::Request('GET',"$remoteurl");
  320:            my $response=$ua->request($request,$transname);
  321:            if ($response->is_error()) {
  322: 	       unlink($transname);
  323:                my $message=$response->status_line;
  324:                &logthis("<font color=blue>WARNING:"
  325:                        ." LWP get: $message: $filename</font>");
  326:                return HTTP_SERVICE_UNAVAILABLE;
  327:            } else {
  328: 	       if ($remoteurl!~/\.meta$/) {
  329:                   my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
  330:                   my $mresponse=$ua->request($mrequest,$filename.'.meta');
  331:                   if ($mresponse->is_error()) {
  332: 		      unlink($filename.'.meta');
  333:                       &logthis(
  334:                      "<font color=yellow>INFO: No metadata: $filename</font>");
  335:                   }
  336: 	       }
  337:                rename($transname,$filename);
  338:                return OK;
  339:            }
  340:     }
  341: }
  342: 
  343: # --------------------------------------------------------- Server Side Include
  344: 
  345: sub ssi {
  346: 
  347:     my $fn=shift;
  348: 
  349:     my $ua=new LWP::UserAgent;
  350:     my $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn);
  351:     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
  352:     my $response=$ua->request($request);
  353: 
  354:     return $response->content;
  355: }
  356: 
  357: 
  358: 
  359: 
  360: # ------------------------------------------------------------------------- Log
  361: 
  362: sub log {
  363:     my ($dom,$nam,$hom,$what)=@_;
  364:     return reply("log:$dom:$nam:$what",$hom);
  365: }
  366: 
  367: # ----------------------------------------------------------------------- Store
  368: 
  369: sub store {
  370:     my %storehash=shift;
  371:     my $namevalue='';
  372:     map {
  373:         $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
  374:     } keys %storehash;
  375:     $namevalue=~s/\&$//;
  376:     return reply("store:$ENV{'user.domain'}:$ENV{'user.name'}:"
  377:                ."$ENV{'user.class'}:$ENV{'request.filename'}:$namevalue",
  378: 		 "$ENV{'user.home'}");
  379: }
  380: 
  381: # --------------------------------------------------------------------- Restore
  382: 
  383: sub restore {
  384:     my $answer=reply("restore:$ENV{'user.domain'}:$ENV{'user.name'}:"
  385:                ."$ENV{'user.class'}:$ENV{'request.filename'}",
  386:                 "$ENV{'user.home'}");
  387:     my %returnhash=();
  388:     map {
  389: 	my ($name,$value)=split(/\=/,$_);
  390:         $returnhash{&unescape($name)}=&unescape($value);
  391:     } split(/\&/,$answer);
  392:     return %returnhash;
  393: }
  394: 
  395: # -------------------------------------------------------- Get user priviledges
  396: 
  397: sub rolesinit {
  398:     my ($domain,$username,$authhost)=@_;
  399:     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
  400:     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
  401:     my %allroles=();
  402:     my %thesepriv=();
  403:     my $userroles='';
  404:     my $now=time;
  405:     my $thesestr;
  406: 
  407:     if ($rolesdump ne '') {
  408:         map {
  409: 	  if ($_!~/rolesdef\&/) {
  410:             my ($area,$role)=split(/=/,$_);
  411:             my ($trole,$tend,$tstart)=split(/_/,$role);
  412:             if ($tend!=0) {
  413: 	        if ($tend<$now) {
  414: 	            $trole='';
  415:                 } 
  416:             }
  417:             if ($tstart!=0) {
  418:                 if ($tstart>$now) {
  419:                    $trole='';        
  420:                 }
  421:             }
  422:             if (($area ne '') && ($trole ne '')) {
  423:                $userroles.='user.role.'.$trole.'.'.$area.'='.
  424:                            $tstart.'.'.$tend."\n";
  425:                my ($tdummy,$tdomain,$trest)=split(/\//,$area);
  426:                if ($trole =~ /^cr\//) {
  427: 		   my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
  428:                    my $homsvr=homeserver($rauthor,$rdomain);
  429:                    if ($hostname{$homsvr} ne '') {
  430:                       my $roledef=
  431: 			  reply("get:$rdomain:$rauthor:roles:rolesdef&$rrole",
  432:                                 $homsvr);
  433:                       if (($roledef ne 'con_lost') && ($roledef ne '')) {
  434:                          my ($syspriv,$dompriv,$coursepriv)=
  435: 			     split(/&&/,$roledef);
  436:  	                 $allroles{'/'}.=':'.$syspriv;
  437:                          if ($tdomain ne '') {
  438:                              $allroles{'/'.$tdomain.'/'}.=':'.$dompriv;
  439:                              if ($trest ne '') {
  440: 		                $allroles{$area}.=':'.$coursepriv;
  441:                              }
  442: 	                 }
  443:                       }
  444:                    }
  445:                } else {
  446: 	           $allroles{'/'}.=':'.$pr{$trole.':s'};
  447:                    if ($tdomain ne '') {
  448:                       $allroles{'/'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
  449:                       if ($trest ne '') {
  450: 		          $allroles{$area}.=':'.$pr{$trole.':c'};
  451:                       }
  452: 	           }
  453: 	       }
  454:             }
  455:           } 
  456:         } split(/&/,$rolesdump);
  457:         map {
  458:             %thesepriv=();
  459:             map {
  460:                 if ($_ ne '') {
  461: 		    my ($priviledge,$restrictions)=split(/&/,$_);
  462:                     if ($restrictions eq '') {
  463: 			$thesepriv{$priviledge}='F';
  464:                     } else {
  465:                         if ($thesepriv{$priviledge} ne 'F') {
  466: 			    $thesepriv{$priviledge}.=$restrictions;
  467:                         }
  468:                     }
  469:                 }
  470:             } split(/:/,$allroles{$_});
  471:             $thesestr='';
  472:             map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
  473:             $userroles.='user.priv.'.$_.'='.$thesestr."\n";
  474:         } keys %allroles;            
  475:     }
  476:     return $userroles;  
  477: }
  478: 
  479: # --------------------------------------------------------------- get interface
  480: 
  481: sub get {
  482:    my ($namespace,@storearr)=@_;
  483:    my $items='';
  484:    map {
  485:        $items.=escape($_).'&';
  486:    } @storearr;
  487:    $items=~s/\&$//;
  488:  my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
  489:                  $ENV{'user.home'});
  490:    my @pairs=split(/\&/,$rep);
  491:    my %returnhash=();
  492:    map {
  493:       my ($key,$value)=split(/=/,$_);
  494:       $returnhash{unespace($key)}=unescape($value);
  495:    } @pairs;
  496:    return %returnhash;
  497: }
  498: 
  499: # -------------------------------------------------------------- dump interface
  500: 
  501: sub dump {
  502:    my $namespace=shift;
  503:    my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",
  504:                 $ENV{'user.home'});
  505:    my @pairs=split(/\&/,$rep);
  506:    my %returnhash=();
  507:    map {
  508:       my ($key,$value)=split(/=/,$_);
  509:       $returnhash{unespace($key)}=unescape($value);
  510:    } @pairs;
  511:    return %returnhash;
  512: }
  513: 
  514: # --------------------------------------------------------------- put interface
  515: 
  516: sub put {
  517:    my ($namespace,%storehash)=@_;
  518:    my $items='';
  519:    map {
  520:        $items.=escape($_).'='.escape($storehash{$_}).'&';
  521:    } keys %storehash;
  522:    $items=~s/\&$//;
  523:    return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
  524:                  $ENV{'user.home'});
  525: }
  526: 
  527: # -------------------------------------------------------------- eget interface
  528: 
  529: sub eget {
  530:    my ($namespace,@storearr)=@_;
  531:    my $items='';
  532:    map {
  533:        $items.=escape($_).'&';
  534:    } @storearr;
  535:    $items=~s/\&$//;
  536:  my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
  537:                  $ENV{'user.home'});
  538:    my @pairs=split(/\&/,$rep);
  539:    my %returnhash=();
  540:    map {
  541:       my ($key,$value)=split(/=/,$_);
  542:       $returnhash{unespace($key)}=unescape($value);
  543:    } @pairs;
  544:    return %returnhash;
  545: }
  546: 
  547: # ------------------------------------------------- Check for a user priviledge
  548: 
  549: sub allowed {
  550:     my ($priv,$uri)=@_;
  551:     $uri=~s/^\/res//;
  552:     $uri=~s/^\///;
  553:     if ($uri=~/^adm\//) {
  554: 	return 'F';
  555:     }
  556:     my $thisallowed='';
  557:     if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) {
  558:        $thisallowed.=$1;
  559:     }
  560:     if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {
  561:        $thisallowed.=$1;
  562:     }
  563:     if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) {
  564:        $thisallowed.=$1;
  565:     }
  566:     return $thisallowed;
  567: }
  568: 
  569: # ----------------------------------------------------------------- Define Role
  570: 
  571: sub definerole {
  572:   if (allowed('mcr','/')) {
  573:     my ($rolename,$sysrole,$domrole,$courole)=@_;
  574:     my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
  575:                 "$ENV{'user.domain'}:$ENV{'user.name'}:".
  576: 	        "rolesdef&$rolename=$sysrole&&$domrole&&$courole";
  577:     return reply($command,$ENV{'user.home'});
  578:   } else {
  579:     return 'refused';
  580:   }
  581: }
  582: 
  583: # ------------------------------------------------------------------ Plain Text
  584: 
  585: sub plaintext {
  586:     return $prp{$_};
  587: }
  588: 
  589: # ----------------------------------------------------------------- Assign Role
  590: 
  591: sub assignrole {
  592: }
  593: 
  594: # -------------------------------------------------------- Escape Special Chars
  595: 
  596: sub escape {
  597:     my $str=shift;
  598:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  599:     return $str;
  600: }
  601: 
  602: # ----------------------------------------------------- Un-Escape Special Chars
  603: 
  604: sub unescape {
  605:     my $str=shift;
  606:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  607:     return $str;
  608: }
  609: 
  610: # ================================================================ Main Program
  611: 
  612: sub BEGIN {
  613: if ($readit ne 'done') {
  614: # ------------------------------------------------------------ Read access.conf
  615: {
  616:     my $config=Apache::File->new("/etc/httpd/conf/access.conf");
  617: 
  618:     while (my $configline=<$config>) {
  619:         if ($configline =~ /PerlSetVar/) {
  620: 	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
  621:            chomp($varvalue);
  622:            $perlvar{$varname}=$varvalue;
  623:         }
  624:     }
  625: }
  626: 
  627: # ------------------------------------------------------------- Read hosts file
  628: {
  629:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
  630: 
  631:     while (my $configline=<$config>) {
  632:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  633:        $hostname{$id}=$name;
  634:        $hostdom{$id}=$domain;
  635:        if ($role eq 'library') { $libserv{$id}=$name; }
  636:     }
  637: }
  638: 
  639: # ------------------------------------------------------ Read spare server file
  640: {
  641:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
  642: 
  643:     while (my $configline=<$config>) {
  644:        chomp($configline);
  645:        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
  646:           $spareid{$configline}=1;
  647:        }
  648:     }
  649: }
  650: # ------------------------------------------------------------ Read permissions
  651: {
  652:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");
  653: 
  654:     while (my $configline=<$config>) {
  655:        chomp($configline);
  656:        my ($role,$perm)=split(/ /,$configline);
  657:        if ($perm ne '') { $pr{$role}=$perm; }
  658:     }
  659: }
  660: 
  661: # -------------------------------------------- Read plain texts for permissions
  662: {
  663:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab");
  664: 
  665:     while (my $configline=<$config>) {
  666:        chomp($configline);
  667:        my ($short,$plain)=split(/:/,$configline);
  668:        if ($plain ne '') { $prp{$short}=$plain; }
  669:     }
  670: }
  671: 
  672: $readit='done';
  673: &logthis('<font color=yellow>INFO: Read configuration</font>');
  674: }
  675: }
  676: 1;
  677: 
  678: 
  679: 
  680: