# The LearningOnline Network
# TCP networking package
#
# Functions for use by content handlers:
#
# plaintext(short)   : plain text explanation of short term
# fileembstyle(ext)  : embed style in page for file extension
# filedescription(ext) : descriptor text for file extension
# allowed(short,url) : returns codes for allowed actions 
#                      F: full access
#                      U,I,K: authentication modes (cxx only)
#                      '': forbidden
#                      1: user needs to choose course
#                      2: browse allowed
# definerole(rolename,sys,dom,cou) : define a custom role rolename
#                      set priviledges in format of lonTabs/roles.tab for
#                      system, domain and course level, 
# assignrole(udom,uname,url,role,end,start) : give a role to a user for the
#                      level given by url. Optional start and end dates
#                      (leave empty string or zero for "no date") 
# assigncustomrole (udom,uname,url,rdom,rnam,rolename,end,start) : give a
#                      custom role to a user for the level given by url.
#                      Specify name and domain of role author, and role name
# revokerole (udom,uname,url,role) : Revoke a role for url
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
# appenv(hash)       : adds hash to session environment
# delenv(varname)    : deletes all environment entries starting with varname
# store(hash)        : stores hash permanently for this url
# cstore(hash)       : critical store
# restore            : returns hash for this url
# eget(namesp,array) : returns hash with keys from array filled in from namesp
# get(namesp,array)  : returns hash with keys from array filled in from namesp
# del(namesp,array)  : deletes keys out of array from namesp
# put(namesp,hash)   : stores hash in namesp
# cput(namesp,hash)  : critical put
# dump(namesp)       : dumps the complete namespace into a hash
# ssi(url,hash)      : does a complete request cycle on url to localhost, posts
#                      hash
# coursedescription(id) : returns and caches course description for id
# repcopy(filename)  : replicate file
# dirlist(url)       : gets a directory listing
# directcondval(index) : reading condition value of single condition from 
#                        state string
# condval(index)     : value of condition index based on state
# varval(name)       : value of a variable
# refreshstate()     : refresh the state information string
# symblist(map,hash) : Updates symbolic storage links
# symbread([filename]) : returns the data handle (filename optional)
# rndseed()          : returns a random seed  
# getfile(filename)  : returns the contents of filename, or a -1 if it can't
#                      be found, replicates and subscribes to the file
# filelocation(dir,file) : returns a farily clean absolute reference to file 
#                          from the directory dir
# hreflocation(dir,file) : same as filelocation, but for hrefs
# log(domain,user,home,msg) : write to permanent log for user
#
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
# 11/8,11/16,11/18,11/22,11/23,12/22,
# 01/06,01/13,02/24,02/28,02/29,
# 03/01,03/02,03/06,03/07,03/13,
# 04/05,05/29,05/31,06/01,
# 06/05,06/26 Gerd Kortemeyer
# 06/26 Ben Tyszka
# 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer
# 08/14 Ben Tyszka
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
# 10/04 Gerd Kortemeyer
# 10/04 Guy Albertelli
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
# 10/30,10/31 Gerd Kortemeyer

package Apache::lonnet;

use strict;
use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars 
qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);

# --------------------------------------------------------------------- Logging

sub logthis {
    my $message=shift;
    my $execdir=$perlvar{'lonDaemons'};
    my $now=time;
    my $local=localtime($now);
    my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
    print $fh "$local ($$): $message\n";
    return 1;
}

sub logperm {
    my $message=shift;
    my $execdir=$perlvar{'lonDaemons'};
    my $now=time;
    my $local=localtime($now);
    my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");
    print $fh "$now:$message:$local\n";
    return 1;
}

# -------------------------------------------------- Non-critical communication
sub subreply {
    my ($cmd,$server)=@_;
    my $peerfile="$perlvar{'lonSockDir'}/$server";
    my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                     Type    => SOCK_STREAM,
                                     Timeout => 10)
       or return "con_lost";
    print $client "$cmd\n";
    my $answer=<$client>;
    if (!$answer) { $answer="con_lost"; }
    chomp($answer);
    return $answer;
}

sub reply {
    my ($cmd,$server)=@_;
    my $answer=subreply($cmd,$server);
    if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
    if (($answer=~/^error:/) || ($answer=~/^refused/) || 
        ($answer=~/^rejected/)) {
       &logthis("<font color=blue>WARNING:".
                " $cmd to $server returned $answer</font>");
    }
    return $answer;
}

# ----------------------------------------------------------- Send USR1 to lonc

sub reconlonc {
    my $peerfile=shift;
    &logthis("Trying to reconnect for $peerfile");
    my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
    if (my $fh=Apache::File->new("$loncfile")) {
	my $loncpid=<$fh>;
        chomp($loncpid);
        if (kill 0 => $loncpid) {
	    &logthis("lonc at pid $loncpid responding, sending USR1");
            kill USR1 => $loncpid;
            sleep 1;
            if (-e "$peerfile") { return; }
            &logthis("$peerfile still not there, give it another try");
            sleep 5;
            if (-e "$peerfile") { return; }
            &logthis(
  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
        } else {
	    &logthis(
               "<font color=blue>WARNING:".
               " lonc at pid $loncpid not responding, giving up</font>");
        }
    } else {
     &logthis('<font color=blue>WARNING: lonc not running, giving up</font>');
    }
}

# ------------------------------------------------------ Critical communication

sub critical {
    my ($cmd,$server)=@_;
    my $answer=reply($cmd,$server);
    if ($answer eq 'con_lost') {
        my $pingreply=reply('ping',$server);
	&reconlonc("$perlvar{'lonSockDir'}/$server");
        my $pongreply=reply('pong',$server);
        &logthis("Ping/Pong for $server: $pingreply/$pongreply");
        $answer=reply($cmd,$server);
        if ($answer eq 'con_lost') {
            my $now=time;
            my $middlename=$cmd;
            $middlename=substr($middlename,0,16);
            $middlename=~s/\W//g;
            my $dfilename=
             "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
            {
             my $dfh;
             if ($dfh=Apache::File->new(">$dfilename")) {
                print $dfh "$cmd\n";
	     }
            }
            sleep 2;
            my $wcmd='';
            {
	     my $dfh;
             if ($dfh=Apache::File->new("$dfilename")) {
                $wcmd=<$dfh>;
	     }
            }
            chomp($wcmd);
            if ($wcmd eq $cmd) {
		&logthis("<font color=blue>WARNING: ".
                         "Connection buffer $dfilename: $cmd</font>");
                &logperm("D:$server:$cmd");
	        return 'con_delayed';
            } else {
                &logthis("<font color=red>CRITICAL:"
                        ." Critical connection failed: $server $cmd</font>");
                &logperm("F:$server:$cmd");
                return 'con_failed';
            }
        }
    }
    return $answer;
}

# ---------------------------------------------------------- Append Environment

sub appenv {
    my %newenv=@_;
    map {
	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
            &logthis("<font color=blue>WARNING: ".
                "Attempt to modify environment ".$_." to ".$newenv{$_});
	    delete($newenv{$_});
        } else {
            $ENV{$_}=$newenv{$_};
        }
    } keys %newenv;
    my @oldenv;
    {
     my $fh;
     unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
	return 'error';
     }
     @oldenv=<$fh>;
    }
    for (my $i=0; $i<=$#oldenv; $i++) {
        chomp($oldenv[$i]);
        if ($oldenv[$i] ne '') {
           my ($name,$value)=split(/=/,$oldenv[$i]);
           unless (defined($newenv{$name})) {
	      $newenv{$name}=$value;
	   }
        }
    }
    {
     my $fh;
     unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
	return 'error';
     }
     my $newname;
     foreach $newname (keys %newenv) {
	 print $fh "$newname=$newenv{$newname}\n";
     }
    }
    return 'ok';
}
# ----------------------------------------------------- Delete from Environment

sub delenv {
    my $delthis=shift;
    my %newenv=();
    if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
        &logthis("<font color=blue>WARNING: ".
                "Attempt to delete from environment ".$delthis);
        return 'error';
    }
    my @oldenv;
    {
     my $fh;
     unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
	return 'error';
     }
     @oldenv=<$fh>;
    }
    {
     my $fh;
     unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
	return 'error';
     }
     map {
	 unless ($_=~/^$delthis/) { print $fh $_; }
     } @oldenv;
    }
    return 'ok';
}

# ------------------------------ Find server with least workload from spare.tab

sub spareserver {
    my $tryserver;
    my $spareserver='';
    my $lowestserver=100;
    foreach $tryserver (keys %spareid) {
       my $answer=reply('load',$tryserver);
       if (($answer =~ /\d/) && ($answer<$lowestserver)) {
	   $spareserver="http://$hostname{$tryserver}";
           $lowestserver=$answer;
       }
    }    
    return $spareserver;
}

# --------- Try to authenticate user from domain's lib servers (first this one)

sub authenticate {
    my ($uname,$upass,$udom)=@_;
    $upass=escape($upass);
    if (($perlvar{'lonRole'} eq 'library') && 
        ($udom eq $perlvar{'lonDefDomain'})) {
    my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
        if ($answer =~ /authorized/) {
              if ($answer eq 'authorized') {
                 &logthis("User $uname at $udom authorized by local server"); 
                 return $perlvar{'lonHostID'}; 
              }
              if ($answer eq 'non_authorized') {
                 &logthis("User $uname at $udom rejected by local server"); 
                 return 'no_host'; 
              }
	}
    }

    my $tryserver;
    foreach $tryserver (keys %libserv) {
	if ($hostdom{$tryserver} eq $udom) {
           my $answer=reply("encrypt:auth:$udom:$uname:$upass",$tryserver);
           if ($answer =~ /authorized/) {
              if ($answer eq 'authorized') {
                 &logthis("User $uname at $udom authorized by $tryserver"); 
                 return $tryserver; 
              }
              if ($answer eq 'non_authorized') {
                 &logthis("User $uname at $udom rejected by $tryserver");
                 return 'no_host';
              } 
	   }
       }
    }
    &logthis("User $uname at $udom could not be authenticated");    
    return 'no_host';
}

# ---------------------- Find the homebase for a user from domain's lib servers

sub homeserver {
    my ($uname,$udom)=@_;

    my $index="$uname:$udom";
    if ($homecache{$index}) { return "$homecache{$index}"; }

    my $tryserver;
    foreach $tryserver (keys %libserv) {
	if ($hostdom{$tryserver} eq $udom) {
           my $answer=reply("home:$udom:$uname",$tryserver);
           if ($answer eq 'found') { 
	      $homecache{$index}=$tryserver;
              return $tryserver; 
	   }
       }
    }    
    return 'no_host';
}

# ----------------------------- Subscribe to a resource, return URL if possible

sub subscribe {
    my $fname=shift;
    my $author=$fname;
    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
    my ($udom,$uname)=split(/\//,$author);
    my $home=homeserver($uname,$udom);
    if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
        return 'not_found'; 
    }
    my $answer=reply("sub:$fname",$home);
    return $answer;
}
    
# -------------------------------------------------------------- Replicate file

sub repcopy {
    my $filename=shift;
    $filename=~s/\/+/\//g;
    my $transname="$filename.in.transfer";
    if ((-e $filename) || (-e $transname)) { return OK; }
    my $remoteurl=subscribe($filename);
    if ($remoteurl eq 'con_lost') {
	   &logthis("Subscribe returned con_lost: $filename");
           return HTTP_SERVICE_UNAVAILABLE;
    } elsif ($remoteurl eq 'not_found') {
	   &logthis("Subscribe returned not_found: $filename");
	   return HTTP_NOT_FOUND;
    } elsif ($remoteurl eq 'rejected') {
	   &logthis("Subscribe returned rejected: $filename");
           return FORBIDDEN;
    } elsif ($remoteurl eq 'directory') {
           return OK;
    } else {
           my @parts=split(/\//,$filename);
           my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
           if ($path ne "$perlvar{'lonDocRoot'}/res") {
               &logthis("Malconfiguration for replication: $filename");
	       return HTTP_BAD_REQUEST;
           }
           my $count;
           for ($count=5;$count<$#parts;$count++) {
               $path.="/$parts[$count]";
               if ((-e $path)!=1) {
		   mkdir($path,0777);
               }
           }
           my $ua=new LWP::UserAgent;
           my $request=new HTTP::Request('GET',"$remoteurl");
           my $response=$ua->request($request,$transname);
           if ($response->is_error()) {
	       unlink($transname);
               my $message=$response->status_line;
               &logthis("<font color=blue>WARNING:"
                       ." LWP get: $message: $filename</font>");
               return HTTP_SERVICE_UNAVAILABLE;
           } else {
	       if ($remoteurl!~/\.meta$/) {
                  my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
                  my $mresponse=$ua->request($mrequest,$filename.'.meta');
                  if ($mresponse->is_error()) {
		      unlink($filename.'.meta');
                      &logthis(
                     "<font color=yellow>INFO: No metadata: $filename</font>");
                  }
	       }
               rename($transname,$filename);
               return OK;
           }
    }
}

# --------------------------------------------------------- Server Side Include

sub ssi {

    my ($fn,%form)=@_;

    my $ua=new LWP::UserAgent;
    
    my $request;
    
    if (%form) {
      $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
      $request->content(join '&', map { "$_=$form{$_}" } keys %form);
    } else {
      $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn);
    }

    $request->header(Cookie => $ENV{'HTTP_COOKIE'});
    my $response=$ua->request($request);

    return $response->content;
}

# ------------------------------------------------------------------------- Log

sub log {
    my ($dom,$nam,$hom,$what)=@_;
    return critical("log:$dom:$nam:$what",$hom);
}

# ----------------------------------------------------------------------- Store

sub store {
    my %storehash=@_;
    my $symb;
    unless ($symb=escape(&symbread())) { return ''; }
    my $namespace;
    unless ($namespace=$ENV{'request.course.id'}) { return ''; }
    my $namevalue='';
    map {
        $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
    } keys %storehash;
    $namevalue=~s/\&$//;
    return reply(
     "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
		 "$ENV{'user.home'}");
}

# -------------------------------------------------------------- Critical Store

sub cstore {
    my %storehash=@_;
    my $symb;
    unless ($symb=escape(&symbread())) { return ''; }
    my $namespace;
    unless ($namespace=$ENV{'request.course.id'}) { return ''; }
    my $namevalue='';
    map {
        $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
    } keys %storehash;
    $namevalue=~s/\&$//;
    return critical(
     "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
		 "$ENV{'user.home'}");
}

# --------------------------------------------------------------------- Restore

sub restore {
    my $symb;
    unless ($symb=escape(&symbread())) { return ''; }
    my $namespace;
    unless ($namespace=$ENV{'request.course.id'}) { return ''; }
    my $answer=reply(
              "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb",
              "$ENV{'user.home'}");
    my %returnhash=();
    map {
	my ($name,$value)=split(/\=/,$_);
        $returnhash{&unescape($name)}=&unescape($value);
    } split(/\&/,$answer);
    map {
        $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_};
    } split(/\:/,$returnhash{$returnhash{'version'}.':keys'});
    return %returnhash;
}

# ---------------------------------------------------------- Course Description

sub coursedescription {
    my $courseid=shift;
    $courseid=~s/^\///;
    $courseid=~s/\_/\//g;
    my ($cdomain,$cnum)=split(/\//,$courseid);
    my $chome=homeserver($cnum,$cdomain);
    if ($chome ne 'no_host') {
       my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
       if ($rep ne 'con_lost') {
           my $normalid=$courseid;
           $normalid=~s/\//\_/g;
           my %envhash=();
           my %returnhash=('home'   => $chome, 
                           'domain' => $cdomain,
                           'num'    => $cnum);
           map {
               my ($name,$value)=split(/\=/,$_);
               $name=&unescape($name);
               $value=&unescape($value);
               $returnhash{$name}=$value;
               $envhash{'course.'.$normalid.'.'.$name}=$value;
           } split(/\&/,$rep);
           $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
           $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
	       $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
           $envhash{'course.'.$normalid.'.last_cache'}=time;
           &appenv(%envhash);
           return %returnhash;
       }
    }
    return ();
}

# -------------------------------------------------------- Get user priviledges

sub rolesinit {
    my ($domain,$username,$authhost)=@_;
    my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
    my %allroles=();
    my %thesepriv=();
    my $now=time;
    my $userroles="user.login.time=$now\n";
    my $thesestr;

    if ($rolesdump ne '') {
        map {
	  if ($_!~/^rolesdef\&/) {
            my ($area,$role)=split(/=/,$_);
            $area=~s/\_\w\w$//;
            my ($trole,$tend,$tstart)=split(/_/,$role);
            $userroles.='user.role.'.$trole.'.'.$area.'='.
                        $tstart.'.'.$tend."\n";
            if ($tend!=0) {
	        if ($tend<$now) {
	            $trole='';
                } 
            }
            if ($tstart!=0) {
                if ($tstart>$now) {
                   $trole='';        
                }
            }
            if (($area ne '') && ($trole ne '')) {
	       my $spec=$trole.'.'.$area;
               my ($tdummy,$tdomain,$trest)=split(/\//,$area);
               if ($trole =~ /^cr\//) {
		   my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
                   my $homsvr=homeserver($rauthor,$rdomain);
                   if ($hostname{$homsvr} ne '') {
                      my $roledef=
			  reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole",
                                $homsvr);
                      if (($roledef ne 'con_lost') && ($roledef ne '')) {
                         my ($syspriv,$dompriv,$coursepriv)=
			     split(/\_/,unescape($roledef));
 	                 $allroles{'cm./'}.=':'.$syspriv;
                         $allroles{$spec.'./'}.=':'.$syspriv;
                         if ($tdomain ne '') {
                             $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
                             $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
                             if ($trest ne '') {
		                $allroles{'cm.'.$area}.=':'.$coursepriv;
		                $allroles{$spec.'.'.$area}.=':'.$coursepriv;
                             }
	                 }
                      }
                   }
               } else {
	           $allroles{'cm./'}.=':'.$pr{$trole.':s'};
	           $allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
                   if ($tdomain ne '') {
                     $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
                     $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
                      if ($trest ne '') {
		          $allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
		          $allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
                      }
	           }
	       }
            }
          } 
        } split(/&/,$rolesdump);
        map {
            %thesepriv=();
            map {
                if ($_ ne '') {
		    my ($priviledge,$restrictions)=split(/&/,$_);
                    if ($restrictions eq '') {
			$thesepriv{$priviledge}='F';
                    } else {
                        if ($thesepriv{$priviledge} ne 'F') {
			    $thesepriv{$priviledge}.=$restrictions;
                        }
                    }
                }
            } split(/:/,$allroles{$_});
            $thesestr='';
            map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
            $userroles.='user.priv.'.$_.'='.$thesestr."\n";
        } keys %allroles;            
    }
    return $userroles;  
}

# --------------------------------------------------------------- get interface

sub get {
   my ($namespace,@storearr)=@_;
   my $items='';
   map {
       $items.=escape($_).'&';
   } @storearr;
   $items=~s/\&$//;
 my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                 $ENV{'user.home'});
   my @pairs=split(/\&/,$rep);
   my %returnhash=();
   my $i=0;
   map {
      $returnhash{$_}=unescape($pairs[$i]);
      $i++;
   } @storearr;
   return %returnhash;
}

# --------------------------------------------------------------- del interface

sub del {
   my ($namespace,@storearr)=@_;
   my $items='';
   map {
       $items.=escape($_).'&';
   } @storearr;
   $items=~s/\&$//;
   return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                 $ENV{'user.home'});
}

# -------------------------------------------------------------- dump interface

sub dump {
   my $namespace=shift;
   my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",
                $ENV{'user.home'});
   my @pairs=split(/\&/,$rep);
   my %returnhash=();
   map {
      my ($key,$value)=split(/=/,$_);
      $returnhash{unescape($key)}=unescape($value);
   } @pairs;
   return %returnhash;
}

# --------------------------------------------------------------- put interface

sub put {
   my ($namespace,%storehash)=@_;
   my $items='';
   map {
       $items.=escape($_).'='.escape($storehash{$_}).'&';
   } keys %storehash;
   $items=~s/\&$//;
   return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                 $ENV{'user.home'});
}

# ------------------------------------------------------ critical put interface

sub cput {
   my ($namespace,%storehash)=@_;
   my $items='';
   map {
       $items.=escape($_).'='.escape($storehash{$_}).'&';
   } keys %storehash;
   $items=~s/\&$//;
   return critical
           ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                 $ENV{'user.home'});
}

# -------------------------------------------------------------- eget interface

sub eget {
   my ($namespace,@storearr)=@_;
   my $items='';
   map {
       $items.=escape($_).'&';
   } @storearr;
   $items=~s/\&$//;
 my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                 $ENV{'user.home'});
   my @pairs=split(/\&/,$rep);
   my %returnhash=();
   my $i=0;
   map {
      $returnhash{$_}=unescape($pairs[$i]);
      $i++;
   } @storearr;
   return %returnhash;
}

