Return to lonnet.pm CVS log

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

Roles have starting and end time
Bug fixes after replication shift
New login screen
Authenticator routes to roles screen
Form variables are transfered to environment (not tested)

# The LearningOnline Network
# TCP networking package
# 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 Gerd Kortemeyer

package Apache::lonnet;

use strict;
use Apache::File;
use LWP::UserAgent();
use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit);
use IO::Socket;
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); }
    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("$peerfile still not there, giving up");
        } else {
	    &logthis("lonc at pid $loncpid not responding, giving up");
        }
    } else {
        &logthis('lonc not running, giving up');
    }
}

# ------------------------------------------------------ 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("Connection buffer $dfilename: $cmd");
                &logperm("D:$server:$cmd");
	        return 'con_delayed';
            } else {
                &logthis("CRITICAL CONNECTION FAILED: $server $cmd");
                &logperm("F:$server:$cmd");
                return 'con_failed';
            }
        }
    }
    return $answer;
}

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

sub appenv {
    my %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]);
	   $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';
}

# ------------------------------ 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)=@_;

    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("enc: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;
    my $transname="$filename.in.transfer";
    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 'forbidden') {
	   &logthis("Subscribe returned forbidden: $filename");
           return FORBIDDEN;
    } 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("LWP GET: $message: $filename");
               return HTTP_SERVICE_UNAVAILABLE;
           } else {
               rename($transname,$filename);
               return OK;
           }
    }
}

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

sub store {
    my %storehash=shift;
    my $command="store:$ENV{'user.domain'}:$ENV{'user.name'}:"
               ."$ENV{'user.class'}:$ENV{'request.filename'}:";
}

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

sub restore {
    my $command="restore:$ENV{'user.domain'}:$ENV{'user.name'}:"
               ."$ENV{'user.class'}:$ENV{'request.filename'}:";
}

# ================================================================ 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;
       }
    }
}
$readit='done';
&logthis('Read configuration');
}
}
1;