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>