Annotation of loncom/lonnet/perl/lonnet.pm, revision 1.1
1.1 ! albertel 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lonnet / perl