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