1: #!/usr/bin/perl
2: # lonsql-based on the preforker:harsha jagasia:date:5/10/00
3:
4: use IO::Socket;
5: use Symbol;
6: use POSIX;
7: use IO::Select;
8: use IO::File;
9: use Socket;
10: use Fcntl;
11: use Tie::RefHash;
12: use DBI;
13:
14:
15: $childmaxattempts=10;
16: $run =0;#running counter to generate the query-id
17:
18: # ------------------------------------ Read httpd access.conf and get variables
19: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
20:
21: while ($configline=<CONFIG>) {
22: if ($configline =~ /PerlSetVar/) {
23: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
24: chomp($varvalue);
25: $perlvar{$varname}=$varvalue;
26: }
27: }
28: close(CONFIG);
29:
30: # ------------------------------------------------------------- Read hosts file
31: $PREFORK=4; # number of children to maintain, at least four spare
32:
33: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
34:
35: while ($configline=<CONFIG>) {
36: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
37: chomp($ip);
38:
39: $hostip{$ip}=$id;
40:
41: if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
42:
43: $PREFORK++;
44: }
45: close(CONFIG);
46:
47: $unixsock = "mysqlsock";
48: my $localfile="$perlvar{'lonSockDir'}/$unixsock";
49: my $server;
50: unlink ($localfile);
51: unless ($server=IO::Socket::UNIX->new(Local =>"$localfile",
52: Type => SOCK_STREAM,
53: Listen => 10))
54: {
55: print "in socket error:$@\n";
56: }
57:
58: # -------------------------------------------------------- Routines for forking
59: # global variables
60: $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process
61: %children = (); # keys are current child process IDs
62: $children = 0; # current number of children
63:
64: sub REAPER { # takes care of dead children
65: $SIG{CHLD} = \&REAPER;
66: my $pid = wait;
67: $children --;
68: &logthis("Child $pid died");
69: delete $children{$pid};
70: }
71:
72: sub HUNTSMAN { # signal handler for SIGINT
73: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
74: kill 'INT' => keys %children;
75: my $execdir=$perlvar{'lonDaemons'};
76: unlink("$execdir/logs/lonsql.pid");
77: &logthis("<font color=red>CRITICAL: Shutting down</font>");
78: $unixsock = "mysqlsock";
79: my $port="$perlvar{'lonSockDir'}/$unixsock";
80: unlink(port);
81: exit; # clean up with dignity
82: }
83:
84: sub HUPSMAN { # signal handler for SIGHUP
85: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
86: kill 'INT' => keys %children;
87: close($server); # free up socket
88: &logthis("<font color=red>CRITICAL: Restarting</font>");
89: my $execdir=$perlvar{'lonDaemons'};
90: $unixsock = "mysqlsock";
91: my $port="$perlvar{'lonSockDir'}/$unixsock";
92: unlink(port);
93: exec("$execdir/lonsql"); # here we go again
94: }
95:
96: sub logthis {
97: my $message=shift;
98: my $execdir=$perlvar{'lonDaemons'};
99: my $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.log");
100: my $now=time;
101: my $local=localtime($now);
102: print $fh "$local ($$): $message\n";
103: }
104: # ---------------------------------------------------- Fork once and dissociate
105: $fpid=fork;
106: exit if $fpid;
107: die "Couldn't fork: $!" unless defined ($fpid);
108:
109: POSIX::setsid() or die "Can't start new session: $!";
110:
111: # ------------------------------------------------------- Write our PID on disk
112:
113: $execdir=$perlvar{'lonDaemons'};
114: open (PIDSAVE,">$execdir/logs/lonsql.pid");
115: print PIDSAVE "$$\n";
116: close(PIDSAVE);
117: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
118:
119: # ----------------------------- Ignore signals generated during initial startup
120: $SIG{HUP}=$SIG{USR1}='IGNORE';
121: # ------------------------------------------------------- Now we are on our own
122: # Fork off our children.
123: for (1 .. $PREFORK) {
124: make_new_child();
125: }
126:
127: # Install signal handlers.
128: $SIG{CHLD} = \&REAPER;
129: $SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
130: $SIG{HUP} = \&HUPSMAN;
131:
132: # And maintain the population.
133: while (1) {
134: sleep; # wait for a signal (i.e., child's death)
135: for ($i = $children; $i < $PREFORK; $i++) {
136: make_new_child(); # top up the child pool
137: }
138: }
139:
140:
141: sub make_new_child {
142: my $pid;
143: my $sigset;
144:
145: # block signal for fork
146: $sigset = POSIX::SigSet->new(SIGINT);
147: sigprocmask(SIG_BLOCK, $sigset)
148: or die "Can't block SIGINT for fork: $!\n";
149:
150: die "fork: $!" unless defined ($pid = fork);
151:
152: if ($pid) {
153: # Parent records the child's birth and returns.
154: sigprocmask(SIG_UNBLOCK, $sigset)
155: or die "Can't unblock SIGINT for fork: $!\n";
156: $children{$pid} = 1;
157: $children++;
158: return;
159: } else {
160: # Child can *not* return from this subroutine.
161: $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before
162:
163: # unblock signals
164: sigprocmask(SIG_UNBLOCK, $sigset)
165: or die "Can't unblock SIGINT for fork: $!\n";
166:
167:
168: #open database handle
169: # making dbh global to avoid garbage collector
170: unless (
171: $dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>1,})
172: ) {
173: my $st=120+int(rand(240));
174: &logthis("<font color=blue>WARNING: Couldn't connect to database ($st secs): $@</font>");
175: print "database handle error\n";
176: sleep($st);
177: exit;
178:
179: };
180: # make sure that a database disconnection occurs with ending kill signals
181: $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
182:
183: # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
184: for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
185: $client = $server->accept() or last;
186:
187: # do something with the connection
188: $run = $run+1;
189: my $userinput = <$client>;
190: chomp($userinput);
191:
192: my ($conserver,$query)=split(/&/,$userinput);
193:
194: #send query id which is pid_unixdatetime_runningcounter
195: $queryid = $thisserver;
196: $queryid .="_".($$)."_";
197: $queryid .= time."_";
198: $queryid .= $run;
199: print $client "$queryid\n";
200:
201: #prepare and execute the query
202: # my $sth = $dbh->prepare($query);
203: # unless ($sth->execute())
204: # {
205: # &logthis(
206: # "<font color=blue>WARNING: Could not retrieve from database: $@</font>"
207: # );
208: # }
209: # my $result=$sth->fetch(???);
210: $result="123";
211: &reply("queryreply:$queryid:$result",$conserver);
212:
213: }
214:
215: # tidy up gracefully and finish
216:
217: #close the database handle
218: $dbh->disconnect
219: or &logthis("<font color=blue>WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@</font>");
220:
221: # this exit is VERY important, otherwise the child will become
222: # a producer of more and more children, forking yourself into
223: # process death.
224: exit;
225: }
226: }
227:
228: sub DISCONNECT {
229: $dbh->disconnect or
230: &logthis("<font color=blue>WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@</font>");
231: exit;
232: }
233:
234: # -------------------------------------------------- Non-critical communication
235:
236: sub subreply {
237: my ($cmd,$server)=@_;
238: my $peerfile="$perlvar{'lonSockDir'}/$server";
239: my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
240: Type => SOCK_STREAM,
241: Timeout => 10)
242: or return "con_lost";
243: print $sclient "$cmd\n";
244: my $answer=<$sclient>;
245: chomp($answer);
246: if (!$answer) { $answer="con_lost"; }
247: return $answer;
248: }
249:
250: sub reply {
251: my ($cmd,$server)=@_;
252: my $answer;
253: if ($server ne $perlvar{'lonHostID'}) {
254: $answer=subreply($cmd,$server);
255: if ($answer eq 'con_lost') {
256: $answer=subreply("ping",$server);
257: $answer=subreply($cmd,$server);
258: }
259: } else {
260: $answer='self_reply';
261: }
262: return $answer;
263: }
264:
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