Return to lonnet.pm CVS log

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

Initial revision

    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 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: # ------------------------------------------------ Try to send delayed messages
   58: 
   59: sub senddelayed {
   60:     my $server=shift;
   61:     my $dfname;
   62:     my $path="$perlvar{'lonSockDir'}/delayed";
   63:     while ($dfname=<$path/*.$server>) {
   64:         my $wcmd;
   65:         {
   66:          my $dfh=Apache::File->new($dfname);
   67:          $wcmd=<$dfh>;
   68:         }
   69:         my ($server,$cmd)=split(/:/,$wcmd);
   70:         chomp($cmd);
   71:         my $answer=subreply($cmd,$server);
   72:         if ($answer ne 'con_lost') {
   73: 	    unlink("$dfname");
   74:             &logthis("Delayed $cmd to $server: $answer");
   75:             &logperm("S:$server:$cmd");
   76:         }        
   77:     }
   78: }
   79: 
   80: # ----------------------------------------------------------- Send USR1 to lonc
   81: 
   82: sub reconlonc {
   83:     my $peerfile=shift;
   84:     &logthis("Trying to reconnect for $peerfile");
   85:     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
   86:     if (my $fh=Apache::File->new("$loncfile")) {
   87: 	my $loncpid=<$fh>;
   88:         chomp($loncpid);
   89:         if (kill 0 => $loncpid) {
   90: 	    &logthis("lonc at pid $loncpid responding, sending USR1");
   91:             kill USR1 => $loncpid;
   92:             sleep 1;
   93:             if (-e "$peerfile") { return; }
   94:             &logthis("$peerfile still not there, give it another try");
   95:             sleep 5;
   96:             if (-e "$peerfile") { return; }
   97:             &logthis("$peerfile still not there, giving up");
   98:         } else {
   99: 	    &logthis("lonc at pid $loncpid not responding, giving up");
  100:         }
  101:     } else {
  102:         &logthis('lonc not running, giving up');
  103:     }
  104: }
  105: 
  106: # ------------------------------------------------------ Critical communication
  107: sub critical {
  108:     my ($cmd,$server)=@_;
  109:     &senddelayed($server);
  110:     my $answer=reply($cmd,$server);
  111:     if ($answer eq 'con_lost') {
  112:         my $pingreply=reply('ping',$server);
  113: 	&reconlonc("$perlvar{'lonSockDir'}/$server");
  114:         my $pongreply=reply('pong',$server);
  115:         &logthis("Ping/Pong for $server: $pingreply/$pongreply");
  116:         $answer=reply($cmd,$server);
  117:         if ($answer eq 'con_lost') {
  118:             my $now=time;
  119:             my $middlename=$cmd;
  120:             $middlename=~s/\W//g;
  121:             my $dfilename=
  122:              "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
  123:             {
  124:              my $dfh;
  125:              if ($dfh=Apache::File->new(">$dfilename")) {
  126:                 print $dfh "$server:$cmd\n";
  127: 	     }
  128:             }
  129:             sleep 2;
  130:             my $wcmd='';
  131:             {
  132: 	     my $dfh;
  133:              if ($dfh=Apache::File->new("$dfilename")) {
  134:                 $wcmd=<$dfh>;
  135: 	     }
  136:             }
  137:             chomp($wcmd);
  138:             if ($wcmd eq "$server:$cmd") {
  139: 		&logthis("Connection buffer $dfilename: $cmd");
  140:                 &logperm("D:$server:$cmd");
  141: 	        return 'con_delayed';
  142:             } else {
  143:                 &logthis("CRITICAL CONNECTION FAILED: $server $cmd");
  144:                 &logperm("F:$server:$cmd");
  145:                 return 'con_failed';
  146:             }
  147:         }
  148:     }
  149:     return $answer;
  150: }
  151: 
  152: 
  153: # ------------------------------ Find server with least workload from spare.tab
  154: sub spareserver {
  155:     my $tryserver;
  156:     my $spareserver='';
  157:     my $lowestserver=100;
  158:     foreach $tryserver (keys %spareid) {
  159:        my $answer=reply('load',$tryserver);
  160:        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
  161: 	   $spareserver="http://$hostname{$tryserver}";
  162:            $lowestserver=$answer;
  163:        }
  164:     }    
  165:     return $spareserver;
  166: }
  167: 
  168: # --------- Try to authenticate user from domain's lib servers (first this one)
  169: sub authenticate {
  170:     my ($uname,$upass,$udom)=@_;
  171: 
  172:     if (($perlvar{'lonRole'} eq 'library') && 
  173:         ($udom eq $perlvar{'lonDefDomain'})) {
  174: 	my $subdir=$uname;
  175:         $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  176:         my $passfilename="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname/passwd";
  177:         if (-e $passfilename) {
  178:            my $pf = Apache::File->new($passfilename);
  179:            my $realpasswd=<$pf>;
  180:            chomp($realpasswd);
  181:            if ( $realpasswd eq $upass ) { 
  182:               return $perlvar{'lonHostID'};
  183: 	   } else {
  184: 	      return 'no_host';
  185:            }
  186:         }
  187:     }
  188: 
  189:     my $tryserver;
  190:     foreach $tryserver (keys %libserv) {
  191: 	if ($hostdom{$tryserver} eq $udom) {
  192:            my $answer=reply("auth:$udom:$uname:$upass",$tryserver);
  193:            if ($answer =~ /authorized/) {
  194:               if ($answer eq 'authorized') { return $tryserver; } 
  195: 	   }
  196:        }
  197:     }    
  198:     return 'no_host';
  199: }
  200: 
  201: # ---------------------- Find the homebase for a user from domain's lib servers
  202: sub homeserver {
  203:     my ($uname,$udom)=@_;
  204: 
  205:     my $index="$uname:$udom";
  206:     if ($homecache{$index}) { return "$homecache{$index}"; }
  207: 
  208:     my $tryserver;
  209:     foreach $tryserver (keys %libserv) {
  210: 	if ($hostdom{$tryserver} eq $udom) {
  211:            my $answer=reply("home:$udom:$uname",$tryserver);
  212:            if ($answer eq 'found') { 
  213: 	      $homecache{$index}=$tryserver;
  214:               return $tryserver; 
  215: 	   }
  216:        }
  217:     }    
  218:     return 'no_host';
  219: }
  220: 
  221: # ----------------------------- Subscribe to a resource, return URL if possible
  222: sub subscribe {
  223:     my $fname=shift;
  224:     &logthis($fname);
  225:     my $author=$fname;
  226:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  227:     my ($udom,$uname)=split(/\//,$author);
  228:     my $home=homeserver($uname,$udom);
  229:     &logthis("$home $udom $uname");
  230:     if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
  231:         return 'not_found'; 
  232:     }
  233:     my $answer=reply("sub:$fname",$home);
  234:     return $answer;
  235: }
  236:     
  237: 
  238: # ================================================================ Main Program
  239: 
  240: sub BEGIN {
  241: if ($readit ne 'done') {
  242: # ------------------------------------------------------------ Read access.conf
  243: {
  244:     my $config=Apache::File->new("/etc/httpd/conf/access.conf");
  245: 
  246:     while (my $configline=<$config>) {
  247:         if ($configline =~ /PerlSetVar/) {
  248: 	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
  249:            $perlvar{$varname}=$varvalue;
  250:         }
  251:     }
  252: }
  253: 
  254: # ------------------------------------------------------------- Read hosts file
  255: {
  256:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
  257: 
  258:     while (my $configline=<$config>) {
  259:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  260:        $hostname{$id}=$name;
  261:        $hostdom{$id}=$domain;
  262:        if ($role eq 'library') { $libserv{$id}=$name; }
  263:     }
  264: }
  265: 
  266: # ------------------------------------------------------ Read spare server file
  267: {
  268:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
  269: 
  270:     while (my $configline=<$config>) {
  271:        chomp($configline);
  272:        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
  273:           $spareid{$configline}=1;
  274:        }
  275:     }
  276: }
  277: $readit='done';
  278: &logthis('Read configuration');
  279: }
  280: }
  281: 1;
  282: 
  283: 
  284: