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