Annotation of loncom/lonsql, revision 1.2
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.2 ! harris41 171: $dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>1,})
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:
! 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:
1.1 harris41 213: }
214:
215: # tidy up gracefully and finish
1.2 ! harris41 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>");
1.1 harris41 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: }
1.2 ! harris41 226: }
1.1 harris41 227:
1.2 ! harris41 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: }
1.1 harris41 233:
1.2 ! harris41 234: # -------------------------------------------------- Non-critical communication
1.1 harris41 235:
1.2 ! harris41 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: }
1.1 harris41 249:
1.2 ! harris41 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: }
1.1 harris41 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