Return to lonnet.pm CVS log

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

Limit length of $middlename to 16 characters for critical message buffer
Add appenv to lonnet (not tested yet)

# 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 Gerd Kortemeyer

package Apache::lonnet;

use strict;
use Apache::File;
use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit);
use IO::Socket;

# --------------------------------------------------------------------- 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>;
    chomp($answer);
    if (!$answer) { $answer="con_lost"; }
    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 "$server:$cmd\n";
	     }
            }
            sleep 2;
            my $wcmd='';
            {
	     my $dfh;
             if ($dfh=Apache::File->new("$dfilename")) {
                $wcmd=<$dfh>;
	     }
            }
            chomp($wcmd);
            if ($wcmd eq "$server:$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 ($name,$value)=@_;
    my $fh;
    unless ($fh=Apache::File->new(">>$ENV{'user.environment'}")) {
	return 'error';
    }
    print $fh "$name=$value\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') { return $perlvar{'lonHostID'}; }
              if ($answer eq 'non_authorized') { 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') { return $tryserver; } 
	   }
       }
    }    
    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;
    &logthis($fname);
    my $author=$fname;
    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
    my ($udom,$uname)=split(/\//,$author);
    my $home=homeserver($uname,$udom);
    &logthis("$home $udom $uname");
    if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
        return 'not_found'; 
    }
    my $answer=reply("sub:$fname",$home);
    return $answer;
}
    

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