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