Annotation of loncom/lonsql, revision 1.44

1.1       harris41    1: #!/usr/bin/perl
1.39      harris41    2: 
                      3: # The LearningOnline Network
1.40      harris41    4: # lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
1.39      harris41    5: #
1.44    ! www         6: # $Id: lonsql,v 1.43 2002/05/17 14:03:04 matthew Exp $
1.41      harris41    7: #
                      8: # Copyright Michigan State University Board of Trustees
                      9: #
                     10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     11: #
                     12: # LON-CAPA is free software; you can redistribute it and/or modify
                     13: # it under the terms of the GNU General Public License as published by
                     14: # the Free Software Foundation; either version 2 of the License, or
                     15: # (at your option) any later version.
                     16: #
                     17: # LON-CAPA is distributed in the hope that it will be useful,
                     18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     20: # GNU General Public License for more details.
                     21: #
                     22: # You should have received a copy of the GNU General Public License
                     23: # along with LON-CAPA; if not, write to the Free Software
                     24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     25: #
                     26: # /home/httpd/html/adm/gpl.txt
                     27: #
                     28: # http://www.lon-capa.org/
                     29: #
1.39      harris41   30: # YEAR=2000
1.2       harris41   31: # lonsql-based on the preforker:harsha jagasia:date:5/10/00
1.4       www        32: # 7/25 Gerd Kortemeyer
1.6       harris41   33: # many different dates Scott Harrison
1.39      harris41   34: # YEAR=2001
                     35: # many different dates Scott Harrison
1.7       harris41   36: # 03/22/2001 Scott Harrison
1.36      www        37: # 8/30 Gerd Kortemeyer
1.41      harris41   38: # 10/17,11/28,11/29,12/20 Scott Harrison
1.42      harris41   39: # YEAR=2001
                     40: # 5/11 Scott Harrison
1.39      harris41   41: #
                     42: ###
                     43: 
1.40      harris41   44: ###############################################################################
                     45: ##                                                                           ##
                     46: ## ORGANIZATION OF THIS PERL SCRIPT                                          ##
                     47: ## 1. Modules used                                                           ##
                     48: ## 2. Enable find subroutine                                                 ##
1.43      matthew    49: ## 3. Read httpd config files and get variables                              ##
1.40      harris41   50: ## 4. Make sure that database can be accessed                                ##
                     51: ## 5. Make sure this process is running from user=www                        ##
                     52: ## 6. Check if other instance is running                                     ##
                     53: ## 7. POD (plain old documentation, CPAN style)                              ##
                     54: ##                                                                           ##
                     55: ###############################################################################
1.36      www        56: 
1.42      harris41   57: use lib '/home/httpd/lib/perl/';
                     58: use LONCAPA::Configuration;
                     59: 
1.2       harris41   60: use IO::Socket;
                     61: use Symbol;
1.1       harris41   62: use POSIX;
                     63: use IO::Select;
                     64: use IO::File;
                     65: use Socket;
                     66: use Fcntl;
                     67: use Tie::RefHash;
                     68: use DBI;
                     69: 
1.9       harris41   70: my @metalist;
                     71: # ----------------- Code to enable 'find' subroutine listing of the .meta files
                     72: require "find.pl";
                     73: sub wanted {
                     74:     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
                     75:     -f _ &&
1.34      harris41   76:     /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&
1.9       harris41   77:     push(@metalist,"$dir/$_");
                     78: }
                     79: 
1.1       harris41   80: $childmaxattempts=10;
1.2       harris41   81: $run =0;#running counter to generate the query-id
                     82: 
1.43      matthew    83: # -------------------------------- Read loncapa_apache.conf and loncapa.conf
                     84: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',
                     85:                                                  'loncapa.conf');
