Annotation of loncom/lonsql, revision 1.3
1.1 harris41 1: #!/usr/bin/perl
1.2 harris41 2: # lonsql-based on the preforker:harsha jagasia:date:5/10/00
1.1 harris41 3:
1.2 harris41 4: use IO::Socket;
5: use Symbol;
1.1 harris41 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;
1.2 harris41 16: $run =0;#running counter to generate the query-id
17:
1.1 harris41 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
1.2 harris41 31: $PREFORK=4; # number of children to maintain, at least four spare
1.1 harris41 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:
1.2 harris41 39: $hostip{$ip}=$id;
1.1 harris41 40:
41: if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
42:
1.2 harris41 43: $PREFORK++;
1.1 harris41 44: }
45: close(CONFIG);
46:
1.2 harris41 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: }
1.1 harris41 57:
58: # -------------------------------------------------------- Routines for forking
59: # global variables
1.2 harris41 60: $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process
1.1 harris41 61: %children = (); # keys are current child process IDs
1.2 harris41 62: $children = 0; # current number of children
1.1 harris41 63:
64: sub REAPER { # takes care of dead children
65: $SIG{CHLD} = \&REAPER;
66: my $pid = wait;
1.2 harris41 67: $children --;
68: &logthis("Child $pid died");
1.1 harris41 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>");
1.2 harris41 78: $unixsock = "mysqlsock";
79: my $port="$perlvar{'lonSockDir'}/$unixsock";
80: unlink(port);
1.1 harris41 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'};
1.2 harris41 90: $unixsock = "mysqlsock";
91: my $port="$perlvar{'lonSockDir'}/$unixsock";
92: unlink(port);
1.1 harris41 93: exec("$execdir/lonsql"); # here we go again
94: }
95:
96: sub logthis {
97: my $message=shift;
98: my $execdir=$perlvar{'lonDaemons'};
1.2 harris41 99: my $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.log");
1.1 harris41 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';
1.2 harris41 121: # ------------------------------------------------------- Now we are on our own
122: # Fork off our children.
123: for (1 .. $PREFORK) {
124: make_new_child();
1.1 harris41 125: }
126:
1.2 harris41 127: # Install signal handlers.
1.1 harris41 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)
1.2 harris41 135: for ($i = $children; $i < $PREFORK; $i++) {
136: make_new_child(); # top up the child pool
1.1 harris41 137: }
138: }
139:
1.2 harris41 140:
1.1 harris41 141: sub make_new_child {
142: my $pid;
143: my $sigset;
1.2 harris41 144:
1.1 harris41 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:
1.2 harris41 150: die "fork: $!" unless defined ($pid = fork);
151:
1.1 harris41 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 {
1.2 harris41 160: # Child can *not* return from this subroutine.
1.1 harris41 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";
1.2 harris41 166:
167:
168: #open database handle
169: # making dbh global to avoid garbage collector
1.1 harris41 170: unless (
1.3 ! harris41 171: $dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>0,PrintError=>0})
1.1 harris41 172: ) {
173: my $st=120+int(rand(240));
174: &logthis("<font color=blue>WARNING: Couldn't connect to database ($st secs): $@</font>");
1.2 harris41 175: print "database handle error\n";
1.1 harris41 176: sleep($st);
1.2 harris41 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:
1.1 harris41 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;
1.2 harris41 186:
187: # do something with the connection
1.1 harris41 188: $run = $run+1;
1.2 harris41 189: my $userinput = <$client>;
190: chomp($userinput);
191:
1.3 ! harris41 192: my ($conserver,$querytmp)=split(/&/,$userinput);
! 193: my $query=unescape($querytmp);
1.2 harris41 194:
195: #send query id which is pid_unixdatetime_runningcounter
196: $queryid = $thisserver;
197: $queryid .="_".($$)."_";
198: $queryid .= time."_";
199: $queryid .= $run;
200: print $client "$queryid\n";
201:
202: #prepare and execute the query
1.3 ! harris41 203: my $sth = $dbh->prepare($query);
! 204: my $result;
! 205: unless ($sth->execute())
! 206: {
! 207: &logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");
! 208: $result="";
! 209: }
! 210: else {
! 211: my $r1=$sth->fetchall_arrayref;
! 212: my @r2; map {my $a=$_; my @b=map {escape($_)} @$a; push @r2,join(",", @b)} (@$r1);
! 213: $result=join("&",@r2) . "\n";
! 214: }
1.2 harris41 215: &reply("queryreply:$queryid:$result",$conserver);
216:
1.1 harris41 217: }
218:
219: # tidy up gracefully and finish
1.2 harris41 220:
221: #close the database handle
222: $dbh->disconnect
223: or &logthis("<font color=blue>WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@</font>");
1.1 harris41 224:
225: # this exit is VERY important, otherwise the child will become
226: # a producer of more and more children, forking yourself into
227: # process death.
228: exit;
229: }
1.2 harris41 230: }
1.1 harris41 231:
1.2 harris41 232: sub DISCONNECT {
233: $dbh->disconnect or
234: &logthis("<font color=blue>WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@</font>");
235: exit;
236: }
1.1 harris41 237:
1.2 harris41 238: # -------------------------------------------------- Non-critical communication
1.1 harris41 239:
1.2 harris41 240: sub subreply {
241: my ($cmd,$server)=@_;
242: my $peerfile="$perlvar{'lonSockDir'}/$server";
243: my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
244: Type => SOCK_STREAM,
245: Timeout => 10)
246: or return "con_lost";
247: print $sclient "$cmd\n";
248: my $answer=<$sclient>;
249: chomp($answer);
250: if (!$answer) { $answer="con_lost"; }
251: return $answer;
252: }
1.1 harris41 253:
1.2 harris41 254: sub reply {
255: my ($cmd,$server)=@_;
256: my $answer;
257: if ($server ne $perlvar{'lonHostID'}) {
258: $answer=subreply($cmd,$server);
259: if ($answer eq 'con_lost') {
260: $answer=subreply("ping",$server);
261: $answer=subreply($cmd,$server);
262: }
263: } else {
264: $answer='self_reply';
265: }
266: return $answer;
267: }
1.1 harris41 268:
1.3 ! harris41 269: # -------------------------------------------------------- Escape Special Chars
! 270:
! 271: sub escape {
! 272: my $str=shift;
! 273: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
! 274: return $str;
! 275: }
! 276:
! 277: # ----------------------------------------------------- Un-Escape Special Chars
! 278:
! 279: sub unescape {
! 280: my $str=shift;
! 281: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
! 282: return $str;
! 283: }
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