# ------------------------------------------------- Check for a user priviledge

sub allowed {
    my ($priv,$uri)=@_;
    $uri=&declutter($uri);

# Free bre access to adm and meta resources

    if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {
	return 'F';
    }

    my $thisallowed='';
    my $statecond=0;
    my $courseprivid='';

# Course

    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
       $thisallowed.=$1;
    }

# Domain

    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
       =~/$priv\&([^\:]*)/) {
       $thisallowed.=$1;
    }

# Course: uri itself is a course

    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
       =~/$priv\&([^\:]*)/) {
       $thisallowed.=$1;
    }

# Full access at system, domain or course-wide level? Exit.

    if ($thisallowed=~/F/) {
	return 'F';
    }

# If this is generating or modifying users, exit with special codes

    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) {
	return $thisallowed;
    }
#
# Gathered so far: system, domain and course wide priviledges
#
# Course: See if uri or referer is an individual resource that is part of 
# the course

    if ($ENV{'request.course.id'}) {
       $courseprivid=$ENV{'request.course.id'};
       if ($ENV{'request.course.sec'}) {
          $courseprivid.='/'.$ENV{'request.course.sec'};
       }
       $courseprivid=~s/\_/\//;
       my $checkreferer=1;
       my @uriparts=split(/\//,$uri);
       my $filename=$uriparts[$#uriparts];
       my $pathname=$uri;
       $pathname=~s/\/$filename$//;
       if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
           /\&$filename\:([\d\|]+)\&/) {
           $statecond=$1;
           if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
               =~/$priv\&([^\:]*)/) {
               $thisallowed.=$1;
               $checkreferer=0;
           }
       }

       if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
	  my $refuri=$ENV{'HTTP_REFERER'};
          $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
          $refuri=&declutter($refuri);
          my @uriparts=split(/\//,$refuri);
          my $filename=$uriparts[$#uriparts];
          my $pathname=$refuri;
          $pathname=~s/\/$filename$//;
          my @filenameparts=split(/\./,$uri);
          if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {
            if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
              /\&$filename\:([\d\|]+)\&/) {
              my $refstatecond=$1;
              if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                  =~/$priv\&([^\:]*)/) {
                  $thisallowed.=$1;
                  $uri=$refuri;
                  $statecond=$refstatecond;
              }
            }
          }
       }
   }

#
# Gathered now: all priviledges that could apply, and condition number
# 
#
# Full or no access?
#

    if ($thisallowed=~/F/) {
	return 'F';
    }

    unless ($thisallowed) {
        return '';
    }

# Restrictions exist, deal with them
#
#   C:according to course preferences
#   R:according to resource settings
#   L:unless locked
#   X:according to user session state
#

# Possibly locked functionality, check all courses
# Locks might take effect only after 10 minutes cache expiration for other
# courses, and 2 minutes for current course

    my $envkey;
    if ($thisallowed=~/L/) {
        foreach $envkey (keys %ENV) {
           if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
               my $courseid=$2;
               my $roleid=$1.'.'.$2;
               my $expiretime=600;
               if ($ENV{'request.role'} eq $roleid) {
		  $expiretime=120;
               }
	       my ($cdom,$cnum,$csec)=split(/\//,$courseid);
               my $prefix='course.'.$cdom.'_'.$cnum.'.';
               if ((time-$ENV{$prefix.'last_cache'})>$expiretime) {
		   &coursedescription($courseid);
               }
               if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
                || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
		   if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
                       &log($ENV{'user.domain'},$ENV{'user.name'},
                            $ENV{'user.host'},
                            'Locked by res: '.$priv.' for '.$uri.' due to '.
                            $cdom.'/'.$cnum.'/'.$csec.' expire '.
                            $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
		       return '';
                   }
               }
               if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
                || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
		   if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
                       &log($ENV{'user.domain'},$ENV{'user.name'},
                            $ENV{'user.host'},
                            'Locked by priv: '.$priv.' for '.$uri.' due to '.
                            $cdom.'/'.$cnum.'/'.$csec.' expire '.
                            $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
		       return '';
                   }
               }
	   }
       }
    }
   
#
# Rest of the restrictions depend on selected course
#

    unless ($ENV{'request.course.id'}) {
       return '1';
    }

#
# Now user is definitely in a course
#


# Course preferences

   if ($thisallowed=~/C/) {
       my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
       if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
	   =~/\,$rolecode\,/) {
           &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
                $ENV{'request.course.id'});
           return '';
       }
   }

# Resource preferences

   if ($thisallowed=~/R/) {
       my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
       my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
       if (-e $filename) {
           my @content;
           {
	     my $fh=Apache::File->new($filename);
             @content=<$fh>;
	   }
           if (join('',@content)=~
                    /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {
	       &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                    'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
           return '';

           }
       }
   }

# Restricted by state?

   if ($thisallowed=~/X/) {
      if (&condval($statecond)) {
	 return '2';
      } else {
         return '';
      }
   }

   return 'F';
}

# ---------------------------------------------------------- Refresh State Info

sub refreshstate {
}

# ----------------------------------------------------------------- Define Role