1.42      harris41   86: my %perlvar=%{$perlvarref};
1.4       www        87: 
1.31      harris41   88: # ------------------------------------- Make sure that database can be accessed
                     89: {
                     90:     my $dbh;
                     91:     unless (
                     92: 	    $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
                     93: 	    ) { 
                     94: 	print "Cannot connect to database!\n";
1.38      harris41   95: 	$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
                     96: 	$subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
                     97: 	system("echo 'Cannot connect to MySQL database!' |\
                     98:  mailto $emailto -s '$subj' > /dev/null");
                     99: 	exit 1;
1.31      harris41  100:     }
                    101:     else {
                    102: 	$dbh->disconnect;
                    103:     }
                    104: }
                    105: 
1.4       www       106: # --------------------------------------------- Check if other instance running
                    107: 
                    108: my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
                    109: 
                    110: if (-e $pidfile) {
                    111:    my $lfh=IO::File->new("$pidfile");
                    112:    my $pide=<$lfh>;
                    113:    chomp($pide);
                    114:    if (kill 0 => $pide) { die "already running"; }
                    115: }
1.1       harris41  116: 
                    117: # ------------------------------------------------------------- Read hosts file
1.2       harris41  118: $PREFORK=4; # number of children to maintain, at least four spare
1.1       harris41  119: 
                    120: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
                    121: 
                    122: while ($configline=<CONFIG>) {
                    123:     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
                    124:     chomp($ip);
                    125: 
1.2       harris41  126:     $hostip{$ip}=$id;
1.1       harris41  127:     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
                    128: 
1.2       harris41  129:     $PREFORK++;
1.1       harris41  130: }
                    131: close(CONFIG);
1.36      www       132: 
                    133: $PREFORK=int($PREFORK/4);
1.1       harris41  134: 
1.2       harris41  135: $unixsock = "mysqlsock";
                    136: my $localfile="$perlvar{'lonSockDir'}/$unixsock";
                    137: my $server;
                    138: unlink ($localfile);
                    139: unless ($server=IO::Socket::UNIX->new(Local    =>"$localfile",
                    140: 				  Type    => SOCK_STREAM,
                    141: 				  Listen => 10))
                    142: {
                    143:     print "in socket error:$@\n";
                    144: }
1.1       harris41  145: 
                    146: # -------------------------------------------------------- Routines for forking
                    147: # global variables
1.2       harris41  148: $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
1.1       harris41  149: %children               = ();       # keys are current child process IDs
1.2       harris41  150: $children               = 0;        # current number of children
1.1       harris41  151: 
                    152: sub REAPER {                        # takes care of dead children
                    153:     $SIG{CHLD} = \&REAPER;
                    154:     my $pid = wait;
1.2       harris41  155:     $children --;
                    156:     &logthis("Child $pid died");
1.1       harris41  157:     delete $children{$pid};
                    158: }
                    159: 
                    160: sub HUNTSMAN {                      # signal handler for SIGINT
                    161:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
                    162:     kill 'INT' => keys %children;
                    163:     my $execdir=$perlvar{'lonDaemons'};
                    164:     unlink("$execdir/logs/lonsql.pid");
                    165:     &logthis("<font color=red>CRITICAL: Shutting down</font>");
1.2       harris41  166:     $unixsock = "mysqlsock";
                    167:     my $port="$perlvar{'lonSockDir'}/$unixsock";
                    168:     unlink(port);
1.1       harris41  169:     exit;                           # clean up with dignity
                    170: }
                    171: 
                    172: sub HUPSMAN {                      # signal handler for SIGHUP
                    173:     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
                    174:     kill 'INT' => keys %children;
                    175:     close($server);                # free up socket
                    176:     &logthis("<font color=red>CRITICAL: Restarting</font>");
                    177:     my $execdir=$perlvar{'lonDaemons'};
1.2       harris41  178:     $unixsock = "mysqlsock";
                    179:     my $port="$perlvar{'lonSockDir'}/$unixsock";
                    180:     unlink(port);
1.1       harris41  181:     exec("$execdir/lonsql");         # here we go again
                    182: }
                    183: 
                    184: sub logthis {
                    185:     my $message=shift;
                    186:     my $execdir=$perlvar{'lonDaemons'};
1.2       harris41  187:     my $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.log");
1.1       harris41  188:     my $now=time;
                    189:     my $local=localtime($now);
                    190:     print $fh "$local ($$): $message\n";
                    191: }
                    192: # ---------------------------------------------------- Fork once and dissociate
                    193: $fpid=fork;
                    194: exit if $fpid;
                    195: die "Couldn't fork: $!" unless defined ($fpid);
                    196: 
                    197: POSIX::setsid() or die "Can't start new session: $!";
                    198: 
                    199: # ------------------------------------------------------- Write our PID on disk
                    200: 
                    201: $execdir=$perlvar{'lonDaemons'};
                    202: open (PIDSAVE,">$execdir/logs/lonsql.pid");
                    203: print PIDSAVE "$$\n";
                    204: close(PIDSAVE);
                    205: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
                    206: 
                    207: # ----------------------------- Ignore signals generated during initial startup
                    208: $SIG{HUP}=$SIG{USR1}='IGNORE';
1.2       harris41  209: # ------------------------------------------------------- Now we are on our own    
                    210: # Fork off our children.
                    211: for (1 .. $PREFORK) {
                    212:     make_new_child();
1.1       harris41  213: }
                    214: 
1.2       harris41  215: # Install signal handlers.
1.1       harris41  216: $SIG{CHLD} = \&REAPER;
                    217: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
                    218: $SIG{HUP}  = \&HUPSMAN;
                    219: 
                    220: # And maintain the population.
                    221: while (1) {
                    222:     sleep;                          # wait for a signal (i.e., child's death)
1.2       harris41  223:     for ($i = $children; $i < $PREFORK; $i++) {
                    224:         make_new_child();           # top up the child pool
1.1       harris41  225:     }
                    226: }
                    227: 
1.2       harris41  228: 
1.1       harris41  229: sub make_new_child {
                    230:     my $pid;
                    231:     my $sigset;
1.2       harris41  232:     
1.1       harris41  233:     # block signal for fork
                    234:     $sigset = POSIX::SigSet->new(SIGINT);
                    235:     sigprocmask(SIG_BLOCK, $sigset)
                    236:         or die "Can't block SIGINT for fork: $!\n";
                    237:     
1.2       harris41  238:     die "fork: $!" unless defined ($pid = fork);
                    239:     
1.1       harris41  240:     if ($pid) {
                    241:         # Parent records the child's birth and returns.
                    242:         sigprocmask(SIG_UNBLOCK, $sigset)
                    243:             or die "Can't unblock SIGINT for fork: $!\n";
                    244:         $children{$pid} = 1;
                    245:         $children++;
                    246:         return;
                    247:     } else {
1.2       harris41  248:         # Child can *not* return from this subroutine.
1.1       harris41  249:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
                    250:     
                    251:         # unblock signals
                    252:         sigprocmask(SIG_UNBLOCK, $sigset)
                    253:             or die "Can't unblock SIGINT for fork: $!\n";
1.2       harris41  254: 	
                    255: 	
                    256:         #open database handle
                    257: 	# making dbh global to avoid garbage collector
1.1       harris41  258: 	unless (
1.31      harris41  259: 		$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
1.1       harris41  260: 		) { 
1.30      harris41  261:   	            sleep(10+int(rand(20)));
1.1       harris41  262: 		    &logthis("<font color=blue>WARNING: Couldn't connect to database  ($st secs): $@</font>");
1.2       harris41  263: 		    print "database handle error\n";
                    264: 		    exit;
                    265: 
                    266: 	  };
                    267: 	# make sure that a database disconnection occurs with ending kill signals
                    268: 	$SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
                    269: 
1.1       harris41  270:         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
                    271:         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
                    272:             $client = $server->accept()     or last;
1.2       harris41  273:             
                    274:             # do something with the connection
1.1       harris41  275: 	    $run = $run+1;
1.2       harris41  276: 	    my $userinput = <$client>;
                    277: 	    chomp($userinput);
                    278: 	    	    
1.21      harris41  279: 	    my ($conserver,$querytmp,
                    280: 		$customtmp,$customshowtmp)=split(/&/,$userinput);
1.3       harris41  281: 	    my $query=unescape($querytmp);
1.7       harris41  282: 	    my $custom=unescape($customtmp);
1.21      harris41  283: 	    my $customshow=unescape($customshowtmp);
1.2       harris41  284: 
                    285:             #send query id which is pid_unixdatetime_runningcounter
                    286: 	    $queryid = $thisserver;
                    287: 	    $queryid .="_".($$)."_";
                    288: 	    $queryid .= time."_";
                    289: 	    $queryid .= $run;
                    290: 	    print $client "$queryid\n";
                    291: 	    
1.25      harris41  292: 	    &logthis("QUERY: $query");
                    293: 	    sleep 1;
1.44    ! www       294: 
        !           295: # ---------- At this point, query is received, query-ID assigned and sent back 
        !           296: # $query eq 'logquery' will mean that this is a query against log-files
        !           297: 
        !           298:           unless ($query eq 'logquery') {
        !           299: # -------------------------------------------------------- This is an sql query
1.2       harris41  300:             #prepare and execute the query
1.3       harris41  301: 	    my $sth = $dbh->prepare($query);
                    302: 	    my $result;
1.20      harris41  303: 	    my @files;
1.24      harris41  304: 	    my $subsetflag=0;
1.26      harris41  305: 	    if ($query) {
                    306: 		unless ($sth->execute())
                    307: 		{
                    308: 		    &logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");
                    309: 		    $result="";
                    310: 		}
                    311: 		else {
                    312: 		    my $r1=$sth->fetchall_arrayref;
                    313: 		    my @r2;
1.41      harris41  314: 		    foreach (@$r1) {my $a=$_; 
1.26      harris41  315: 			 my @b=map {escape($_)} @$a;
                    316: 			 push @files,@{$a}[3];
                    317: 			 push @r2,join(",", @b)
1.41      harris41  318: 			 }
1.26      harris41  319: 		    $result=join("&",@r2);
                    320: 		}
1.3       harris41  321: 	    }
1.7       harris41  322: 	    # do custom metadata searching here and build into result
1.28      harris41  323: 	    if ($custom or $customshow) {
1.9       harris41  324: 		&logthis("am going to do custom query for $custom");
1.26      harris41  325: 		if ($query) {
1.23      harris41  326: 		    @metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files;
1.20      harris41  327: 		}
                    328: 		else {
                    329: 		    @metalist=(); pop @metalist;
1.34      harris41  330: 		    opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
                    331: 		    my @homeusers=grep
                    332: 		          {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}
                    333: 		          grep {!/^\.\.?$/} readdir(RESOURCES);
                    334: 		    closedir RESOURCES;
                    335: 		    foreach my $user (@homeusers) {
                    336: 			&find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
                    337: 		    }
1.20      harris41  338: 		}
1.23      harris41  339: #		&logthis("FILELIST:" . join(":::",@metalist));
1.10      harris41  340: 		# if file is indicated in sql database and
                    341: 		# not part of sql-relevant query, do not pattern match.
                    342: 		# if file is not in sql database, output error.
                    343: 		# if file is indicated in sql database and is
                    344: 		# part of query result list, then do the pattern match.
1.12      harris41  345: 		my $customresult='';
1.26      harris41  346: 		my @r2;
1.11      harris41  347: 		foreach my $m (@metalist) {
                    348: 		    my $fh=IO::File->new($m);
                    349: 		    my @lines=<$fh>;
                    350: 		    my $stuff=join('',@lines);
                    351: 		    if ($stuff=~/$custom/s) {
1.18      harris41  352: 			foreach my $f ('abstract','author','copyright',
                    353: 				       'creationdate','keywords','language',
                    354: 				       'lastrevisiondate','mime','notes',
                    355: 				       'owner','subject','title') {
1.37      harris41  356: 			    $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s;
1.18      harris41  357: 			}
1.19      harris41  358: 			my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};
1.26      harris41  359: 			$m2=~s/^$docroot//;
                    360: 			$m2=~s/\.meta$//;
                    361: 			unless ($query) {
1.35      harris41  362: 			    my $q2="select * from metadata where url like binary '$m2'";
1.27      harris41  363: 			    my $sth = $dbh->prepare($q2);
1.26      harris41  364: 			    $sth->execute();
                    365: 			    my $r1=$sth->fetchall_arrayref;
1.41      harris41  366: 			    foreach (@$r1) {my $a=$_; 
1.26      harris41  367: 				 my @b=map {escape($_)} @$a;
                    368: 				 push @files,@{$a}[3];
                    369: 				 push @r2,join(",", @b)
1.41      harris41  370: 				 }
1.26      harris41  371: 			}
1.20      harris41  372: #			&logthis("found: $stuff");
1.19      harris41  373: 			$customresult.='&custom='.escape($m2).','.escape($stuff);
1.11      harris41  374: 		    }
                    375: 		}
1.26      harris41  376: 		$result=join("&",@r2) unless $query;
1.17      harris41  377: 		$result.=$customresult;
1.9       harris41  378: 	    }
1.44    ! www       379: # ------------------------------------------------------------ end of sql query
        !           380: 	} else {
        !           381: # ------------------------------------------------------ beginning of log query
        !           382: #
        !           383: # do log queries here
        !           384: #
        !           385: 	    $result='not_yet_implemented';
        !           386: # ------------------------------------------------------------ end of log query
        !           387: 	}
        !           388: 	    # reply with result, append \n unless already there
        !           389: 	    $result.="\n" unless ($result=~/\n$/);
1.17      harris41  390:             &reply("queryreply:$queryid:$result",$conserver);
1.2       harris41  391: 
1.1       harris41  392:         }
                    393:     
                    394:         # tidy up gracefully and finish
