File:  [LON-CAPA] / nsdl / lonsql
Revision 1.7: download - view: text, annotated - select for diffs
Thu Nov 24 21:34:31 2005 UTC (18 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD
NSDL Search: saving my work

    1: #!/usr/bin/perl
    2: 
    3: # The LearningOnline Network
    4: # lonsql - LON TCP-NSDL Query Handler.
    5: #
    6: # $Id: lonsql,v 1.7 2005/11/24 21:34:31 www Exp $
    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: #
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: This script should be run as user=www.  
   40: Note that a lonsql.pid file contains the pid of the parent process.
   41: 
   42: =head1 OVERVIEW
   43: 
   44: =head2 Purpose within LON-CAPA
   45: 
   46: LON-CAPA is meant to distribute A LOT of educational content to A LOT
   47: of people. It is ineffective to directly rely on contents within the
   48: ext2 filesystem to be speedily scanned for on-the-fly searches of
   49: content descriptions. (Simply put, it takes a cumbersome amount of
   50: time to open, read, analyze, and close thousands of files.)
   51: 
   52: The solution is to index various data fields that are descriptive of
   53: the educational resources on a LON-CAPA server machine in a
   54: database. Descriptive data fields are referred to as "metadata". The
   55: question then arises as to how this metadata is handled in terms of
   56: the rest of the LON-CAPA network without burdening client and daemon
   57: processes.
   58: 
   59: The obvious solution, using lonc to send a query to a lond process,
   60: doesn't work so well in general as you can see in the following
   61: example:
   62: 
   63:     lonc= loncapa client process    A-lonc= a lonc process on Server A
   64:     lond= loncapa daemon process
   65: 
   66:                  database command
   67:     A-lonc  --------TCP/IP----------------> B-lond
   68: 
   69: The problem emerges that A-lonc and B-lond are kept waiting for the
   70: MySQL server to "do its stuff", or in other words, perform the
   71: conceivably sophisticated, data-intensive, time-sucking database
   72: transaction.  By tying up a lonc and lond process, this significantly
   73: cripples the capabilities of LON-CAPA servers.
   74: 
   75: The solution is to offload the work onto another process, and use
   76: lonc and lond just for requests and notifications of completed
   77: processing:
   78: 
   79:                 database command
   80: 
   81:   A-lonc  ---------TCP/IP-----------------> B-lond =====> B-lonsql
   82:          <---------------------------------/                |
   83:            "ok, I'll get back to you..."                    |
   84:                                                             |
   85:                                                             /
   86:   A-lond  <-------------------------------  B-lonc   <======
   87:            "Guess what? I have the result!"
   88: 
   89: Of course, depending on success or failure, the messages may vary, but
   90: the principle remains the same where a separate pool of children
   91: processes (lonsql's) handle the MySQL database manipulations.
   92: 
   93: Thus, lonc and lond spend effectively no time waiting on results from
   94: the database.
   95: 
   96: =head1 Internals
   97: 
   98: =over 4
   99: 
  100: =cut
  101: 
  102: use strict;
  103: 
  104: use lib '/home/httpd/lib/perl/';
  105: use LONCAPA::Configuration;
  106: use LONCAPA::lonmetadata();
  107: 
  108: use IO::Socket;
  109: use Symbol;
  110: use POSIX;
  111: use IO::Select;
  112: use IO::File;
  113: use Socket;
  114: use Fcntl;
  115: use Tie::RefHash;
  116: use HTML::LCParser();
  117: use LWP::UserAgent();
  118: use HTTP::Headers;
  119: use HTTP::Date;
  120: use File::Find;
  121: use localenroll;
  122: 
  123: ########################################################
  124: ########################################################
  125: 
  126: =pod 
  127: 
  128: =item Variables required for forking
  129: 
  130: =over 4
  131: 
  132: =item $MAX_CLIENTS_PER_CHILD
  133: 
  134: The number of clients each child should process.
  135: 
  136: =item %children 
  137: 
  138: The keys to %children  are the current child process IDs
  139: 
  140: =item $children
  141: 
  142: The current number of children
  143: 
  144: =back
  145: 
  146: =cut 
  147: 
  148: ########################################################
  149: ########################################################
  150: my $MAX_CLIENTS_PER_CHILD  = 5;   # number of clients each child should process
  151: my %children               = ();  # keys are current child process IDs
  152: my $children               = 0;   # current number of children
  153:                                
  154: ###################################################################
  155: ###################################################################
  156: 
  157: =pod
  158: 
  159: =item Main body of code.
  160: 
  161: =over 4
  162: 
  163: =item Read data from loncapa_apache.conf and loncapa.conf.
  164: 
  165: =item Ensure we can access the database.
  166: 
  167: =item Determine if there are other instances of lonsql running.
  168: 
  169: =item Read the hosts file.
  170: 
  171: =item Create a socket for lonsql.
  172: 
  173: =item Fork once and dissociate from parent.
  174: 
  175: =item Write PID to disk.
  176: 
  177: =item Prefork children and maintain the population of children.
  178: 
  179: =back
  180: 
  181: =cut
  182: 
  183: ###################################################################
  184: ###################################################################
  185: my $childmaxattempts=10;
  186: my $run =0;              # running counter to generate the query-id
  187: #
  188: # Read loncapa_apache.conf and loncapa.conf
  189: #
  190: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
  191: my %perlvar=%{$perlvarref};
  192: #
  193: # Write the /home/www/.my.cnf file 
  194: my $conf_file = '/home/www/.my.cnf';
  195: if (! -e $conf_file) {
  196:     if (open MYCNF, ">$conf_file") {
  197:         print MYCNF <<"ENDMYCNF";
  198: [client]
  199: user=www
  200: password=$perlvar{'lonSqlAccess'}
  201: ENDMYCNF
  202:         close MYCNF;
  203:     } else {
  204:         warn "Unable to write $conf_file, continuing";
  205:     }
  206: }
  207: 
  208: 
  209: #
  210: # Check if other instance running
  211: #
  212: my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
  213: if (-e $pidfile) {
  214:    my $lfh=IO::File->new("$pidfile");
  215:    my $pide=<$lfh>;
  216:    chomp($pide);
  217:    if (kill 0 => $pide) { die "already running"; }
  218: }
  219: 
  220: #
  221: # Read hosts file
  222: #
  223: my $thisserver;
  224: my $PREFORK=4; # number of children to maintain, at least four spare
  225: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
  226: while (my $configline=<CONFIG>) {
  227:     my ($id,$domain,$role,$name)=split(/:/,$configline);
  228:     $name=~s/\s//g;
  229:     $thisserver=$name if ($id eq $perlvar{'lonHostID'});
  230:     #$PREFORK++;
  231: }
  232: close(CONFIG);
  233: #
  234: #$PREFORK=int($PREFORK/4);
  235: 
  236: #
  237: # Create a socket to talk to lond
  238: #
  239: my $unixsock = "mysqlsock";
  240: my $localfile="$perlvar{'lonSockDir'}/$unixsock";
  241: my $server;
  242: unlink ($localfile);
  243: unless ($server=IO::Socket::UNIX->new(Local    =>"$localfile",
  244:                                       Type    => SOCK_STREAM,
  245:                                       Listen => 10)) {
  246:     print "in socket error:$@\n";
  247: }
  248: 
  249: #
  250: # Fork once and dissociate
  251: #
  252: my $fpid=fork;
  253: exit if $fpid;
  254: die "Couldn't fork: $!" unless defined ($fpid);
  255: POSIX::setsid() or die "Can't start new session: $!";
  256: 
  257: #
  258: # Write our PID on disk
  259: my $execdir=$perlvar{'lonDaemons'};
  260: open (PIDSAVE,">$execdir/logs/lonsql.pid");
  261: print PIDSAVE "$$\n";
  262: close(PIDSAVE);
  263: &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
  264: 
  265: #
  266: # Ignore signals generated during initial startup
  267: $SIG{HUP}=$SIG{USR1}='IGNORE';
  268: # Now we are on our own    
  269: #    Fork off our children.
  270: for (1 .. $PREFORK) {
  271:     make_new_child();
  272: }
  273: 
  274: #
  275: # Install signal handlers.
  276: $SIG{CHLD} = \&REAPER;
  277: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
  278: $SIG{HUP}  = \&HUPSMAN;
  279: 
  280: #
  281: # And maintain the population.
  282: while (1) {
  283:     sleep;                          # wait for a signal (i.e., child's death)
  284:     for (my $i = $children; $i < $PREFORK; $i++) {
  285:         make_new_child();           # top up the child pool
  286:     }
  287: }
  288: 
  289: ########################################################
  290: ########################################################
  291: 
  292: =pod
  293: 
  294: =item &make_new_child
  295: 
  296: Inputs: None
  297: 
  298: Returns: None
  299: 
  300: =cut
  301: 
  302: ########################################################
  303: ########################################################
  304: sub make_new_child {
  305:     my $pid;
  306:     my $sigset;
  307:     #
  308:     # block signal for fork
  309:     $sigset = POSIX::SigSet->new(SIGINT);
  310:     sigprocmask(SIG_BLOCK, $sigset)
  311:         or die "Can't block SIGINT for fork: $!\n";
  312:     #
  313:     die "fork: $!" unless defined ($pid = fork);
  314:     #
  315:     if ($pid) {
  316:         # Parent records the child's birth and returns.
  317:         sigprocmask(SIG_UNBLOCK, $sigset)
  318:             or die "Can't unblock SIGINT for fork: $!\n";
  319:         $children{$pid} = 1;
  320:         $children++;
  321:         return;
  322:     } else {
  323:         # Child can *not* return from this subroutine.
  324:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
  325:         # unblock signals
  326:         sigprocmask(SIG_UNBLOCK, $sigset)
  327:             or die "Can't unblock SIGINT for fork: $!\n";
  328: 
  329: 	$SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
  330:         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
  331:         for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
  332:             my $client = $server->accept() or last;
  333:             # do something with the connection
  334: 	    $run = $run+1;
  335: 	    my $userinput = <$client>;
  336: 	    chomp($userinput);
  337:             #
  338: 	    my ($conserver,$query,
  339: 		$arg1,$arg2,$arg3)=split(/&/,$userinput);
  340: 	    my $query=unescape($query);
  341:             #
  342:             #send query id which is pid_unixdatetime_runningcounter
  343: 	    my $queryid = $thisserver;
  344: 	    $queryid .="_".($$)."_";
  345: 	    $queryid .= time."_";
  346: 	    $queryid .= $run;
  347: 	    print $client "$queryid\n";
  348: 	    #
  349: 	    # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3");
  350: 	    sleep 1;
  351:             #
  352:             my $result='';
  353:             #
  354:             # At this point, query is received, query-ID assigned and sent 
  355:             # back, $query eq 'logquery' will mean that this is a query 
  356:             # against log-files
  357:             if (($query eq 'userlog') || ($query eq 'courselog')) {
  358:                 # beginning of log query
  359:                 my $udom    = &unescape($arg1);
  360:                 my $uname   = &unescape($arg2);
  361:                 my $command = &unescape($arg3);
  362:                 my $path    = &propath($udom,$uname);
  363:                 if (-e "$path/activity.log") {
  364:                     if ($query eq 'userlog') {
  365:                         $result=&userlog($path,$command);
  366:                     } else {
  367:                         $result=&courselog($path,$command);
  368:                     }
  369:                 } else {
  370:                     &logthis('Unable to do log query: '.$uname.'@'.$udom);
  371:                     $result='no_such_file';
  372:                 }
  373:                 # end of log query
  374:             } elsif ($query eq 'fetchenrollment') {
  375:                 # retrieve institutional class lists
  376:                 my $dom = &unescape($arg1);
  377:                 my %affiliates = ();
  378:                 my %replies = ();
  379:                 my $locresult = '';
  380:                 my $querystr = &unescape($arg3);
  381:                 foreach (split/%%/,$querystr) {
  382:                     if (/^([^=]+)=([^=]+)$/) {
  383:                         @{$affiliates{$1}} = split/,/,$2;
  384:                     }
  385:                 }
  386:                 $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);
  387:                 $result = &escape($locresult.':');
  388:                 if ($locresult) {
  389:                     $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
  390:                 }
  391:             } elsif ($query eq 'prepare activity log') {
  392:                 my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2);
  393:                 &logthis('preparing activity log tables for '.$cid);
  394:                 my $command = 
  395:                     qq{$perlvar{'lonDaemons'}/parse_activity_log.pl -course=$cid -domain=$domain};
  396:                 system($command);
  397:                 &logthis($command);
  398:                 my $returnvalue = $?>>8;
  399:                 if ($returnvalue) {
  400:                     $result = 'error: parse_activity_log.pl returned '.
  401:                         $returnvalue;
  402:                 } else {
  403:                     $result = 'success';
  404:                 }
  405:             } else {
  406:                 # Do an sql query
  407:                 $result = &nsdl_query($query,$arg1,$arg2);
  408:             }
  409:             # result does not need to be escaped because it has already been
  410:             # escaped.
  411:             #$result=&escape($result);
  412:             &reply("queryreply:$queryid:$result",$conserver);
  413:         }
  414:         # tidy up gracefully and finish
  415:         #
  416: 
  417:         # this exit is VERY important, otherwise the child will become
  418:         # a producer of more and more children, forking yourself into
  419:         # process death.
  420:         exit;
  421:     }
  422: }
  423: ########################################################
  424: 
  425: =pod
  426: 
  427: =item &logthis
  428: 
  429: Inputs: $message, the message to log
  430: 
  431: Returns: nothing
  432: 
  433: Writes $message to the logfile.
  434: 
  435: =cut
  436: 
  437: ########################################################
  438: ########################################################
  439: sub logthis {
  440:     my $message=shift;
  441:     my $execdir=$perlvar{'lonDaemons'};
  442:     my $fh=IO::File->new(">>$execdir/logs/lonsql.log");
  443:     my $now=time;
  444:     my $local=localtime($now);
  445:     print $fh "$local ($$): $message\n";
  446: }
  447: 
  448: # -------------------------------------------------- Non-critical communication
  449: 
  450: ########################################################
  451: ########################################################
  452: 
  453: =pod
  454: 
  455: =item &subreply
  456: 
  457: Sends a command to a server.  Called only by &reply.
  458: 
  459: Inputs: $cmd,$server
  460: 
  461: Returns: The results of the message or 'con_lost' on error.
  462: 
  463: =cut
  464: 
  465: ########################################################
  466: ########################################################
  467: sub subreply {
  468:     my ($cmd,$server)=@_;
  469:     my $peerfile="$perlvar{'lonSockDir'}/$server";
  470:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  471:                                       Type    => SOCK_STREAM,
  472:                                       Timeout => 10)
  473:        or return "con_lost";
  474:     print $sclient "$cmd\n";
  475:     my $answer=<$sclient>;
  476:     chomp($answer);
  477:     $answer="con_lost" if (!$answer);
  478:     return $answer;
  479: }
  480: 
  481: ########################################################
  482: ########################################################
  483: 
  484: =pod
  485: 
  486: =item &reply
  487: 
  488: Sends a command to a server.
  489: 
  490: Inputs: $cmd,$server
  491: 
  492: Returns: The results of the message or 'con_lost' on error.
  493: 
  494: =cut
  495: 
  496: ########################################################
  497: ########################################################
  498: sub reply {
  499:   my ($cmd,$server)=@_;
  500:   my $answer;
  501:   if ($server ne $perlvar{'lonHostID'}) { 
  502:     $answer=subreply($cmd,$server);
  503:     if ($answer eq 'con_lost') {
  504: 	$answer=subreply("ping",$server);
  505:         $answer=subreply($cmd,$server);
  506:     }
  507:   } else {
  508:     $answer='self_reply';
  509:     $answer=subreply($cmd,$server);
  510:   } 
  511:   return $answer;
  512: }
  513: 
  514: ########################################################
  515: ########################################################
  516: 
  517: =pod
  518: 
  519: =item &escape
  520: 
  521: Escape special characters in a string.
  522: 
  523: Inputs: string to escape
  524: 
  525: Returns: The input string with special characters escaped.
  526: 
  527: =cut
  528: 
  529: ########################################################
  530: ########################################################
  531: sub escape {
  532:     my $str=shift;
  533:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  534:     return $str;
  535: }
  536: 
  537: ########################################################
  538: ########################################################
  539: 
  540: =pod
  541: 
  542: =item &unescape
  543: 
  544: Unescape special characters in a string.
  545: 
  546: Inputs: string to unescape
  547: 
  548: Returns: The input string with special characters unescaped.
  549: 
  550: =cut
  551: 
  552: ########################################################
  553: ########################################################
  554: sub unescape {
  555:     my $str=shift;
  556:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  557:     return $str;
  558: }
  559: 
  560: ########################################################
  561: ########################################################
  562: 
  563: =pod
  564: 
  565: =item &ishome
  566: 
  567: Determine if the current machine is the home server for a user.
  568: The determination is made by checking the filesystem for the users information.
  569: 
  570: Inputs: $author
  571: 
  572: Returns: 0 - this is not the authors home server, 1 - this is.
  573: 
  574: =cut
  575: 
  576: ########################################################
  577: ########################################################
  578: sub ishome {
  579:     my $author=shift;
  580:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  581:     my ($udom,$uname)=split(/\//,$author);
  582:     my $proname=propath($udom,$uname);
  583:     if (-e $proname) {
  584: 	return 1;
  585:     } else {
  586:         return 0;
  587:     }
  588: }
  589: 
  590: ########################################################
  591: ########################################################
  592: 
  593: =pod
  594: 
  595: =item &propath
  596: 
  597: Inputs: user name, user domain
  598: 
  599: Returns: The full path to the users directory.
  600: 
  601: =cut
  602: 
  603: ########################################################
  604: ########################################################
  605: sub propath {
  606:     my ($udom,$uname)=@_;
  607:     $udom=~s/\W//g;
  608:     $uname=~s/\W//g;
  609:     my $subdir=$uname.'__';
  610:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  611:     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
  612:     return $proname;
  613: } 
  614: 
  615: ########################################################
  616: ########################################################
  617: 
  618: =pod
  619: 
  620: =item &courselog
  621: 
  622: Inputs: $path, $command
  623: 
  624: Returns: unescaped string of values.
  625: 
  626: =cut
  627: 
  628: ########################################################
  629: ########################################################
  630: sub courselog {
  631:     my ($path,$command)=@_;
  632:     my %filters=();
  633:     foreach (split(/\:/,&unescape($command))) {
  634: 	my ($name,$value)=split(/\=/,$_);
  635:         $filters{$name}=$value;
  636:     }
  637:     my @results=();
  638:     open(IN,$path.'/activity.log') or return ('file_error');
  639:     while (my $line=<IN>) {
  640:         chomp($line);
  641:         my ($timestamp,$host,$log)=split(/\:/,$line);
  642: #
  643: # $log has the actual log entries; currently still escaped, and
  644: # %26(timestamp)%3a(url)%3a(user)%3a(domain)
  645: # then additionally
  646: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
  647: # or
  648: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
  649: #
  650: # get delimiter between timestamped entries to be &&&
  651:         $log=~s/\%26(\d+)\%3a/\&\&\&$1\%3a/g;
  652: # now go over all log entries 
  653:         foreach (split(/\&\&\&/,&unescape($log))) {
  654: 	    my ($time,$res,$uname,$udom,$action,@values)=split(/\:/,$_);
  655:             my $values=&unescape(join(':',@values));
  656:             $values=~s/\&/\:/g;
  657:             $res=&unescape($res);
  658:             my $include=1;
  659:             if (($filters{'username'}) && ($uname ne $filters{'username'})) 
  660:                                                                { $include=0; }
  661:             if (($filters{'domain'}) && ($udom ne $filters{'domain'})) 
  662:                                                                { $include=0; }
  663:             if (($filters{'url'}) && ($res!~/$filters{'url'}/)) 
  664:                                                                { $include=0; }
  665:             if (($filters{'start'}) && ($time<$filters{'start'})) 
  666:                                                                { $include=0; }
  667:             if (($filters{'end'}) && ($time>$filters{'end'})) 
  668:                                                                { $include=0; }
  669:             if (($filters{'action'} eq 'view') && ($action)) 
  670:                                                                { $include=0; }
  671:             if (($filters{'action'} eq 'submit') && ($action ne 'POST')) 
  672:                                                                { $include=0; }
  673:             if (($filters{'action'} eq 'grade') && ($action ne 'CSTORE')) 
  674:                                                                { $include=0; }
  675:             if ($include) {
  676: 	       push(@results,($time<1000000000?'0':'').$time.':'.$res.':'.
  677:                                             $uname.':'.$udom.':'.
  678:                                             $action.':'.$values);
  679:             }
  680:        }
  681:     }
  682:     close IN;
  683:     return join('&',sort(@results));
  684: }
  685: 
  686: ########################################################
  687: ########################################################
  688: 
  689: =pod
  690: 
  691: =item &userlog
  692: 
  693: Inputs: $path, $command
  694: 
  695: Returns: unescaped string of values.
  696: 
  697: =cut
  698: 
  699: ########################################################
  700: ########################################################
  701: sub userlog {
  702:     my ($path,$command)=@_;
  703:     my %filters=();
  704:     foreach (split(/\:/,&unescape($command))) {
  705: 	my ($name,$value)=split(/\=/,$_);
  706:         $filters{$name}=$value;
  707:     }
  708:     my @results=();
  709:     open(IN,$path.'/activity.log') or return ('file_error');
  710:     while (my $line=<IN>) {
  711:         chomp($line);
  712:         my ($timestamp,$host,$log)=split(/\:/,$line);
  713:         $log=&unescape($log);
  714:         my $include=1;
  715:         if (($filters{'start'}) && ($timestamp<$filters{'start'})) 
  716:                                                              { $include=0; }
  717:         if (($filters{'end'}) && ($timestamp>$filters{'end'})) 
  718:                                                              { $include=0; }
  719:         if (($filters{'action'} eq 'log') && ($log!~/^Log/)) { $include=0; }
  720:         if (($filters{'action'} eq 'check') && ($log!~/^Check/)) 
  721:                                                              { $include=0; }
  722:         if ($include) {
  723: 	   push(@results,$timestamp.':'.$log);
  724:         }
  725:     }
  726:     close IN;
  727:     return join('&',sort(@results));
  728: }
  729: 
  730: ########################################################
  731: ########################################################
  732: 
  733: =pod
  734: 
  735: =item Functions required for forking
  736: 
  737: =over 4
  738: 
  739: =item REAPER
  740: 
  741: REAPER takes care of dead children.
  742: 
  743: =item HUNTSMAN
  744: 
  745: Signal handler for SIGINT.
  746: 
  747: =item HUPSMAN
  748: 
  749: Signal handler for SIGHUP
  750: 
  751: =item DISCONNECT
  752: 
  753: Disconnects from database.
  754: 
  755: =back
  756: 
  757: =cut
  758: 
  759: ########################################################
  760: ########################################################
  761: sub REAPER {                   # takes care of dead children
  762:     $SIG{CHLD} = \&REAPER;
  763:     my $pid = wait;
  764:     $children --;
  765:     &logthis("Child $pid died");
  766:     delete $children{$pid};
  767: }
  768: 
  769: sub HUNTSMAN {                      # signal handler for SIGINT
  770:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
  771:     kill 'INT' => keys %children;
  772:     my $execdir=$perlvar{'lonDaemons'};
  773:     unlink("$execdir/logs/lonsql.pid");
  774:     &logthis("<font color='red'>CRITICAL: Shutting down</font>");
  775:     $unixsock = "mysqlsock";
  776:     my $port="$perlvar{'lonSockDir'}/$unixsock";
  777:     unlink($port);
  778:     exit;                           # clean up with dignity
  779: }
  780: 
  781: sub HUPSMAN {                      # signal handler for SIGHUP
  782:     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
  783:     kill 'INT' => keys %children;
  784:     close($server);                # free up socket
  785:     &logthis("<font color='red'>CRITICAL: Restarting</font>");
  786:     my $execdir=$perlvar{'lonDaemons'};
  787:     $unixsock = "mysqlsock";
  788:     my $port="$perlvar{'lonSockDir'}/$unixsock";
  789:     unlink($port);
  790:     exec("$execdir/lonsql");         # here we go again
  791: }
  792: 
  793: #
  794: # Takes SQL query
  795: # sends it to NSDL
  796: #
  797: 
  798: sub nsdl_query {
  799:     my $query=shift;
  800:     my ($keyword)=($query=~/\"\%([^\%]+)\%\"/);
  801:     $keyword=&escape($keyword);
  802:     my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword;
  803:     my $ua=new LWP::UserAgent;
  804:     my $response=$ua->get($url);
  805:     my $parser=HTML::LCParser->new(\$response->content);
  806:     my $is='';
  807:     my $cont='';
  808:     my $token;
  809:     my %result=();
  810:     my $allresults='';
  811:     while ($token=$parser->get_token) {
  812: 	if ($token->[0] eq 'T') {
  813: 	    $cont.=$token->[1];
  814: 	} elsif ($token->[0] eq 'S') {
  815: 	    if ($token->[1] eq 'record') {
  816: 		%result=();
  817: 	    } elsif ($token->[1]=~/^dc\:/) {
  818: 		$is=$token->[1];
  819: 		$cont='';
  820: 	    }
  821: 	} elsif ($token->[0] eq 'E') {
  822: 	    if ($token->[1] eq 'record') {
  823: #
  824: # Now store it away
  825: #
  826:                 my $url=$result{'dc:identifier'};
  827:                 if ($url=~/^http\:/) {
  828:                    $url=~s/^http:\//\/ext/;
  829:                 } else {
  830:                    $url='';
  831:                 }
  832:                 $allresults.='&'.
  833:                     &escape($result{'dc:title'}).','.
  834:                     &escape($result{'dc:creator'}).','.
  835:                     &escape($url).','.
  836:                     &escape($result{'dc:subject'}).',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,';
  837: 	    } elsif ($token->[1]=~/^dc\:/) {
  838: 		$result{$is}=$cont;
  839: 	    }
  840: 	}
  841:     }
  842:     $allresults=~s/^\&//;
  843: &logthis($allresults);
  844:     return $allresults;
  845: }
  846: 
  847: =pod
  848: 
  849: =back
  850: 
  851: =cut

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