sub definerole {
  if (allowed('mcr','/')) {
    my ($rolename,$sysrole,$domrole,$courole)=@_;
    map {
	my ($crole,$cqual)=split(/\&/,$_);
        if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }
        if ($pr{'cr:s'}=~/$crole\&/) {
	    if ($pr{'cr:s'}!~/$crole\&\w*$cqual/) { 
               return "refused:s:$crole&$cqual"; 
            }
        }
    } split('/',$sysrole);
    map {
	my ($crole,$cqual)=split(/\&/,$_);
        if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }
        if ($pr{'cr:d'}=~/$crole\&/) {
	    if ($pr{'cr:d'}!~/$crole\&\w*$cqual/) { 
               return "refused:d:$crole&$cqual"; 
            }
        }
    } split('/',$domrole);
    map {
	my ($crole,$cqual)=split(/\&/,$_);
        if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }
        if ($pr{'cr:c'}=~/$crole\&/) {
	    if ($pr{'cr:c'}!~/$crole\&\w*$cqual/) { 
               return "refused:c:$crole&$cqual"; 
            }
        }
    } split('/',$courole);
    my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
                "$ENV{'user.domain'}:$ENV{'user.name'}:".
	        "rolesdef_$rolename=".
                escape($sysrole.'_'.$domrole.'_'.$courole);
    return reply($command,$ENV{'user.home'});
  } else {
    return 'refused';
  }
}

# ------------------------------------------------------------------ Plain Text

sub plaintext {
    my $short=shift;
    return $prp{$short};
}

# ------------------------------------------------------------------ Plain Text

sub fileembstyle {
    my $ending=shift;
    return $fe{$ending};
}

# ------------------------------------------------------------ Description Text

sub filedecription {
    my $ending=shift;
    return $fd{$ending};
}

# ----------------------------------------------------------------- Assign Role

sub assignrole {
    my ($udom,$uname,$url,$role,$end,$start)=@_;
    my $mrole;
    $url=declutter($url);
    if ($role =~ /^cr\//) {
        unless ($url=~/\.course$/) { return 'invalid'; }
	unless (allowed('ccr',$url)) { return 'refused'; }
        $mrole='cr';
    } else {
        unless (($url=~/\.course$/) || ($url=~/\/$/)) { return 'invalid'; }
        unless (allowed('c'+$role)) { return 'refused'; }
        $mrole=$role;
    }
    my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
                "$udom:$uname:$url".'_'."$mrole=$role";
    if ($end) { $command.='_$end'; }
    if ($start) {
	if ($end) { 
           $command.='_$start'; 
        } else {
           $command.='_0_$start';
        }
    }
    return &reply($command,&homeserver($uname,$udom));
}

# ---------------------------------------------------------- Assign Custom Role

sub assigncustomrole {
    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start)=@_;
    return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
                       $end,$start);
}

# ----------------------------------------------------------------- Revoke Role

sub revokerole {
    my ($udom,$uname,$url,$role)=@_;
    my $now=time;
    return &assignrole($udom,$uname,$url,$role,$now);
}

# ---------------------------------------------------------- Revoke Custom Role

sub revokecustomrole {
    my ($udom,$uname,$url,$rdom,$rnam,$rolename)=@_;
    my $now=time;
    return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now);
}

# ------------------------------------------------------------ Directory lister

sub dirlist {
    my $uri=shift;
    $uri=~s/^\///;
    $uri=~s/\/$//;
    my ($res,$udom,$uname,@rest)=split(/\//,$uri);
    if ($udom) {
     if ($uname) {
       my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri,
                      homeserver($uname,$udom));
       return split(/:/,$listing);
     } else {
       my $tryserver;
       my %allusers=();
       foreach $tryserver (keys %libserv) {
	  if ($hostdom{$tryserver} eq $udom) {
             my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom,
			       $tryserver);
             if (($listing ne 'no_such_dir') && ($listing ne 'empty')
              && ($listing ne 'con_lost')) {
                map {
                  my ($entry,@stat)=split(/&/,$_);
                  $allusers{$entry}=1;
                } split(/:/,$listing);
             }
	  }
       }
       my $alluserstr='';
       map {
           $alluserstr.=$_.'&user:';
       } sort keys %allusers;
       $alluserstr=~s/:$//;
       return split(/:/,$alluserstr);
     } 
   } else {
       my $tryserver;
       my %alldom=();
       foreach $tryserver (keys %libserv) {
	   $alldom{$hostdom{$tryserver}}=1;
       }
       my $alldomstr='';
       map {
          $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
       } sort keys %alldom;
       $alldomstr=~s/:$//;
       return split(/:/,$alldomstr);       
   }
}

# -------------------------------------------------------- Value of a Condition

sub directcondval {
    my $number=shift;
    if ($ENV{'user.state.'.$ENV{'request.course.id'}}) {
       return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1);
    } else {
       return 2;
    }
}

sub condval {
    my $condidx=shift;
    my $result=0;
    my $allpathcond='';
    map {
       if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_})) {
	   $allpathcond.=
               '('.$ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_}.')|';
       }
    } split(/\|/,$condidx);
    $allpathcond=~s/\|$//;
    if ($ENV{'request.course.id'}) {
       if ($allpathcond) {
          my $operand='|';
	  my @stack;
          map {
              if ($_ eq '(') {
                 push @stack,($operand,$result)
              } elsif ($_ eq ')') {
                  my $before=pop @stack;
		  if (pop @stack eq '&') {
		      $result=$result>$before?$before:$result;
                  } else {
                      $result=$result>$before?$result:$before;
                  }
              } elsif (($_ eq '&') || ($_ eq '|')) {
                  $operand=$_;
              } else {
                  my $new=directcondval($_);
                  if ($operand eq '&') {
                     $result=$result>$new?$new:$result;
                  } else {
                     $result=$result>$new?$result:$new;
                  }                  
              }
          } ($allpathcond=~/(\d+|\(|\)|\&|\|)/g);
       }
    }
    return $result;
}