1.2       harris41  395: 	
                    396:         #close the database handle
                    397: 	$dbh->disconnect
                    398: 	   or &logthis("<font color=blue>WARNING: Couldn't disconnect from database  $DBI::errstr ($st secs): $@</font>");
1.1       harris41  399:     
                    400:         # this exit is VERY important, otherwise the child will become
                    401:         # a producer of more and more children, forking yourself into
                    402:         # process death.
                    403:         exit;
                    404:     }
1.2       harris41  405: }
1.1       harris41  406: 
1.2       harris41  407: sub DISCONNECT {
                    408:     $dbh->disconnect or 
                    409:     &logthis("<font color=blue>WARNING: Couldn't disconnect from database  $DBI::errstr ($st secs): $@</font>");
                    410:     exit;
                    411: }
1.1       harris41  412: 
1.2       harris41  413: # -------------------------------------------------- Non-critical communication
1.1       harris41  414: 
1.2       harris41  415: sub subreply {
                    416:     my ($cmd,$server)=@_;
                    417:     my $peerfile="$perlvar{'lonSockDir'}/$server";
                    418:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                    419:                                       Type    => SOCK_STREAM,
                    420:                                       Timeout => 10)
                    421:        or return "con_lost";
                    422:     print $sclient "$cmd\n";
                    423:     my $answer=<$sclient>;
                    424:     chomp($answer);
                    425:     if (!$answer) { $answer="con_lost"; }
                    426:     return $answer;
                    427: }
