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