Return to lonnet.pm CVS log

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

Senddelayed moved from lonnet and loncron to lonc - not tested

    1: # The LearningOnline Network
    2: # TCP networking package
    3: # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
    4: # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,11/8,11/16,11/18 Gerd Kortemeyer
    5: 
    6: package Apache::lonnet;
    7: 
    8: use strict;
    9: use Apache::File;
   10: use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit);
   11: use IO::Socket;
   12: 
   13: # --------------------------------------------------------------------- Logging
   14: 
   15: sub logthis {
   16:     my $message=shift;
   17:     my $execdir=$perlvar{'lonDaemons'};
   18:     my $now=time;
   19:     my $local=localtime($now);
   20:     my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
   21:     print $fh "$local ($$): $message\n";
   22:     return 1;
   23: }
   24: 
   25: sub logperm {
   26:     my $message=shift;
   27:     my $execdir=$perlvar{'lonDaemons'};
   28:     my $now=time;
   29:     my $local=localtime($now);
   30:     my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");
   31:     print $fh "$now:$message:$local\n";
   32:     return 1;
   33: }
   34: 
   35: # -------------------------------------------------- Non-critical communication
   36: sub subreply {
   37:     my ($cmd,$server)=@_;
   38:     my $peerfile="$perlvar{'lonSockDir'}/$server";
   39:     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
   40:                                      Type    => SOCK_STREAM,
   41:                                      Timeout => 10)
   42:        or return "con_lost";
   43:     print $client "$cmd\n";
   44:     my $answer=<$client>;
   45:     chomp($answer);
   46:     if (!$answer) { $answer="con_lost"; }
   47:     return $answer;
   48: }
   49: 
   50: sub reply {
   51:     my ($cmd,$server)=@_;
   52:     my $answer=subreply($cmd,$server);
   53:     if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
   54:     return $answer;
   55: }
   56: 
   57: # ----------------------------------------------------------- Send USR1 to lonc
   58: 
   59: sub reconlonc {
   60:     my $peerfile=shift;
   61:     &logthis("Trying to reconnect for $peerfile");
   62:     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
   63:     if (my $fh=Apache::File->new("$loncfile")) {
   64: 	my $loncpid=<$fh>;
   65:         chomp($loncpid);
   66:         if (kill 0 => $loncpid) {
   67: 	    &logthis("lonc at pid $loncpid responding, sending USR1");
   68:             kill USR1 => $loncpid;
   69:             sleep 1;
   70:             if (-e "$peerfile") { return; }
   71:             &logthis("$peerfile still not there, give it another try");
   72:             sleep 5;
   73:             if (-e "$peerfile") { return; }
   74:             &logthis("$peerfile still not there, giving up");
   75:         } else {
   76: 	    &logthis("lonc at pid $loncpid not responding, giving up");
   77:         }
   78:     } else {
   79:         &logthis('lonc not running, giving up');
   80:     }
   81: }
   82: 
   83: # ------------------------------------------------------ Critical communication
   84: sub critical {
   85:     my ($cmd,$server)=@_;
   86:     my $answer=reply($cmd,$server);
   87:     if ($answer eq 'con_lost') {
   88:         my $pingreply=reply('ping',$server);
   89: 	&reconlonc("$perlvar{'lonSockDir'}/$server");
   90:         my $pongreply=reply('pong',$server);
   91:         &logthis("Ping/Pong for $server: $pingreply/$pongreply");
   92:         $answer=reply($cmd,$server);
   93:         if ($answer eq 'con_lost') {
   94:             my $now=time;
   95:             my $middlename=$cmd;
   96:             $middlename=~s/\W//g;
   97:             my $dfilename=
   98:              "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
   99:             {
  100:              my $dfh;
  101:              if ($dfh=Apache::File->new(">$dfilename")) {
  102:                 print $dfh "$server:$cmd\n";
  103: 	     }
  104:             }
  105:             sleep 2;
  106:             my $wcmd='';
  107:             {
  108: 	     my $dfh;
  109:              if ($dfh=Apache::File->new("$dfilename")) {
  110:                 $wcmd=<$dfh>;
  111: 	     }
  112:             }
  113:             chomp($wcmd);
  114:             if ($wcmd eq "$server:$cmd") {
  115: 		&logthis("Connection buffer $dfilename: $cmd");
  116:                 &logperm("D:$server:$cmd");
  117: 	        return 'con_delayed';
  118:             } else {
  119:                 &logthis("CRITICAL CONNECTION FAILED: $server $cmd");
  120:                 &logperm("F:$server:$cmd");
  121:                 return 'con_failed';
  122:             }
  123:         }
  124:     }
  125:     return $answer;
  126: }
  127: 
  128: 
  129: # ------------------------------ Find server with least workload from spare.tab
  130: sub spareserver {
  131:     my $tryserver;
  132:     my $spareserver='';
  133:     my $lowestserver=100;
  134:     foreach $tryserver (keys %spareid) {
  135:        my $answer=reply('load',$tryserver);
  136:        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
  137: 	   $spareserver="http://$hostname{$tryserver}";
  138:            $lowestserver=$answer;
  139:        }
  140:     }    
  141:     return $spareserver;
  142: }
  143: 
  144: # --------- Try to authenticate user from domain's lib servers (first this one)
  145: sub authenticate {
  146:     my ($uname,$upass,$udom)=@_;
  147: 
  148:     if (($perlvar{'lonRole'} eq 'library') && 
  149:         ($udom eq $perlvar{'lonDefDomain'})) {
  150:     my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
  151:         if ($answer =~ /authorized/) {
  152:               if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; }
  153:               if ($answer eq 'non_authorized') { return 'no_host'; }
  154: 	}
  155:     }
  156: 
  157:     my $tryserver;
  158:     foreach $tryserver (keys %libserv) {
  159: 	if ($hostdom{$tryserver} eq $udom) {
  160:            my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);
  161:            if ($answer =~ /authorized/) {
  162:               if ($answer eq 'authorized') { return $tryserver; } 
  163: 	   }
  164:        }
  165:     }    
  166:     return 'no_host';
  167: }
  168: 
  169: # ---------------------- Find the homebase for a user from domain's lib servers
  170: sub homeserver {
  171:     my ($uname,$udom)=@_;
  172: 
  173:     my $index="$uname:$udom";
  174:     if ($homecache{$index}) { return "$homecache{$index}"; }
  175: 
  176:     my $tryserver;
  177:     foreach $tryserver (keys %libserv) {
  178: 	if ($hostdom{$tryserver} eq $udom) {
  179:            my $answer=reply("home:$udom:$uname",$tryserver);
  180:            if ($answer eq 'found') { 
  181: 	      $homecache{$index}=$tryserver;
  182:               return $tryserver; 
  183: 	   }
  184:        }
  185:     }    
  186:     return 'no_host';
  187: }
  188: 
  189: # ----------------------------- Subscribe to a resource, return URL if possible
  190: sub subscribe {
  191:     my $fname=shift;
  192:     &logthis($fname);
  193:     my $author=$fname;
  194:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  195:     my ($udom,$uname)=split(/\//,$author);
  196:     my $home=homeserver($uname,$udom);
  197:     &logthis("$home $udom $uname");
  198:     if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
  199:         return 'not_found'; 
  200:     }
  201:     my $answer=reply("sub:$fname",$home);
  202:     return $answer;
  203: }
  204:     
  205: 
  206: # ================================================================ Main Program
  207: 
  208: sub BEGIN {
  209: if ($readit ne 'done') {
  210: # ------------------------------------------------------------ Read access.conf
  211: {
  212:     my $config=Apache::File->new("/etc/httpd/conf/access.conf");
  213: 
  214:     while (my $configline=<$config>) {
  215:         if ($configline =~ /PerlSetVar/) {
  216: 	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
  217:            $perlvar{$varname}=$varvalue;
  218:         }
  219:     }
  220: }
  221: 
  222: # ------------------------------------------------------------- Read hosts file
  223: {
  224:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
  225: 
  226:     while (my $configline=<$config>) {
  227:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  228:        $hostname{$id}=$name;
  229:        $hostdom{$id}=$domain;
  230:        if ($role eq 'library') { $libserv{$id}=$name; }
  231:     }
  232: }
  233: 
  234: # ------------------------------------------------------ Read spare server file
  235: {
  236:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
  237: 
  238:     while (my $configline=<$config>) {
  239:        chomp($configline);
  240:        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
  241:           $spareid{$configline}=1;
  242:        }
  243:     }
  244: }
  245: $readit='done';
  246: &logthis('Read configuration');
  247: }
  248: }
  249: 1;
  250: 
  251: 
  252: