[BACK]Return to lonsql CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lonsql between versions 1.41 and 1.94

version 1.41, 2001/12/20 17:43:05 version 1.94, 2015/08/05 18:47:12
Line 27 Line 27
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2000  
 # lonsql-based on the preforker:harsha jagasia:date:5/10/00  =pod
 # 7/25 Gerd Kortemeyer  
 # many different dates Scott Harrison  =head1 NAME
 # YEAR=2001  
 # many different dates Scott Harrison  lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
 # 03/22/2001 Scott Harrison  
 # 8/30 Gerd Kortemeyer  =head1 SYNOPSIS
 # 10/17,11/28,11/29,12/20 Scott Harrison  
 #  This script should be run as user=www.  
 ###  Note that a lonsql.pid file contains the pid of the parent process.
   
 ###############################################################################  =head1 OVERVIEW
 ##                                                                           ##  
 ## ORGANIZATION OF THIS PERL SCRIPT                                          ##  =head2 Purpose within LON-CAPA
 ## 1. Modules used                                                           ##  
 ## 2. Enable find subroutine                                                 ##  LON-CAPA is meant to distribute A LOT of educational content to A LOT
 ## 3. Read httpd access.conf and get variables                               ##  of people. It is ineffective to directly rely on contents within the
 ## 4. Make sure that database can be accessed                                ##  ext2 filesystem to be speedily scanned for on-the-fly searches of
 ## 5. Make sure this process is running from user=www                        ##  content descriptions. (Simply put, it takes a cumbersome amount of
 ## 6. Check if other instance is running                                     ##  time to open, read, analyze, and close thousands of files.)
 ## 7. POD (plain old documentation, CPAN style)                              ##  
 ##                                                                           ##  The solution is to index various data fields that are descriptive of
 ###############################################################################  the educational resources on a LON-CAPA server machine in a
   database. Descriptive data fields are referred to as "metadata". The
   question then arises as to how this metadata is handled in terms of
   the rest of the LON-CAPA network without burdening client and daemon
   processes.
   
   The obvious solution, using lonc to send a query to a lond process,
   doesn't work so well in general as you can see in the following
   example:
   
       lonc= loncapa client process    A-lonc= a lonc process on Server A
       lond= loncapa daemon process
   
                    database command
       A-lonc  --------TCP/IP----------------> B-lond
   
   The problem emerges that A-lonc and B-lond are kept waiting for the
   MySQL server to "do its stuff", or in other words, perform the
   conceivably sophisticated, data-intensive, time-sucking database
   transaction.  By tying up a lonc and lond process, this significantly
   cripples the capabilities of LON-CAPA servers.
   
   The solution is to offload the work onto another process, and use
   lonc and lond just for requests and notifications of completed
   processing:
   
                   database command
   
     A-lonc  ---------TCP/IP-----------------> B-lond =====> B-lonsql
            <---------------------------------/                |
              "ok, I'll get back to you..."                    |
                                                               |
                                                               /
     A-lond  <-------------------------------  B-lonc   <======
              "Guess what? I have the result!"
   
   Of course, depending on success or failure, the messages may vary, but
   the principle remains the same where a separate pool of children
   processes (lonsql's) handle the MySQL database manipulations.
   
   Thus, lonc and lond spend effectively no time waiting on results from
   the database.
   
   =head1 Internals
   
   =cut
   
   use strict;
   
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
   use LONCAPA::Configuration;
   use LONCAPA::lonmetadata();
   use Apache::lonnet;
   
 use IO::Socket;  use IO::Socket;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
 use IO::Select;  use IO::Select;
 use IO::File;  
 use Socket;  
 use Fcntl;  
 use Tie::RefHash;  
 use DBI;  use DBI;
   use File::Find;
   use localenroll;
   use GDBM_File;
   
 my @metalist;  ########################################################
 # ----------------- Code to enable 'find' subroutine listing of the .meta files  ########################################################
 require "find.pl";  
 sub wanted {  
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&  
     -f _ &&  
     /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&  
     push(@metalist,"$dir/$_");  
 }  
   
 $childmaxattempts=10;  =pod
 $run =0;#running counter to generate the query-id  
   
 # ------------------------------------ Read httpd access.conf and get variables  =over 4
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  
   
 while ($configline=<CONFIG>) {  =item Global Variables
     if ($configline =~ /PerlSetVar/) {  
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
         chomp($varvalue);  
         $perlvar{$varname}=$varvalue;  
     }  
 }  
 close(CONFIG);  
   
 # ------------------------------------- Make sure that database can be accessed  =over 4
 {  
     my $dbh;  
     unless (  
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})  
     ) {   
  print "Cannot connect to database!\n";  
  $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";  
  $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";  
  system("echo 'Cannot connect to MySQL database!' |\  
  mailto $emailto -s '$subj' > /dev/null");  
  exit 1;  
     }  
     else {  
  $dbh->disconnect;  
     }  
 }  
   
 # --------------------------------------------- Check if other instance running  =item dbh
   
 my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";  =back
   
 if (-e $pidfile) {  =cut
    my $lfh=IO::File->new("$pidfile");  
    my $pide=<$lfh>;  
    chomp($pide);  
    if (kill 0 => $pide) { die "already running"; }  
 }  
   
 # ------------------------------------------------------------- Read hosts file  ########################################################
 $PREFORK=4; # number of children to maintain, at least four spare  ########################################################
   my $dbh;
   
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";  ########################################################
   ########################################################
   
 while ($configline=<CONFIG>) {  =pod 
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);  
     chomp($ip);  
   
     $hostip{$ip}=$id;  =item Variables required for forking
     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }  
   
     $PREFORK++;  =over 4
 }  
 close(CONFIG);  
   
 $PREFORK=int($PREFORK/4);  =item $MAX_CLIENTS_PER_CHILD
   
 $unixsock = "mysqlsock";  The number of clients each child should process.
 my $localfile="$perlvar{'lonSockDir'}/$unixsock";  
 my $server;  
 unlink ($localfile);  
 unless ($server=IO::Socket::UNIX->new(Local    =>"$localfile",  
   Type    => SOCK_STREAM,  
   Listen => 10))  
 {  
     print "in socket error:$@\n";  
 }  
   
 # -------------------------------------------------------- Routines for forking  =item %children 
 # global variables  
 $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process  
 %children               = ();       # keys are current child process IDs  
 $children               = 0;        # current number of children  
   
 sub REAPER {                        # takes care of dead children  The keys to %children  are the current child process IDs
     $SIG{CHLD} = \&REAPER;  
     my $pid = wait;  =item $children
     $children --;  
     &logthis("Child $pid died");  The current number of children
     delete $children{$pid};  
   =back
   
   =cut 
   
   ########################################################
   ########################################################
   my $MAX_CLIENTS_PER_CHILD  = 5;   # number of clients each child should process
   my %children               = ();  # keys are current child process IDs
   my $children               = 0;   # current number of children
                                  
   ###################################################################
   ###################################################################
   
   =pod
   
   =item Main body of code.
   
   =over 4
   
   =item Read data from loncapa_apache.conf and loncapa.conf.
   
   =item Ensure we can access the database.
   
   =item Determine if there are other instances of lonsql running.
   
   =item Read the hosts file.
   
   =item Create a socket for lonsql.
   
   =item Fork once and dissociate from parent.
   
   =item Write PID to disk.
   
   =item Prefork children and maintain the population of children.
   
   =back
   
   =cut
   
   ###################################################################
   ###################################################################
   my $childmaxattempts=10;
   my $run =0;              # running counter to generate the query-id
   #
   # Read loncapa_apache.conf and loncapa.conf
   #
   my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
   #
   # Write the /home/www/.my.cnf file 
   my $conf_file = '/home/www/.my.cnf';
   if (! -e $conf_file) {
       if (open MYCNF, ">$conf_file") {
           print MYCNF <<"ENDMYCNF";
   [client]
   user=www
   password=$perlvar{'lonSqlAccess'}
   ENDMYCNF
           close MYCNF;
       } else {
           warn "Unable to write $conf_file, continuing";
       }
 }  }
   
 sub HUNTSMAN {                      # signal handler for SIGINT  
     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children  #
     kill 'INT' => keys %children;  # Make sure that database can be accessed
     my $execdir=$perlvar{'lonDaemons'};  #
     unlink("$execdir/logs/lonsql.pid");  my $dbh;
     &logthis("<font color=red>CRITICAL: Shutting down</font>");  unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
     $unixsock = "mysqlsock";                              $perlvar{'lonSqlAccess'},
     my $port="$perlvar{'lonSockDir'}/$unixsock";                              { RaiseError =>0,PrintError=>0})) { 
     unlink(port);      print "Cannot connect to database!\n";
     exit;                           # clean up with dignity      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
       my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
       system("echo 'Cannot connect to MySQL database!' |".
              " mailto $emailto -s '$subj' > /dev/null");
   
       open(SMP,">$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
       print SMP 'time='.time.'&mysql=defunct'."\n";
       close(SMP);
   
       exit 1;
   } else {
       unlink("$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
       $dbh->disconnect;
 }  }
   
 sub HUPSMAN {                      # signal handler for SIGHUP  #
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children  # Check if other instance running
     kill 'INT' => keys %children;  #
     close($server);                # free up socket  my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
     &logthis("<font color=red>CRITICAL: Restarting</font>");  if (-e $pidfile) {
     my $execdir=$perlvar{'lonDaemons'};     open(my $lfh,"$pidfile");
     $unixsock = "mysqlsock";     my $pide=<$lfh>;
     my $port="$perlvar{'lonSockDir'}/$unixsock";     chomp($pide);
     unlink(port);     if (kill 0 => $pide) { die "already running"; }
     exec("$execdir/lonsql");         # here we go again  
 }  }
   
 sub logthis {  my $PREFORK=4; # number of children to maintain, at least four spare
     my $message=shift;  #
     my $execdir=$perlvar{'lonDaemons'};  #$PREFORK=int($PREFORK/4);
     my $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.log");  
     my $now=time;  #
     my $local=localtime($now);  # Create a socket to talk to lond
     print $fh "$local ($$): $message\n";  #
   my $unixsock = "mysqlsock";
   my $localfile="$perlvar{'lonSockDir'}/$unixsock";
   my $server;
   unlink ($localfile);
   unless ($server=IO::Socket::UNIX->new(Local    =>"$localfile",
                                         Type    => SOCK_STREAM,
                                         Listen => 10)) {
       print "in socket error:$@\n";
 }  }
 # ---------------------------------------------------- Fork once and dissociate  
 $fpid=fork;  #
   # Fork once and dissociate
   #
   my $fpid=fork;
 exit if $fpid;  exit if $fpid;
 die "Couldn't fork: $!" unless defined ($fpid);  die "Couldn't fork: $!" unless defined ($fpid);
   
 POSIX::setsid() or die "Can't start new session: $!";  POSIX::setsid() or die "Can't start new session: $!";
   
 # ------------------------------------------------------- Write our PID on disk  #
   # Write our PID on disk
 $execdir=$perlvar{'lonDaemons'};  my $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lonsql.pid");  open (PIDSAVE,">$execdir/logs/lonsql.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
 &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");  &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
   
 # ----------------------------- Ignore signals generated during initial startup  #
   # Ignore signals generated during initial startup
 $SIG{HUP}=$SIG{USR1}='IGNORE';  $SIG{HUP}=$SIG{USR1}='IGNORE';
 # ------------------------------------------------------- Now we are on our own      # Now we are on our own    
 # Fork off our children.  #    Fork off our children.
 for (1 .. $PREFORK) {  for (1 .. $PREFORK) {
     make_new_child();      make_new_child();
 }  }
   
   #
 # Install signal handlers.  # Install signal handlers.
 $SIG{CHLD} = \&REAPER;  $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;  $SIG{HUP}  = \&HUPSMAN;
   
   #
 # And maintain the population.  # And maintain the population.
 while (1) {  while (1) {
     sleep;                          # wait for a signal (i.e., child's death)      sleep;                          # wait for a signal (i.e., child's death)
     for ($i = $children; $i < $PREFORK; $i++) {      for (my $i = $children; $i < $PREFORK; $i++) {
         make_new_child();           # top up the child pool          make_new_child();           # top up the child pool
     }      }
 }  }
   
   ########################################################
   ########################################################
   
   =pod
   
   =item &make_new_child
   
   Inputs: None
   
   Returns: None
   
   =cut
   
   ########################################################
   ########################################################
 sub make_new_child {  sub make_new_child {
     my $pid;      my $pid;
     my $sigset;      my $sigset;
           #
     # block signal for fork      # block signal for fork
     $sigset = POSIX::SigSet->new(SIGINT);      $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)      sigprocmask(SIG_BLOCK, $sigset)
         or die "Can't block SIGINT for fork: $!\n";          or die "Can't block SIGINT for fork: $!\n";
           #
     die "fork: $!" unless defined ($pid = fork);      die "fork: $!" unless defined ($pid = fork);
           #
     if ($pid) {      if ($pid) {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
Line 249  sub make_new_child { Line 347  sub make_new_child {
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
       
         # unblock signals          # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
   
   
         #open database handle          #open database handle
  # making dbh global to avoid garbage collector   # making dbh global to avoid garbage collector
  unless (   unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
  $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})                                      $perlvar{'lonSqlAccess'},
  ) {                                       { RaiseError =>0,PrintError=>0})) { 
              sleep(10+int(rand(20)));              sleep(10+int(rand(20)));
     &logthis("<font color=blue>WARNING: Couldn't connect to database  ($st secs): $@</font>");              &logthis("<font color='blue'>WARNING: Couldn't connect to database".
     print "database handle error\n";                       ": $@</font>");
     exit;                       #  "($st secs): $@</font>");
               print "database handle error\n";
   };              exit;
  # make sure that a database disconnection occurs with ending kill signals          }
    # make sure that a database disconnection occurs with 
           # ending kill signals
  $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;   $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
   
         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD          # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {          for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
             $client = $server->accept()     or last;              my $client = $server->accept() or last;
               
             # do something with the connection              # do something with the connection
     $run = $run+1;      $run = $run+1;
     my $userinput = <$client>;      my $userinput = <$client>;
     chomp($userinput);      chomp($userinput);
                       $userinput=~s/\:($LONCAPA::domain_re)$//;
     my ($conserver,$querytmp,              my $searchdomain=$1;
  $customtmp,$customshowtmp)=split(/&/,$userinput);              #
     my $query=unescape($querytmp);      my ($conserver,$query,
     my $custom=unescape($customtmp);   $arg1,$arg2,$arg3)=split(/&/,$userinput);
     my $customshow=unescape($customshowtmp);      my $query=unescape($query);
               #
             #send query id which is pid_unixdatetime_runningcounter              #send query id which is pid_unixdatetime_runningcounter
     $queryid = $thisserver;      my $queryid = &Apache::lonnet::hostname($perlvar{'lonHostID'});
     $queryid .="_".($$)."_";      $queryid .="_".($$)."_";
     $queryid .= time."_";      $queryid .= time."_";
     $queryid .= $run;      $queryid .= $run;
     print $client "$queryid\n";      print $client "$queryid\n";
           #
     &logthis("QUERY: $query");      # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid");
     &logthis("QUERY: $query");      # sleep 1;
     sleep 1;              #
             #prepare and execute the query              my $result='';
     my $sth = $dbh->prepare($query);              #
     my $result;              # At this point, query is received, query-ID assigned and sent 
     my @files;              # back, $query eq 'logquery' will mean that this is a query 
     my $subsetflag=0;              # against log-files
     if ($query) {              if (($query eq 'userlog') || ($query eq 'courselog')) {
  unless ($sth->execute())                  # beginning of log query
  {                  my $udom    = &unescape($arg1);
     &logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");                  my $uname   = &unescape($arg2);
     $result="";                  my $command = &unescape($arg3);
  }                  my $path    = &propath($udom,$uname);
  else {                  if (-e "$path/activity.log") {
     my $r1=$sth->fetchall_arrayref;                      if ($query eq 'userlog') {
     my @r2;                          $result=&userlog($path,$command);
     foreach (@$r1) {my $a=$_;                       } else {
  my @b=map {escape($_)} @$a;                          $result=&courselog($path,$command);
  push @files,@{$a}[3];                      }
  push @r2,join(",", @b)                      $result = &escape($result);
  }                  } else {
     $result=join("&",@r2);                      &logthis('Unable to do log query: '.$uname.'@'.$udom);
  }                      $result='no_such_file';
     }                  }
     # do custom metadata searching here and build into result                  # end of log query
     if ($custom or $customshow) {              } elsif (($query eq 'fetchenrollment') || 
  &logthis("am going to do custom query for $custom");       ($query eq 'institutionalphotos')) {
  if ($query) {                  # retrieve institutional class lists
     @metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files;                  my $dom = &unescape($arg1);
  }                  my %affiliates = ();
  else {                  my %replies = ();
     @metalist=(); pop @metalist;                  my $locresult = '';
     opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");                  my $querystr = &unescape($arg3);
     my @homeusers=grep                  foreach (split/%%/,$querystr) {
           {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}                      if (/^([^=]+)=([^=]+)$/) {
           grep {!/^\.\.?$/} readdir(RESOURCES);                          @{$affiliates{$1}} = split/,/,$2;
     closedir RESOURCES;                      }
     foreach my $user (@homeusers) {                  }
  &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");                  if ($query eq 'fetchenrollment') { 
                       $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);
                   } elsif ($query eq 'institutionalphotos') {
                       my $crs = &unescape($arg2);
       eval {
    local($SIG{__DIE__})='DEFAULT';
    $locresult = &localenroll::institutional_photos($dom,$crs,\%affiliates,\%replies,'update');
       };
       if ($@) {
    $locresult = 'error';
     }      }
  }                  }
 # &logthis("FILELIST:" . join(":::",@metalist));                  $result = &escape($locresult.':');
  # if file is indicated in sql database and                  if ($locresult) {
  # not part of sql-relevant query, do not pattern match.                      $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
  # if file is not in sql database, output error.                  }
  # if file is indicated in sql database and is              } elsif ($query eq 'usersearch') {
  # part of query result list, then do the pattern match.                  my ($srchby,$srchtype,$srchterm);
  my $customresult='';                  if ((&unescape($arg1) eq $searchdomain) &&
  my @r2;                      ($arg2 =~ /\%\%/)) {
  foreach my $m (@metalist) {                      ($srchby,$srchtype) =
     my $fh=IO::File->new($m);                          map {&unescape($_);} (split(/\%\%/,$arg2));
     my @lines=<$fh>;                      $srchterm = &unescape($arg3);
     my $stuff=join('',@lines);                  } else {
     if ($stuff=~/$custom/s) {                      ($srchby,$srchtype,$srchterm) =
  foreach my $f ('abstract','author','copyright',                          map {&unescape($_);} ($arg1,$arg2,$arg3);
        'creationdate','keywords','language',                  }
        'lastrevisiondate','mime','notes',                  $result = &do_user_search($searchdomain,$srchby,
        'owner','subject','title') {                                            $srchtype,$srchterm);
     $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s;      } elsif ($query eq 'instdirsearch') {
  }   $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);
  my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};              } elsif ($query eq 'getinstuser') {
  $m2=~s/^$docroot//;                  $result = &get_inst_user($searchdomain,$arg1,$arg2);
  $m2=~s/\.meta$//;              } elsif ($query eq 'getmultinstusers') {
  unless ($query) {                  $result = &get_multiple_instusers($searchdomain,$arg3);
     my $q2="select * from metadata where url like binary '$m2'";              } elsif ($query eq 'prepare activity log') {
     my $sth = $dbh->prepare($q2);                  my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2);
     $sth->execute();                  &logthis('preparing activity log tables for '.$cid);
     my $r1=$sth->fetchall_arrayref;                  my $command = 
     foreach (@$r1) {my $a=$_;                       qq{$perlvar{'lonDaemons'}/parse_activity_log.pl -course=$cid -domain=$domain};
  my @b=map {escape($_)} @$a;                  system($command);
  push @files,@{$a}[3];                  &logthis($command);
  push @r2,join(",", @b)                  my $returnvalue = $?>>8;
  }                  if ($returnvalue) {
  }                      $result = 'error: parse_activity_log.pl returned '.
 # &logthis("found: $stuff");                          $returnvalue;
  $customresult.='&custom='.escape($m2).','.escape($stuff);                  } else {
     }                      $result = 'success';
  }                  }
  $result=join("&",@r2) unless $query;              } elsif (($query eq 'portfolio_metadata') || 
  $result.=$customresult;                      ($query eq 'portfolio_access')) {
     }                  $result = &portfolio_table_update($query,$arg1,$arg2,
     # reply with result                                                    $arg3);
     $result.="\n" if $result;              } elsif ($query eq 'allusers') {
             &reply("queryreply:$queryid:$result",$conserver);                  my ($uname,$udom) = map {&unescape($_);} ($arg1,$arg2);
                   my %userdata;
                   my (@data) = split(/\%\%/,$arg3);
                   foreach my $item (@data) {
                       my ($key,$value) = split(/=/,$item);
                       $userdata{$key} = &unescape($value);
                   }
                   $userdata{'username'} = $uname;
                   $userdata{'domain'} = $udom;
                   $result = &allusers_table_update($query,$uname,$udom,\%userdata);
               } else {
                   # Do an sql query
                   $result = &do_sql_query($query,$arg1,$arg2,$arg3,$searchdomain);
               }
               # result does not need to be escaped because it has already been
               # escaped.
               #$result=&escape($result);
               &Apache::lonnet::reply("queryreply:$queryid:$result",$conserver);
         }          }
       
         # tidy up gracefully and finish          # tidy up gracefully and finish
           #
         #close the database handle          # close the database handle
  $dbh->disconnect   $dbh->disconnect
    or &logthis("<font color=blue>WARNING: Couldn't disconnect from database  $DBI::errstr ($st secs): $@</font>");              or &logthis("<font color='blue'>WARNING: Couldn't disconnect".
                               " from database  $DBI::errstr : $@</font>");
         # this exit is VERY important, otherwise the child will become          # this exit is VERY important, otherwise the child will become
         # a producer of more and more children, forking yourself into          # a producer of more and more children, forking yourself into
         # process death.          # process death.
