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)

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