Return to lonnet.pm CVS log

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

Changed authenticate subroutine to work with "enc" and also use standard
channel (through lonc/lond) to locally authenticate. 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,11/8 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 $answer=reply("enc:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
  175:         if ($answer =~ /authorized/) {
  176:               if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; }
  177:               if ($answer eq 'non_authorized') { return 'no_host'; }
  178: 	}
  179:     }
  180: 
  181:     my $tryserver;
  182:     foreach $tryserver (keys %libserv) {
  183: 	if ($hostdom{$tryserver} eq $udom) {
  184:            my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);
  185:            if ($answer =~ /authorized/) {
  186:               if ($answer eq 'authorized') { return $tryserver; } 
  187: 	   }
  188:        }
  189:     }    
  190:     return 'no_host';
  191: }
  192: 
  193: # ---------------------- Find the homebase for a user from domain's lib servers
  194: sub homeserver {
  195:     my ($uname,$udom)=@_;
  196: 
  197:     my $index="$uname:$udom";
  198:     if ($homecache{$index}) { return "$homecache{$index}"; }
  199: 
  200:     my $tryserver;
  201:     foreach $tryserver (keys %libserv) {
  202: 	if ($hostdom{$tryserver} eq $udom) {
  203:            my $answer=reply("home:$udom:$uname",$tryserver);
  204:            if ($answer eq 'found') { 
  205: 	      $homecache{$index}=$tryserver;
  206:               return $tryserver; 
  207: 	   }
  208:        }
  209:     }    
  210:     return 'no_host';
  211: }
  212: 
  213: # ----------------------------- Subscribe to a resource, return URL if possible
  214: sub subscribe {
  215:     my $fname=shift;
  216:     &logthis($fname);
  217:     my $author=$fname;
  218:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  219:     my ($udom,$uname)=split(/\//,$author);
  220:     my $home=homeserver($uname,$udom);
  221:     &logthis("$home $udom $uname");
  222:     if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
  223:         return 'not_found'; 
  224:     }
  225:     my $answer=reply("sub:$fname",$home);
  226:     return $answer;
  227: }
  228:     
  229: 
  230: # ================================================================ Main Program
  231: 
  232: sub BEGIN {
  233: if ($readit ne 'done') {
  234: # ------------------------------------------------------------ Read access.conf
  235: {
  236:     my $config=Apache::File->new("/etc/httpd/conf/access.conf");
  237: 
  238:     while (my $configline=<$config>) {
  239:         if ($configline =~ /PerlSetVar/) {
  240: 	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
  241:            $perlvar{$varname}=$varvalue;
  242:         }
  243:     }
  244: }
  245: 
  246: # ------------------------------------------------------------- Read hosts file
  247: {
  248:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
  249: 
  250:     while (my $configline=<$config>) {
  251:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  252:        $hostname{$id}=$name;
  253:        $hostdom{$id}=$domain;
  254:        if ($role eq 'library') { $libserv{$id}=$name; }
  255:     }
  256: }
  257: 
  258: # ------------------------------------------------------ Read spare server file
  259: {
  260:     my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
  261: 
  262:     while (my $configline=<$config>) {
  263:        chomp($configline);
  264:        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
  265:           $spareid{$configline}=1;
  266:        }
  267:     }
  268: }
  269: $readit='done';
  270: &logthis('Read configuration');
  271: }
  272: }
  273: 1;
  274: 
  275: 
  276: