Return to lonsql CVS log

Up to [LON-CAPA] / loncom

Check if already running

    1: #!/usr/bin/perl
    2: # lonsql-based on the preforker:harsha jagasia:date:5/10/00
    3: # 7/25 Gerd Kortemeyer
    4: 
    5: use IO::Socket;
    6: use Symbol;
    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;
   17: $run =0;#running counter to generate the query-id
   18: 
   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);
   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: }
   41: 
   42: # ------------------------------------------------------------- Read hosts file
   43: $PREFORK=4; # number of children to maintain, at least four spare
   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: 
   51:     $hostip{$ip}=$id;
   52: 
   53:     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
   54: 
   55:     $PREFORK++;
   56: }
   57: close(CONFIG);
   58: 
   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: }
   69: 
   70: # -------------------------------------------------------- Routines for forking
   71: # global variables
   72: $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
   73: %children               = ();       # keys are current child process IDs
   74: $children               = 0;        # current number of children
   75: 
   76: sub REAPER {                        # takes care of dead children
   77:     $SIG{CHLD} = \&REAPER;
   78:     my $pid = wait;
   79:     $children --;
   80:     &logthis("Child $pid died");
   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>");
   90:     $unixsock = "mysqlsock";
   91:     my $port="$perlvar{'lonSockDir'}/$unixsock";
   92:     unlink(port);
   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'};
  102:     $unixsock = "mysqlsock";
  103:     my $port="$perlvar{'lonSockDir'}/$unixsock";
  104:     unlink(port);
  105:     exec("$execdir/lonsql");         # here we go again
  106: }
  107: 
  108: sub logthis {
  109:     my $message=shift;
  110:     my $execdir=$perlvar{'lonDaemons'};
  111:     my $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.log");
  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';
  133: # ------------------------------------------------------- Now we are on our own    
  134: # Fork off our children.
  135: for (1 .. $PREFORK) {
  136:     make_new_child();
  137: }
  138: 
  139: # Install signal handlers.
  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)
  147:     for ($i = $children; $i < $PREFORK; $i++) {
  148:         make_new_child();           # top up the child pool
  149:     }
  150: }
  151: 
  152: 
  153: sub make_new_child {
  154:     my $pid;
  155:     my $sigset;
  156:     
  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:     
  162:     die "fork: $!" unless defined ($pid = fork);
  163:     
  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 {
  172:         # Child can *not* return from this subroutine.
  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";
  178: 	
  179: 	
  180:         #open database handle
  181: 	# making dbh global to avoid garbage collector
  182: 	unless (
  183: 		$dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>0,PrintError=>0})
  184: 		) { 
  185: 	            my $st=120+int(rand(240));
  186: 		    &logthis("<font color=blue>WARNING: Couldn't connect to database  ($st secs): $@</font>");
  187: 		    print "database handle error\n";
  188: 		    sleep($st);
  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: 
  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;
  198:             
  199:             # do something with the connection
  200: 	    $run = $run+1;
  201: 	    my $userinput = <$client>;
  202: 	    chomp($userinput);
  203: 	    	    
  204: 	    my ($conserver,$querytmp)=split(/&/,$userinput);
  205: 	    my $query=unescape($querytmp);
  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
  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: 	    }
  227:             &reply("queryreply:$queryid:$result",$conserver);
  228: 
  229:         }
  230:     
  231:         # tidy up gracefully and finish
  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>");
  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:     }
  242: }
  243: 
  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: }
  249: 
  250: # -------------------------------------------------- Non-critical communication
  251: 
  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: }
  265: 
  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: }
  280: 
  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: }