Line 392  sub make_new_child { Line 511  sub make_new_child {
     }      }
 }  }
   
 sub DISCONNECT {  sub do_user_search {
     $dbh->disconnect or       my ($domain,$srchby,$srchtype,$srchterm) = @_;
     &logthis("<font color=blue>WARNING: Couldn't disconnect from database  $DBI::errstr ($st secs): $@</font>");      my $result;
     exit;      my $quoted_dom = $dbh->quote( $domain );
       my ($query,$quoted_srchterm,@fields);
       my ($table_columns,$table_indices) =
           &LONCAPA::lonmetadata::describe_metadata_storage('allusers');
       foreach my $coldata (@{$table_columns}) {
           push(@fields,$coldata->{'name'});
       }
       my $fieldlist = join(',',@fields);
       $query = "SELECT $fieldlist FROM allusers WHERE (domain = $quoted_dom AND ";
       if ($srchby eq 'lastfirst') {
           my ($fraglast,$fragfirst) = split(/,/,$srchterm);
           $fragfirst =~ s/^\s+//;
           $fraglast =~ s/\s+$//;
           if ($srchtype eq 'exact') {
               $query .= 'lastname = '.$dbh->quote($fraglast).
                         ' AND firstname = '.$dbh->quote($fragfirst);
           } elsif ($srchtype eq 'begins') {
               $query .= 'lastname LIKE '.$dbh->quote($fraglast.'%').
                         ' AND firstname LIKE '.$dbh->quote($fragfirst.'%');
           } else {
               $query .= 'lastname LIKE '.$dbh->quote('%'.$fraglast.'%').
                         ' AND firstname LIKE '.$dbh->quote('%'.$fragfirst.'%');
           }
       } else {
           my %srchfield = (
                             uname    => 'username',
                             lastname => 'lastname',
                           );
           if ($srchtype eq 'exact') {
               $query .= $srchfield{$srchby}.' = '.$dbh->quote($srchterm);
           } elsif ($srchtype eq 'begins') {
                $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote($srchterm.'%');
           } else {
                $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote('%'.$srchterm.'%');
           }
       }
       $query .= ") ORDER BY username ";
       my $sth = $dbh->prepare($query);
       if ($sth->execute()) {
           my @results;
           while (my @row = $sth->fetchrow_array) {
               my @items;
               for (my $i=0; $i<@row; $i++) {
                   push(@items,&escape($fields[$i]).'='.&escape($row[$i]));
               }
               my $userstr = join(':', @items);
               push(@results,&escape($userstr));
           }
           $sth->finish;
           $result = join('&',@results);
       } else {
           &logthis('<font color="blue">'.
                   'WARNING: Could not retrieve from database:'.
           $sth->errstr().'</font>');
       }
       return $result;
 }  }
   
 # -------------------------------------------------- Non-critical communication  sub do_inst_dir_search {
       my ($domain,$srchby,$srchterm,$srchtype) = @_;
       $srchby   = &unescape($srchby);
       $srchterm = &unescape($srchterm);
       $srchtype = &unescape($srchtype);
       my (%instusers,%instids,$result,$response);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $result=&localenroll::get_userinfo($domain,undef,undef,\%instusers,
      \%instids,undef,$srchby,$srchterm,
      $srchtype);
       };
       if ($result eq 'ok') {
           if (%instusers) {
               foreach my $key (keys(%instusers)) {
                   my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key});
                   $response .=&escape(&escape($key).'='.$usrstr).'&';
               }
           }
           $response=~s/\&$//;
       } else {
           $response = 'unavailable';
       }
       return $response;
   }
   
 sub subreply {  sub get_inst_user {
     my ($cmd,$server)=@_;      my ($domain,$uname,$id) = @_;
     my $peerfile="$perlvar{'lonSockDir'}/$server";      $uname = &unescape($uname);
     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",      $id = &unescape($id);
                                       Type    => SOCK_STREAM,      my (%instusers,%instids,$result,$response);
                                       Timeout => 10)      eval {
        or return "con_lost";          local($SIG{__DIE__})='DEFAULT';
     print $sclient "$cmd\n";          $result=&localenroll::get_userinfo($domain,$uname,$id,\%instusers,
     my $answer=<$sclient>;                                             \%instids);
     chomp($answer);      };
     if (!$answer) { $answer="con_lost"; }      if ($result eq 'ok') {
     return $answer;          if (keys(%instusers) > 0) {
               foreach my $key (keys(%instusers)) {
                   my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key});
                   $response .= &escape(&escape($key).'='.$usrstr).'&';
               }
           }
           $response=~s/\&$//;
       } else {
           $response = 'unavailable';
       }
       return $response;
 }  }
   
 sub reply {  sub get_multiple_instusers {
   my ($cmd,$server)=@_;      my ($domain,$data) = @_;
   my $answer;      my ($type,$users) = split(/=/,$data,2);
   if ($server ne $perlvar{'lonHostID'}) {       my $requested = &Apache::lonnet::thaw_unescape($users);
     $answer=subreply($cmd,$server);      my $response;
     if ($answer eq 'con_lost') {      if (ref($requested) eq 'HASH') {
  $answer=subreply("ping",$server);          my (%instusers,%instids,$result);
         $answer=subreply($cmd,$server);          eval {
               local($SIG{__DIE__})='DEFAULT';
               $result=&localenroll::get_multusersinfo($domain,$type,$requested,\%instusers,
                                                       \%instids);
           };
           if ($@) {
               $response = 'error';
           } elsif ($result eq 'ok') {
               if (keys(%instusers)) {
                   $response = $result.':'.&Apache::lonnet::freeze_escape(\%instusers); 
               }
           } else {
               $response = 'unavailable';
           }
       } else {
           $response = 'invalid';
     }      }
   } else {      return $response;
     $answer='self_reply';  
     $answer=subreply($cmd,$server);  
   }   
   return $answer;  
 }  }
   
 # -------------------------------------------------------- Escape Special Chars  ########################################################
   ########################################################
   
   =pod
   
   =item &do_sql_query
   
   Runs an sql metadata table query.
   
   Inputs: $query, $custom, $customshow
   
   Returns: A string containing escaped results.
   
   =cut
   
 sub escape {  ########################################################
     my $str=shift;  ########################################################
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  {
     return $str;      my @metalist;
   
   sub process_file {
       if ( -e $_ &&  # file exists
            -f $_ &&  # and is a normal file
            /\.meta$/ &&  # ends in meta
            ! /^.+\.\d+\.[^\.]+\.meta$/  # is not a previous version
            ) {
           push(@metalist,$File::Find::name);
       }
 }  }
   
 # ----------------------------------------------------- Un-Escape Special Chars  sub do_sql_query {
       my ($query,$custom,$customshow,$domainstr,$searchdomain) = @_;
   
   #
   # limit to searchdomain if given and table is metadata
   #
       if ($domainstr && ($query=~/FROM metadata/)) {
           my $havingstr;
           $domainstr = &unescape($domainstr); 
           if ($domainstr =~ /,/) {
               foreach my $dom (split(/,/,$domainstr)) {
                   if ($dom =~ /^$LONCAPA::domain_re$/) {
                       $havingstr .= 'domain="'.$dom.'" OR ';
                   }
               }
               $havingstr =~ s/ OR $//;
           } else {
               if ($domainstr =~ /^$LONCAPA::domain_re$/) {
                   $havingstr = 'domain="'.$domainstr.'"';
               }
           }
           if ($havingstr) {
               $query.=' HAVING ('.$havingstr.')';
           }
       } elsif (($searchdomain) && ($query=~/FROM metadata/)) {
    $query.=' HAVING (domain="'.$searchdomain.'")';
       }
   #    &logthis('doing query ('.$searchdomain.')'.$query);
   
   
   
 sub unescape {      $custom     = &unescape($custom);
     my $str=shift;      $customshow = &unescape($customshow);
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;      #
     return $str;      @metalist = ();
       #
       my $result = '';
       my @results = ();
       my @files;
       my $subsetflag=0;
       #
       if ($query) {
           #prepare and execute the query
           my $sth = $dbh->prepare($query);
           unless ($sth->execute()) {
               &logthis('<font color="blue">'.
                        'WARNING: Could not retrieve from database:'.
                        $sth->errstr().'</font>');
           } else {
               my $aref=$sth->fetchall_arrayref;
               foreach my $row (@$aref) {
                   push @files,@{$row}[3] if ($custom or $customshow);
                   my @b=map { &escape($_); } @$row;
                   push @results,join(",", @b);
                   # Build up the @files array with the LON-CAPA urls 
                   # of the resources.
               }
           }
       }
       # do custom metadata searching here and build into result
       return join("&",@results) if (! ($custom or $customshow));
       # Only get here if there is a custom query or custom show request
       &logthis("Doing custom query for $custom");
       if ($query) {
           @metalist=map {
               $perlvar{'lonDocRoot'}.$_.'.meta';
           } @files;
       } else {
           my $dir = "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}";
           @metalist=(); 
           opendir(RESOURCES,$dir);
           my @homeusers=grep {
               &ishome($dir.'/'.$_);
           } grep {!/^\.\.?$/} readdir(RESOURCES);
           closedir RESOURCES;
           # Define the
           foreach my $user (@homeusers) {
               find (\&process_file,$dir.'/'.$user);
           }
       } 
       # if file is indicated in sql database and
       #     not part of sql-relevant query, do not pattern match.
       #
       # if file is not in sql database, output error.
       #
       # if file is indicated in sql database and is
       #     part of query result list, then do the pattern match.
       my $customresult='';
       my @results;
       foreach my $metafile (@metalist) {
           open(my $fh,$metafile);
           my @lines=<$fh>;
           my $stuff=join('',@lines);
           if ($stuff=~/$custom/s) {
               foreach my $f ('abstract','author','copyright',
                              'creationdate','keywords','language',
                              'lastrevisiondate','mime','notes',
                              'owner','subject','title') {
                   $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s;
               }
               my $mfile=$metafile; 
               my $docroot=$perlvar{'lonDocRoot'};
               $mfile=~s/^$docroot//;
               $mfile=~s/\.meta$//;
               unless ($query) {
                   my $q2="SELECT * FROM metadata WHERE url ".
                       " LIKE BINARY '?'";
                   my $sth = $dbh->prepare($q2);
                   $sth->execute($mfile);
                   my $aref=$sth->fetchall_arrayref;
                   foreach my $a (@$aref) {
                       my @b=map { &escape($_)} @$a;
                       push @results,join(",", @b);
                   }
               }
               # &logthis("found: $stuff");
               $customresult.='&custom='.&escape($mfile).','.
                   escape($stuff);
           }
       }
       $result=join("&",@results) unless $query;
       $result.=$customresult;
       #
       return $result;
   } # End of &do_sql_query
   
   } # End of scoping curly braces for &process_file and &do_sql_query
   
   sub portfolio_table_update { 
       my ($query,$arg1,$arg2,$arg3) = @_;
       my %tablenames = (
                          'portfolio'   => 'portfolio_metadata',
                          'access'      => 'portfolio_access',
                          'addedfields' => 'portfolio_addedfields',
                        );
       my $result = 'ok';
       my $tablechk = &check_table($query);
       if ($tablechk == 0) {
           my $request =
      &LONCAPA::lonmetadata::create_metadata_storage($query,$query);
           $dbh->do($request);
           if ($dbh->err) {
               &logthis("create $query".
                        " ERROR: ".$dbh->errstr);
                        $result = 'error';
           }
       }
       if ($result eq 'ok') {
           my ($uname,$udom,$group) = split(/:/,&unescape($arg1));
           my $file_name = &unescape($arg2);
           my $action = $arg3;
           my $is_course = 0;
           if ($group ne '') {
               $is_course = 1;
           }
           my $urlstart = '/uploaded/'.$udom.'/'.$uname;
           my $pathstart = &propath($udom,$uname).'/userfiles';
           my ($fullpath,$url);
           if ($is_course) {
               $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.
                           $file_name;
               $url = $urlstart.'/groups/'.$group.'/portfolio'.$file_name;
           } else {
               $fullpath = $pathstart.'/portfolio'.$file_name;
               $url = $urlstart.'/portfolio'.$file_name;
           }
           if ($query eq 'portfolio_metadata') {
               if ($action eq 'delete') {
                   my %loghash = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef,\%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group,'update');
               } elsif (-e $fullpath.'.meta') {
                   my %loghash = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef,\%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group,'update');
                   if (keys(%loghash) > 0) {
                       &portfolio_logging(%loghash);
                   }
               }
           } elsif ($query eq 'portfolio_access') {
               my %access = &get_access_hash($uname,$udom,$group.$file_name);
               my %loghash =
        &LONCAPA::lonmetadata::process_portfolio_access_data($dbh,undef,
            \%tablenames,$url,$fullpath,\%access,'update');
               if (keys(%loghash) > 0) {
                   &portfolio_logging(%loghash);
               } else {
                   my $available = 0;
                   foreach my $key (keys(%access)) {
                       my ($num,$scope,$end,$start) =
                           ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
                       if ($scope eq 'public' || $scope eq 'guest') {
                           $available = 1;
                           last;
                       }
                   }
                   if ($available) {
                       # Retrieve current values
                       my $condition = 'url='.$dbh->quote("$url");
                       my ($error,$row) =
       &LONCAPA::lonmetadata::lookup_metadata($dbh,$condition,undef,
                                              'portfolio_metadata');
                       if (!$error) {
                           if (!(ref($row->[0]) eq 'ARRAY')) {  
                               my %loghash =
        &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef,
            \%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group);
                               if (keys(%loghash) > 0) {
                                   &portfolio_logging(%loghash);
                               }
                           } 
                       }
                   }
               }
           }
       }
       return $result;
 }  }
   
 # --------------------------------------- Is this the home server of an author?  sub get_access_hash {
 # (copied from lond, modification of the return value)      my ($uname,$udom,$file) = @_;
       my $hashref = &tie_user_hash($udom,$uname,'file_permissions',
                                    &GDBM_READER());
       my %curr_perms;
       my %access; 
       if ($hashref) {
           while (my ($key,$value) = each(%$hashref)) {
               $key = &unescape($key);
               next if ($key =~ /^error: 2 /);
               $curr_perms{$key}=&Apache::lonnet::thaw_unescape($value);
           }
           if (!&untie_user_hash($hashref)) {
               &logthis("error: ".($!+0)." untie (GDBM) Failed");
           }
       } else {
           &logthis("error: ".($!+0)." tie (GDBM) Failed");
       }
       if (keys(%curr_perms) > 0) {
           if (ref($curr_perms{$file."\0".'accesscontrol'}) eq 'HASH') {
               foreach my $acl (keys(%{$curr_perms{$file."\0".'accesscontrol'}})) {
                   $access{$acl} = $curr_perms{$file."\0".$acl};
               }
           }
       }
       return %access;
   }
   
   sub allusers_table_update {
       my ($query,$uname,$udom,$userdata) = @_;
       my %tablenames = (
                          'allusers'   => 'allusers',
                        );
       my $result = 'ok';
       my $tablechk = &check_table($query);
       if ($tablechk == 0) {
           my $request =
      &LONCAPA::lonmetadata::create_metadata_storage($query,$query);
           $dbh->do($request);
           if ($dbh->err) {
               &logthis("create $query".
                        " ERROR: ".$dbh->errstr);
                        $result = 'error';
           }
       }
       if ($result eq 'ok') {
           my %loghash = 
               &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
                   \%tablenames,$uname,$udom,$userdata,'update');
           foreach my $key (keys(%loghash)) {
               &logthis($loghash{$key});
           }
       }
       return $result;
   }
   
   ###########################################
   sub check_table {
       my ($table_id) = @_;
       my $sth=$dbh->prepare('SHOW TABLES');
       $sth->execute();
       my $aref = $sth->fetchall_arrayref;
       $sth->finish();
       if ($sth->err()) {
           &logthis("fetchall_arrayref after SHOW TABLES".
               " ERROR: ".$sth->errstr);
           return undef;
       }
       my $result = 0;
       foreach my $table (@{$aref}) {
           if ($table->[0] eq $table_id) { 
               $result = 1;
               last;
           }
       }
       return $result;
   }
   
   ###########################################
   
   sub portfolio_logging {
       my (%portlog) = @_;
       foreach my $key (keys(%portlog)) {
           if (ref($portlog{$key}) eq 'HASH') {
               foreach my $item (keys(%{$portlog{$key}})) {
                   &logthis($portlog{$key}{$item});
               }
           }
       }
   }
   
   
   ########################################################
   ########################################################
   
   =pod
   
   =item &logthis
   
   Inputs: $message, the message to log
   
   Returns: nothing
   
   Writes $message to the logfile.
   
   =cut
   
   ########################################################
   ########################################################
   sub logthis {
       my $message=shift;
       my $execdir=$perlvar{'lonDaemons'};
       open(my $fh,">>$execdir/logs/lonsql.log");
       my $now=time;
       my $local=localtime($now);
       print $fh "$local ($$): $message\n";
   }
   
   ########################################################
   ########################################################
   
   =pod
   
   =item &ishome
   
   Determine if the current machine is the home server for a user.
   The determination is made by checking the filesystem for the users information.
   
   Inputs: $author
   
   Returns: 0 - this is not the authors home server, 1 - this is.
   
   =cut
   
   ########################################################
   ########################################################
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
Line 460  sub ishome { Line 1042  sub ishome {
     }      }
 }  }
   
 # -------------------------------------------- Return path to profile directory  ########################################################
 # (copied from lond)  ########################################################
 sub propath {  
     my ($udom,$uname)=@_;  
     $udom=~s/\W//g;  
     $uname=~s/\W//g;  
     my $subdir=$uname.'__';  
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;  
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";  
     return $proname;  
 }   
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  =pod
   
 =head1 NAME  =item &courselog
   
 lonsql - LON TCP-MySQL-Server Daemon for handling database requests.  Inputs: $path, $command
   
 =head1 SYNOPSIS  Returns: unescaped string of values.
   
   =cut
   
   ########################################################
   ########################################################
   sub courselog {
       my ($path,$command)=@_;
       my %filters=();
       foreach (split(/\:/,&unescape($command))) {
    my ($name,$value)=split(/\=/,$_);
           $filters{$name}=$value;
       }
       my @results=();
       open(IN,$path.'/activity.log') or return ('file_error');
       while (my $line=<IN>) {
           chomp($line);
           my ($timestamp,$host,$log)=split(/\:/,$line);
   #
   # $log has the actual log entries; currently still escaped, and
   # %26(timestamp)%3a(url)%3a(user)%3a(domain)
   # then additionally
   # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value)
   # or
   # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
   #
   # get delimiter between timestamped entries to be &&&
           $log=~s/\%26(\d+)\%3a/\&\&\&$1\%3a/g;
   # now go over all log entries 
           foreach (split(/\&\&\&/,&unescape($log))) {
       my ($time,$res,$uname,$udom,$action,@values)=split(/\:/,$_);
               my $values=&unescape(join(':',@values));
               $values=~s/\&/\:/g;
               $res=&unescape($res);
               my $include=1;
               if (($filters{'username'}) && ($uname ne $filters{'username'})) 
                                                                  { $include=0; }
               if (($filters{'domain'}) && ($udom ne $filters{'domain'})) 
                                                                  { $include=0; }
               if (($filters{'url'}) && ($res!~/$filters{'url'}/)) 
                                                                  { $include=0; }
               if (($filters{'start'}) && ($time<$filters{'start'})) 
                                                                  { $include=0; }
               if (($filters{'end'}) && ($time>$filters{'end'})) 
                                                                  { $include=0; }
               if (($filters{'action'} eq 'view') && ($action)) 
                                                                  { $include=0; }
               if (($filters{'action'} eq 'submit') && ($action ne 'POST')) 
                                                                  { $include=0; }
               if (($filters{'action'} eq 'grade') && ($action ne 'CSTORE')) 
                                                                  { $include=0; }
               if ($include) {
          push(@results,($time<1000000000?'0':'').$time.':'.$res.':'.
                                               $uname.':'.$udom.':'.
                                               $action.':'.$values);
               }
          }
       }
       close IN;
       return join('&',sort(@results));
   }
   
   ########################################################
   ########################################################
   
   =pod
   
   =item &userlog
   
   Inputs: $path, $command
   
   Returns: unescaped string of values.
   
   =cut
   
   ########################################################
   ########################################################
   sub userlog {
       my ($path,$command)=@_;
       my %filters=();
       foreach (split(/\:/,&unescape($command))) {
    my ($name,$value)=split(/\=/,$_);
           $filters{$name}=$value;
       }
       my @results=();
       open(IN,$path.'/activity.log') or return ('file_error');
       while (my $line=<IN>) {
           chomp($line);
           my ($timestamp,$host,$log)=split(/\:/,$line);
           $log=&unescape($log);
           my $include=1;
           if (($filters{'start'}) && ($timestamp<$filters{'start'})) 
                                                                { $include=0; }
           if (($filters{'end'}) && ($timestamp>$filters{'end'})) 
                                                                { $include=0; }
           if (($filters{'action'} eq 'Role') && ($log !~/^Role/))
                                                                { $include=0; }
           if (($filters{'action'} eq 'log') && ($log!~/^Log/)) { $include=0; }
           if (($filters{'action'} eq 'check') && ($log!~/^Check/)) 
                                                                { $include=0; }
           if ($include) {
      push(@results,$timestamp.':'.$host.':'.&escape($log));
           }
       }
       close IN;
       return join('&',sort(@results));
   }
   
   ########################################################
   ########################################################
   
   =pod
   
   =item Functions required for forking
   
   =over 4
   
   =item REAPER
   
   REAPER takes care of dead children.
   
   =item HUNTSMAN
   
   Signal handler for SIGINT.
   
 This script should be run as user=www.  The following is an example invocation  =item HUPSMAN
 from the loncron script.  Note that a lonsql.pid file contains the pid of  
 the parent process.  
   
     if (-e $lonsqlfile) {  
  my $lfh=IO::File->new("$lonsqlfile");  
  my $lonsqlpid=<$lfh>;  
  chomp($lonsqlpid);  
  if (kill 0 => $lonsqlpid) {  
     print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>";  
     $restartflag=0;  
  } else {  
     $errors++; $errors++;  
     print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>";  
  $restartflag=1;  
  print $fh   
     "<h3>Decided to clean up stale .pid file and restart lonsql</h3>";  
  }  
     }  
     if ($restartflag==1) {  
  $errors++;  
          print $fh '<br><font color="red">Killall lonsql: '.  
                     system('killall lonsql').' - ';  
                     sleep 60;  
                     print $fh unlink($lonsqlfile).' - '.  
                               system('killall -9 lonsql').  
                     '</font><br>';  
  print $fh "<h3>lonsql not running, trying to start</h3>";  
  system(  
  "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");  
  sleep 10;  
   
 =head1 DESCRIPTION  
   
 Not yet written.  
   
 =head1 README  
   
 Not yet written.  
   
 =head1 PREREQUISITES  
   
 IO::Socket  
 Symbol  
 POSIX  
 IO::Select  
 IO::File  
 Socket  
 Fcntl  
 Tie::RefHash  
 DBI  
   
 =head1 COREQUISITES  
   
 =head1 OSNAMES  Signal handler for SIGHUP
   
   =item DISCONNECT
   
   Disconnects from database.
   
   =back
   
   =cut
   
   ########################################################
   ########################################################
   sub REAPER {                   # takes care of dead children
       $SIG{CHLD} = \&REAPER;
       my $pid = wait;
       $children --;
       &logthis("Child $pid died");
       delete $children{$pid};
   }
   
   sub HUNTSMAN {                      # signal handler for SIGINT
       local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
       kill 'INT' => keys %children;
       my $execdir=$perlvar{'lonDaemons'};
       unlink("$execdir/logs/lonsql.pid");
       &logthis("<font color='red'>CRITICAL: Shutting down</font>");
       $unixsock = "mysqlsock";
       my $port="$perlvar{'lonSockDir'}/$unixsock";
       unlink($port);
       exit;                           # clean up with dignity
   }
   
   sub HUPSMAN {                      # signal handler for SIGHUP
       local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
       kill 'INT' => keys %children;
       close($server);                # free up socket
       &logthis("<font color='red'>CRITICAL: Restarting</font>");
       my $execdir=$perlvar{'lonDaemons'};
       $unixsock = "mysqlsock";
       my $port="$perlvar{'lonSockDir'}/$unixsock";
       unlink($port);
       exec("$execdir/lonsql");         # here we go again
   }
   
   sub DISCONNECT {
       $dbh->disconnect or 
       &logthis("<font color='blue'>WARNING: Couldn't disconnect from database ".
                " $DBI::errstr : $@</font>");
       exit;
   }
   
 linux  
   
 =head1 SCRIPT CATEGORIES  =pod
   
 Server/Process  =back
   
 =cut  =cut
Removed from v.1.41  
changed lines
  Added in v.1.94

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.