Annotation of loncom/lonnet/perl/lonnet.pm, revision 1.1.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