1.1       harris41  428: 
1.2       harris41  429: sub reply {
                    430:   my ($cmd,$server)=@_;
                    431:   my $answer;
                    432:   if ($server ne $perlvar{'lonHostID'}) { 
                    433:     $answer=subreply($cmd,$server);
                    434:     if ($answer eq 'con_lost') {
                    435: 	$answer=subreply("ping",$server);
                    436:         $answer=subreply($cmd,$server);
                    437:     }
                    438:   } else {
                    439:     $answer='self_reply';
1.33      harris41  440:     $answer=subreply($cmd,$server);
1.2       harris41  441:   } 
                    442:   return $answer;
                    443: }
1.1       harris41  444: 
1.3       harris41  445: # -------------------------------------------------------- Escape Special Chars
                    446: 
                    447: sub escape {
                    448:     my $str=shift;
                    449:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
                    450:     return $str;
                    451: }
                    452: 
                    453: # ----------------------------------------------------- Un-Escape Special Chars
                    454: 
                    455: sub unescape {
                    456:     my $str=shift;
                    457:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    458:     return $str;
                    459: }
1.34      harris41  460: 
                    461: # --------------------------------------- Is this the home server of an author?
                    462: # (copied from lond, modification of the return value)
                    463: sub ishome {
                    464:     my $author=shift;
                    465:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
                    466:     my ($udom,$uname)=split(/\//,$author);
                    467:     my $proname=propath($udom,$uname);
                    468:     if (-e $proname) {
                    469: 	return 1;
                    470:     } else {
                    471:         return 0;
                    472:     }
                    473: }
                    474: 
                    475: # -------------------------------------------- Return path to profile directory
                    476: # (copied from lond)
                    477: sub propath {
                    478:     my ($udom,$uname)=@_;
                    479:     $udom=~s/\W//g;
                    480:     $uname=~s/\W//g;
                    481:     my $subdir=$uname.'__';
                    482:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
                    483:     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
                    484:     return $proname;
                    485: } 
1.40      harris41  486: 
                    487: # ----------------------------------- POD (plain old documentation, CPAN style)
                    488: 
                    489: =head1 NAME
                    490: 
                    491: lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
                    492: 
                    493: =head1 SYNOPSIS
                    494: 
                    495: This script should be run as user=www.  The following is an example invocation
                    496: from the loncron script.  Note that a lonsql.pid file contains the pid of
                    497: the parent process.
                    498: 
                    499:     if (-e $lonsqlfile) {
                    500: 	my $lfh=IO::File->new("$lonsqlfile");
                    501: 	my $lonsqlpid=<$lfh>;
                    502: 	chomp($lonsqlpid);
                    503: 	if (kill 0 => $lonsqlpid) {
                    504: 	    print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>";
                    505: 	    $restartflag=0;
                    506: 	} else {
                    507: 	    $errors++; $errors++;
                    508: 	    print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>";
                    509: 		$restartflag=1;
                    510: 	print $fh 
                    511: 	    "<h3>Decided to clean up stale .pid file and restart lonsql</h3>";
                    512: 	}
                    513:     }
                    514:     if ($restartflag==1) {
                    515: 	$errors++;
                    516: 	         print $fh '<br><font color="red">Killall lonsql: '.
                    517:                     system('killall lonsql').' - ';
                    518:                     sleep 60;
                    519:                     print $fh unlink($lonsqlfile).' - '.
                    520:                               system('killall -9 lonsql').
                    521:                     '</font><br>';
                    522: 	print $fh "<h3>lonsql not running, trying to start</h3>";
                    523: 	system(
                    524:  "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");
                    525: 	sleep 10;
                    526: 
                    527: =head1 DESCRIPTION
                    528: 
1.41      harris41  529: Not yet written.
1.40      harris41  530: 
                    531: =head1 README
                    532: 
1.41      harris41  533: Not yet written.
1.40      harris41  534: 
                    535: =head1 PREREQUISITES
                    536: 
                    537: IO::Socket
                    538: Symbol
                    539: POSIX
                    540: IO::Select
                    541: IO::File
                    542: Socket
                    543: Fcntl
                    544: Tie::RefHash
                    545: DBI
                    546: 
                    547: =head1 COREQUISITES
                    548: 
                    549: =head1 OSNAMES
                    550: 
                    551: linux
                    552: 
                    553: =head1 SCRIPT CATEGORIES
                    554: 
                    555: Server/Process
                    556: 
                    557: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>