Annotation of loncom/lonsql, revision 1.1
1.1 ! harris41 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