Return to lonnet.pm CVS log

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

LON-CAPA Communication Module

# 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 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;
}

# ------------------------------------------------ Try to send delayed messages

sub senddelayed {
    my $server=shift;
    my $dfname;
    my $path="$perlvar{'lonSockDir'}/delayed";
    while ($dfname=<$path/*.$server>) {
        my $wcmd;
        {
         my $dfh=Apache::File->new($dfname);
         $wcmd=<$dfh>;
        }
        my ($server,$cmd)=split(/:/,$wcmd);
        chomp($cmd);
        my $answer=subreply($cmd,$server);
        if ($answer ne 'con_lost') {
	    unlink("$dfname");
            &logthis("Delayed $cmd to $server: $answer");
            &logperm("S:$server:$cmd");
        }        
    }
}

# ----------------------------------------------------------- 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)=@_;
    &senddelayed($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=~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;
}


# ------------------------------ 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 $subdir=$uname;
        $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
        my $passfilename="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname/passwd";
        if (-e $passfilename) {
           my $pf = Apache::File->new($passfilename);
           my $realpasswd=<$pf>;
           chomp($realpasswd);
           if ( $realpasswd eq $upass ) { 
              return $perlvar{'lonHostID'};
	   } else {
	      return 'no_host';
           }
        }
    }

    my $tryserver;
    foreach $tryserver (keys %libserv) {
	if ($hostdom{$tryserver} eq $udom) {
           my $answer=reply("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;