# --------------------------------------------------------- Value of a Variable

sub varval {
    my $varname=shift;
    my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
    my $rest;
    if ($therest[0]) {
       $rest=join('.',@therest);
    } else {
       $rest='';
    }
    my $qualifierrest=$qualifier;
    if ($rest) { $qualifierrest.='.'.$rest; }
    my $spacequalifierrest=$space;
    if ($qualifierrest) { $spacequalifierrest.='.'.$qualifierrest; }
    if ($realm eq 'user') {
# --------------------------------------------------------------- user.resource
	if ($space eq 'resource') {
	    my %restored=&restore;
            return $restored{$qualifierrest};
# ----------------------------------------------------------------- user.access
        } elsif ($space eq 'access') {
            return &allowed($qualifier,$rest);
# ------------------------------------------ user.preferences, user.environment
        } elsif (($space eq 'preferences') || ($space eq 'environment')) {
            return $ENV{join('.',('environment',$qualifierrest))};
# ----------------------------------------------------------------- user.course
        } elsif ($space eq 'course') {
            return $ENV{join('.',('request.course',$qualifier))};
# ------------------------------------------------------------------- user.role
        } elsif ($space eq 'role') {
            my ($role,$where)=split(/\./,$ENV{'request.role'});
            if ($qualifier eq 'value') {
		return $role;
            } elsif ($qualifier eq 'extent') {
                return $where;
            }
# ----------------------------------------------------------------- user.domain
        } elsif ($space eq 'domain') {
            return $ENV{'user.domain'};
# ------------------------------------------------------------------- user.name
        } elsif ($space eq 'name') {
            return $ENV{'user.name'};
# ---------------------------------------------------- Any other user namespace
        } else {
            my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
            my %reply=&get($space,$item);
            return $reply{$item};
        }
    } elsif ($realm eq 'request') {
# ------------------------------------------------------------- request.browser
        if ($space eq 'browser') {
	    return $ENV{'browser.'.$qualifier};
# ------------------------------------------------------------ request.filename
        } else {
            return $ENV{'request.'.$spacequalifierrest};
        }
    } elsif ($realm eq 'course') {
# ---------------------------------------------------------- course.description
        my $section='';
        if ($ENV{'request.course.sec'}) {
	    $section='_'.$ENV{'request.course.sec'};
        }
        return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
                              $spacequalifierrest};
    } elsif ($realm eq 'resource') {
# ----------------------------------------------------------- resource metadata
	my $uri=&declutter($ENV{'request.filename'});
        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
        if (-e $filename) {
            my @content;
            {
             my $fh=Apache::File->new($filename);
             @content=<$fh>;
            }
            if (join('',@content)=~
                 /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
	        return $1;
            } else {
                return '';
            }
         }
    } elsif ($realm eq 'userdata') {
        my $uhome=&homeserver($qualifier,$space);
# ----------------------------------------------- userdata.domain.name.resource
# ---------------------------------------------------- Any other user namespace
    } elsif ($realm eq 'environment') {
# ----------------------------------------------------------------- environment
        return $ENV{$spacequalifierrest};
    } elsif ($realm eq 'system') {
# ----------------------------------------------------------------- system.time
	if ($space eq 'time') {
	    return time;
        }
    }
    return '';
}

# ------------------------------------------------- Update symbolic store links

sub symblist {
    my ($mapname,%newhash)=@_;
    $mapname=declutter($mapname);
    my %hash;
    if (($ENV{'request.course.fn'}) && (%newhash)) {
        if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                      &GDBM_WRCREAT,0640)) {
	    map {
                $hash{declutter($_)}=$mapname.'___'.$newhash{$_};
            } keys %newhash;
            if (untie(%hash)) {
		return 'ok';
            }
        }
    }
    return 'error';
}

# ------------------------------------------------------ Return symb list entry

sub symbread {
    my $thisfn=shift;
    unless ($thisfn) {
	$thisfn=$ENV{'request.filename'};
    }
    $thisfn=declutter($thisfn);
    my %hash;
    my %bighash;
    my $syval='';
    if (($ENV{'request.course.fn'}) && ($thisfn)) {
        if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                      &GDBM_READER,0640)) {
	    $syval=$hash{$thisfn};
            untie(%hash);
        }
# ---------------------------------------------------------- There was an entry
        if ($syval) {
           unless ($syval=~/\_\d+$/) {
	       unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
                  &appenv('request.ambiguous' => $thisfn);
                  return '';
               }    
               $syval.=$1;
	   }
        } else {
# ------------------------------------------------------- Was not in symb table
           if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                            &GDBM_READER,0640)) {
# ---------------------------------------------- Get ID(s) for current resource
              my $ids=$bighash{'ids_/res/'.$thisfn};
              if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
                 my @possibilities=split(/\,/,$ids);
                 if ($#possibilities==0) {
# ----------------------------------------------- There is only one possibility
		     my ($mapid,$resid)=split(/\./,$ids);
                     $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
                 } else {
# ------------------------------------------ There is more than one possibility
                     my $realpossible=0;
                     map {
			 my $file=$bighash{'src_'.$_};
                         if (&allowed('bre',$file)) {
         		    my ($mapid,$resid)=split(/\./,$_);
                            if ($bighash{'map_type_'.$mapid} ne 'page') {
				$realpossible++;
                                $syval=declutter($bighash{'map_id_'.$mapid}).
                                       '___'.$resid;
                            }
			 }
                     } @possibilities;
		     if ($realpossible!=1) { $syval=''; }
                 }
	      }
              untie(%bighash)
           } 
        }
        if ($syval) { return $syval.'___'.$thisfn; }
    }
    &appenv('request.ambiguous' => $thisfn);
    return '';
}

# ---------------------------------------------------------- Return random seed

sub numval {
    my $txt=shift;
    $txt=~tr/A-J/0-9/;
    $txt=~tr/a-j/0-9/;
    $txt=~tr/K-T/0-9/;
    $txt=~tr/k-t/0-9/;
    $txt=~tr/U-Z/0-5/;
    $txt=~tr/u-z/0-5/;
    $txt=~s/\D//g;
    return int($txt);
}    

sub rndseed {
    my $symb;
    unless ($symb=&symbread()) { return time; }
    my $symbchck=unpack("%32C*",$symb);
    my $symbseed=numval($symb)%$symbchck;
    my $namechck=unpack("%32C*",$ENV{'user.name'});
    my $nameseed=numval($ENV{'user.name'})%$namechck;
    return int( $symbseed
	       .$nameseed
               .unpack("%32C*",$ENV{'user.domain'})
               .unpack("%32C*",$ENV{'request.course.id'})
               .$namechck
               .$symbchck);
}

# ------------------------------------------------------------ Serves up a file
# returns either the contents of the file or a -1
sub getfile {
  my $file=shift;
  &repcopy($file);
  if (! -e $file ) { return -1; };
  my $fh=Apache::File->new($file);
  my $a='';
  while (<$fh>) { $a .=$_; }
  return $a
}

sub filelocation {
  my ($dir,$file) = @_;
  my $location;
  $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
  $file=~s/^$perlvar{'lonDocRoot'}//;
  $file=~s:^/*res::;
  if ( !( $file =~ m:^/:) ) {
    $location = $dir. '/'.$file;
  } else {
    $location = '/home/httpd/html/res'.$file;
  }
  $location=~s://+:/:g; # remove duplicate /
  while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
  return $location;
}

sub hreflocation {
    my ($dir,$file)=@_;
    unless (($_=~/^http:\/\//i) || ($_=~/^\//)) {
       my $finalpath=filelocation($dir,$file);
       $finalpath=~s/^\/home\/httpd\/html//;
       return $finalpath;
    } else {
       return $file;
    }
}

# ------------------------------------------------------------- Declutters URLs

sub declutter {
    my $thisfn=shift;
    $thisfn=~s/^$perlvar{'lonDocRoot'}//;
    $thisfn=~s/^\///;
    $thisfn=~s/^res\///;
    return $thisfn;
}

# -------------------------------------------------------- Escape Special Chars

sub escape {
    my $str=shift;
    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
    return $str;
}

# ----------------------------------------------------- Un-Escape Special Chars

sub unescape {
    my $str=shift;
    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    return $str;
}

# ================================================================ Main Program

sub BEGIN {
if ($readit ne 'done') {
# ------------------------------------------------------------ Read access.conf
{
    my $config=Apache::File->new("/etc/httpd/conf/access.conf");

    while (my $configline=<$config>) {
        if ($configline =~ /PerlSetVar/) {
	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
           chomp($varvalue);
           $perlvar{$varname}=$varvalue;
        }
    }
}

# ------------------------------------------------------------- Read hosts file
{
    my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");

    while (my $configline=<$config>) {
       my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
       $hostname{$id}=$name;
       $hostdom{$id}=$domain;
       if ($role eq 'library') { $libserv{$id}=$name; }
    }
}

# ------------------------------------------------------ Read spare server file
{
    my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");

    while (my $configline=<$config>) {
       chomp($configline);
       if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
          $spareid{$configline}=1;
       }
    }
}
# ------------------------------------------------------------ Read permissions
{
    my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");

    while (my $configline=<$config>) {
       chomp($configline);
       my ($role,$perm)=split(/ /,$configline);
       if ($perm ne '') { $pr{$role}=$perm; }
    }
}

# -------------------------------------------- Read plain texts for permissions
{
    my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab");

    while (my $configline=<$config>) {
       chomp($configline);
       my ($short,$plain)=split(/:/,$configline);
       if ($plain ne '') { $prp{$short}=$plain; }
    }
}

# ------------------------------------------------------------- Read file types
{
    my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");

    while (my $configline=<$config>) {
       chomp($configline);
       my ($ending,$emb,@descr)=split(/\s+/,$configline);
       if ($descr[0] ne '') { 
         $fe{$ending}=$emb;
         $fd{$ending}=join(' ',@descr);
       }
    }
}


$readit='done';
&logthis('<font color=yellow>INFO: Read configuration</font>');
}
}
1;