1: #!/usr/bin/perl
2:
3: # The LearningOnline Network
4: # lonsql
5: # provides unix domain sockets to receive queries from lond and send replies to lonc
6: #
7: # PID in subdir logs/lonc.pid
8: # kill kills
9: # HUP restarts
10: # USR1 tries to open connections again
11:
12: # 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
13: # 10/8,10/9,10/15,11/18,12/22,
14: # 2/8 Gerd Kortemeyer
15: # based on nonforker from Perl Cookbook
16: # - server who multiplexes without forking
17:
18: use POSIX;
19: use IO::Socket;
20: use IO::Select;
21: use IO::File;
22: use Socket;
23: use Fcntl;
24: use Tie::RefHash;
25: use Crypt::IDEA;
26: use DBI;
27:
28:
29: $childmaxattempts=10;
30: $run =0;
31: # ------------------------------------ Read httpd access.conf and get variables
32:
33: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
34:
35: while ($configline=<CONFIG>) {
36: if ($configline =~ /PerlSetVar/) {
37: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
38: chomp($varvalue);
39: $perlvar{$varname}=$varvalue;
40: }
41: }
42: close(CONFIG);
43:
44: # ------------------------------------------------------------- Read hosts file
45: #$PREFORK=4; # number of children to maintain, at least four spare
46:
47: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
48:
49: while ($configline=<CONFIG>) {
50: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
51: chomp($ip);
52:
53: #$hostip{$ip}=$id;
54: $hostip{$id}=$ip;
55:
56: if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
57:
58: #$PREFORK++;
59: }
60: close(CONFIG);
61:
62:
63: # -------------------------------------------------------- Routines for forking
64: # global variables
65: #$MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process
66: %children = (); # keys are current child process IDs
67: #$children = 0; # current number of children
68: %childpid = (); # the other way around
69:
70: %childatt = (); # number of attempts to start server
71: # for ID
72:
73:
74: sub REAPER { # takes care of dead children
75: $SIG{CHLD} = \&REAPER;
76: my $pid = wait;
77:
78: #$children --;
79: #&logthis("Child $pid died");
80: #delete $children{$pid};
81:
82: my $wasserver=$children{$pid};
83: &logthis("<font color=red>CRITICAL: "
84: ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");
85: delete $children{$pid};
86: delete $childpid{$wasserver};
87: my $port = "$perlvar{'lonSockDir'}/$wasserver";
88: unlink($port);
89:
90:
91: }
92:
93: sub HUNTSMAN { # signal handler for SIGINT
94: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
95: kill 'INT' => keys %children;
96: my $execdir=$perlvar{'lonDaemons'};
97: unlink("$execdir/logs/lonsql.pid");
98: &logthis("<font color=red>CRITICAL: Shutting down</font>");
99: exit; # clean up with dignity
100: }
101:
102: sub HUPSMAN { # signal handler for SIGHUP
103: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
104: kill 'INT' => keys %children;
105: close($server); # free up socket
106: &logthis("<font color=red>CRITICAL: Restarting</font>");
107: my $execdir=$perlvar{'lonDaemons'};
108: exec("$execdir/lonsql"); # here we go again
109: }
110:
111: sub logthis {
112: my $message=shift;
113: my $execdir=$perlvar{'lonDaemons'};
114: my $fh=IO::File->new(">>$execdir/logs/lonsql.log");
115: my $now=time;
116: my $local=localtime($now);
117: print $fh "$local ($$): $message\n";
118: }
119:
120: # ----------------------------------------------------------- Send USR1 to lonc
121: sub reconlonc {
122: my $peerfile=shift;
123: &logthis("Trying to reconnect for $peerfile");
124: my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
125: if (my $fh=IO::File->new("$loncfile")) {
126: my $loncpid=<$fh>;
127: chomp($loncpid);
128: if (kill 0 => $loncpid) {
129: &logthis("lonc at pid $loncpid responding, sending USR1");
130: kill USR1 => $loncpid;
131: sleep 1;
132: if (-e "$peerfile") { return; }
133: &logthis("$peerfile still not there, give it another try");
134: sleep 5;
135: if (-e "$peerfile") { return; }
136: &logthis(
137: "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
138: } else {
139: &logthis(
140: "<font color=red>CRITICAL: "
141: ."lonc at pid $loncpid not responding, giving up</font>");
142: }
143: } else {
144: &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
145: }
146: }
147:
148: # -------------------------------------------------- Non-critical communication
149: sub subreply {
150: my ($cmd,$server)=@_;
151: my $peerfile="$perlvar{'lonSockDir'}/$server";
152: my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
153: Type => SOCK_STREAM,
154: Timeout => 10)
155: or return "con_lost";
156: print $sclient "$cmd\n";
157: my $answer=<$sclient>;
158: chomp($answer);
159: if (!$answer) { $answer="con_lost"; }
160: return $answer;
161: }
162:
163: sub reply {
164: my ($cmd,$server)=@_;
165: my $answer;
166: if ($server ne $perlvar{'lonHostID'}) {
167: $answer=subreply($cmd,$server);
168: if ($answer eq 'con_lost') {
169: $answer=subreply("ping",$server);
170: if ($answer ne $server) {
171: &reconlonc("$perlvar{'lonSockDir'}/$server");
172: }
173: $answer=subreply($cmd,$server);
174: }
175: } else {
176: $answer='self_reply';
177: }
178: return $answer;
179: }
180:
181: $unixsock = "msua1_sql";
182: my $localfile="$perlvar{'lonSockDir'}/$unixsock";
183: my $server=IO::Socket::UNIX->new(LocalAddr =>"$localfile",
184: Type => SOCK_STREAM,
185: Timeout => 10);
186:
187: # ---------------------------------------------------- Fork once and dissociate
188: $fpid=fork;
189: exit if $fpid;
190: die "Couldn't fork: $!" unless defined ($fpid);
191:
192: POSIX::setsid() or die "Can't start new session: $!";
193:
194: # ------------------------------------------------------- Write our PID on disk
195:
196: $execdir=$perlvar{'lonDaemons'};
197: open (PIDSAVE,">$execdir/logs/lonsql.pid");
198: print PIDSAVE "$$\n";
199: close(PIDSAVE);
200: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
201:
202: # ----------------------------- Ignore signals generated during initial startup
203: $SIG{HUP}=$SIG{USR1}='IGNORE';
204:
205: # ------------------------------------------------------- Now we are on our own
206: #Fork of children one for every server
207:
208: #for (1 .. $PREFORK) {
209: # make_new_child($thisserver);
210: #}
211:
212: foreach $thisserver (keys %hostip) {
213: make_new_child($thisserver);
214: }
215:
216: &logthis("Done starting initial servers");
217: # ----------------------------------------------------- Install signal handlers
218:
219: $SIG{CHLD} = \&REAPER;
220: $SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
221: $SIG{HUP} = \&HUPSMAN;
222:
223: # And maintain the population.
224: while (1) {
225: sleep; # wait for a signal (i.e., child's death)
226:
227: #for ($i = $children; $i < $PREFORK; $i++) {
228: # make_new_child(); # top up the child pool
229: #}
230:
231: foreach $thisserver (keys %hostip) {
232: if (!$childpid{$thisserver}) {
233: if ($childatt{$thisserver}<=$childmaxattempts) {
234: $childatt{$thisserver}++;
235: &logthis(
236: "<font color=yellow>INFO: Trying to reconnect for $thisserver "
237: ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");
238: make_new_child($thisserver);
239: }
240: }
241: }
242: }
243:
244: sub make_new_child {
245: my $conserver=shift;
246: my $pid;
247: my $sigset;
248: my $queryid;
249:
250: &logthis("Attempting to start child");
251: # block signal for fork
252: $sigset = POSIX::SigSet->new(SIGINT);
253: sigprocmask(SIG_BLOCK, $sigset)
254: or die "Can't block SIGINT for fork: $!\n";
255:
256: die "fork: $!" unless defined ($pid = fork);#do the forking of children
257:
258: if ($pid) {
259: # Parent records the child's birth and returns.
260: sigprocmask(SIG_UNBLOCK, $sigset)
261: or die "Can't unblock SIGINT for fork: $!\n";
262: $children{$pid} = 1;
263: $children++;
264: return;
265: } else {
266: # Child can *not* return from this subroutine.
267: $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before
268:
269: # unblock signals
270: sigprocmask(SIG_UNBLOCK, $sigset)
271: or die "Can't unblock SIGINT for fork: $!\n";
272:
273: #connect to the database
274: unless (
275: my $dbh = DBI->connect("DBI:mysql:loncapa","root","mysql",{ RaiseError =>1,})
276: ) {
277: my $st=120+int(rand(240));
278: &logthis("<font color=blue>WARNING: Couldn't connect to database ($st secs): $@</font>");
279: sleep($st);
280: exit;#do I need to cleanup before exit if can't connect to database
281: };
282:
283: # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
284: for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
285: $client = $server->accept() or last;
286: $run = $run+1;
287: # =============================================================================
288: # do something with the connection
289: # -----------------------------------------------------------------------------
290: my $userinput = "1";
291: #while (my $userinput=<$client>) {
292: while (my $userinput="1") {
293: print ("here we go\n");
294: chomp($userinput);
295:
296: #send query id which is pid_unixdatetime_runningcounter
297: $queryid = $conserver;
298: $queryid .=($$)."_";
299: $queryid .= time."_";
300: $queryid .= run;
301: print $client "$queryid\n";
302:
303: #prepare and execute the query
304:
305: my $sth = $dbh->prepare("select * into outfile \"$queryid\" from resource");#can't use $userinput directly since we the query to write to a file which depends on the query id generated
306:
307: $sth->execute();
308: if (-e "$queryid") { print "Oops ,file is already there!\n";}
309: else
310: {
311: print "error reading into file\n";
312: }
313:
314: #connect to lonc and send the query results
315: $reply = reply($queryid,$conserver);
316:
317: }
318: # =============================================================================
319: }
320:
321: # tidy up gracefully and finish
322:
323: # this exit is VERY important, otherwise the child will become
324: # a producer of more and more children, forking yourself into
325: # process death.
326: exit;
327: }
328: }
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonsql CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom