Annotation of loncom/lonnet/perl/lonnet.pm, revision 1.3
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,
1.3 ! www 4: # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,11/8,11/16 Gerd Kortemeyer
1.1 albertel 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'})) {
1.3 ! www 174: my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
1.2 www 175: if ($answer =~ /authorized/) {
176: if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; }
177: if ($answer eq 'non_authorized') { return 'no_host'; }
178: }
1.1 albertel 179: }
180:
181: my $tryserver;
182: foreach $tryserver (keys %libserv) {
183: if ($hostdom{$tryserver} eq $udom) {
1.2 www 184: my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);
1.1 albertel 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:
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