Annotation of loncom/lonnet/perl/lonnet.pm, revision 1.6
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,
1.6 ! www 5: # 11/8,11/16,11/18,11/22,11/23 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 {
1.6 ! www 133: my %newenv=@_;
! 134: my @oldenv;
! 135: {
! 136: my $fh;
! 137: unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
1.5 www 138: return 'error';
1.6 ! www 139: }
! 140: @oldenv=<$fh>;
! 141: }
! 142: for (my $i=0; $i<=$#oldenv; $i++) {
! 143: chomp($oldenv[$i]);
! 144: my ($name,$value)=split(/=/,$oldenv[$i]);
! 145: $newenv{$name}=$value;
! 146: }
! 147: {
! 148: my $fh;
! 149: unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
! 150: return 'error';
! 151: }
! 152: my $newname;
! 153: foreach $newname (keys %newenv) {
! 154: print $fh "$newname=$newenv{$newname}\n";
! 155: }
1.5 www 156: }
157: return 'ok';
158: }
1.1 albertel 159:
160: # ------------------------------ Find server with least workload from spare.tab
161: sub spareserver {
162: my $tryserver;
163: my $spareserver='';
164: my $lowestserver=100;
165: foreach $tryserver (keys %spareid) {
166: my $answer=reply('load',$tryserver);
167: if (($answer =~ /\d/) && ($answer<$lowestserver)) {
168: $spareserver="http://$hostname{$tryserver}";
169: $lowestserver=$answer;
170: }
171: }
172: return $spareserver;
173: }
174:
175: # --------- Try to authenticate user from domain's lib servers (first this one)
176: sub authenticate {
177: my ($uname,$upass,$udom)=@_;
178:
179: if (($perlvar{'lonRole'} eq 'library') &&
180: ($udom eq $perlvar{'lonDefDomain'})) {
1.3 www 181: my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
1.2 www 182: if ($answer =~ /authorized/) {
183: if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; }
184: if ($answer eq 'non_authorized') { return 'no_host'; }
185: }
1.1 albertel 186: }
187:
188: my $tryserver;
189: foreach $tryserver (keys %libserv) {
190: if ($hostdom{$tryserver} eq $udom) {
1.2 www 191: my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);
1.1 albertel 192: if ($answer =~ /authorized/) {
193: if ($answer eq 'authorized') { return $tryserver; }
194: }
195: }
196: }
197: return 'no_host';
198: }
199:
200: # ---------------------- Find the homebase for a user from domain's lib servers
201: sub homeserver {
202: my ($uname,$udom)=@_;
203:
204: my $index="$uname:$udom";
205: if ($homecache{$index}) { return "$homecache{$index}"; }
206:
207: my $tryserver;
208: foreach $tryserver (keys %libserv) {
209: if ($hostdom{$tryserver} eq $udom) {
210: my $answer=reply("home:$udom:$uname",$tryserver);
211: if ($answer eq 'found') {
212: $homecache{$index}=$tryserver;
213: return $tryserver;
214: }
215: }
216: }
217: return 'no_host';
218: }
219:
220: # ----------------------------- Subscribe to a resource, return URL if possible
221: sub subscribe {
222: my $fname=shift;
223: &logthis($fname);
224: my $author=$fname;
225: $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
226: my ($udom,$uname)=split(/\//,$author);
227: my $home=homeserver($uname,$udom);
228: &logthis("$home $udom $uname");
229: if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) {
230: return 'not_found';
231: }
232: my $answer=reply("sub:$fname",$home);
233: return $answer;
234: }
235:
236:
237: # ================================================================ Main Program
238:
239: sub BEGIN {
240: if ($readit ne 'done') {
241: # ------------------------------------------------------------ Read access.conf
242: {
243: my $config=Apache::File->new("/etc/httpd/conf/access.conf");
244:
245: while (my $configline=<$config>) {
246: if ($configline =~ /PerlSetVar/) {
247: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
248: $perlvar{$varname}=$varvalue;
249: }
250: }
251: }
252:
253: # ------------------------------------------------------------- Read hosts file
254: {
255: my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
256:
257: while (my $configline=<$config>) {
258: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
259: $hostname{$id}=$name;
260: $hostdom{$id}=$domain;
261: if ($role eq 'library') { $libserv{$id}=$name; }
262: }
263: }
264:
265: # ------------------------------------------------------ Read spare server file
266: {
267: my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");
268:
269: while (my $configline=<$config>) {
270: chomp($configline);
271: if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
272: $spareid{$configline}=1;
273: }
274: }
275: }
276: $readit='done';
277: &logthis('Read configuration');
278: }
279: }
280: 1;
281:
282:
283:
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