Diff for /loncom/lonsql between versions 1.40 and 1.50

version 1.40, 2001/11/29 14:59:52 version 1.50, 2002/07/05 15:07:59
Line 3 Line 3
 # The LearningOnline Network  # The LearningOnline Network
 # lonsql - LON TCP-MySQL-Server Daemon for handling database requests.  # lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
 #  #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 # YEAR=2000  # YEAR=2000
 # lonsql-based on the preforker:harsha jagasia:date:5/10/00  # lonsql-based on the preforker:harsha jagasia:date:5/10/00
 # 7/25 Gerd Kortemeyer  # 7/25 Gerd Kortemeyer
Line 11 Line 35
 # many different dates Scott Harrison  # many different dates Scott Harrison
 # 03/22/2001 Scott Harrison  # 03/22/2001 Scott Harrison
 # 8/30 Gerd Kortemeyer  # 8/30 Gerd Kortemeyer
 # 10/17,11/28,11/29 Scott Harrison  # 10/17,11/28,11/29,12/20 Scott Harrison
   # YEAR=2001
   # 5/11 Scott Harrison
 #  #
 # $Id$  
 ###  ###
   
 ###############################################################################  ###############################################################################
Line 21 Line 46
 ## ORGANIZATION OF THIS PERL SCRIPT                                          ##  ## ORGANIZATION OF THIS PERL SCRIPT                                          ##
 ## 1. Modules used                                                           ##  ## 1. Modules used                                                           ##
 ## 2. Enable find subroutine                                                 ##  ## 2. Enable find subroutine                                                 ##
 ## 3. Read httpd access.conf and get variables                               ##  ## 3. Read httpd config files and get variables                              ##
 ## 4. Make sure that database can be accessed                                ##  ## 4. Make sure that database can be accessed                                ##
 ## 5. Make sure this process is running from user=www                        ##  ## 5. Make sure this process is running from user=www                        ##
 ## 6. Check if other instance is running                                     ##  ## 6. Check if other instance is running                                     ##
Line 29 Line 54
 ##                                                                           ##  ##                                                                           ##
 ###############################################################################  ###############################################################################
   
   use lib '/home/httpd/lib/perl/';
   use LONCAPA::Configuration;
   
 use IO::Socket;  use IO::Socket;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
Line 52  sub wanted { Line 80  sub wanted {
 $childmaxattempts=10;  $childmaxattempts=10;
 $run =0;#running counter to generate the query-id  $run =0;#running counter to generate the query-id
   
 # ------------------------------------ Read httpd access.conf and get variables  # -------------------------------- Read loncapa_apache.conf and loncapa.conf
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',
                                                    'loncapa.conf');
 while ($configline=<CONFIG>) {  my %perlvar=%{$perlvarref};
     if ($configline =~ /PerlSetVar/) {  
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
         chomp($varvalue);  
         $perlvar{$varname}=$varvalue;  
     }  
 }  
 close(CONFIG);  
   
 # ------------------------------------- Make sure that database can be accessed  # ------------------------------------- Make sure that database can be accessed
 {  {
Line 168  sub logthis { Line 189  sub logthis {
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "$local ($$): $message\n";      print $fh "$local ($$): $message\n";
 }  }
   
   # ------------------------------------------------------------------ Course log
   
   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 ($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));
   }
   
   # -------------------------------------------------------------------- User log
   
   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 ($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 'log') && ($log!~/^Log/)) { $include=0; }
           if (($filters{'action'} eq 'check') && ($log!~/^Check/)) 
                                                                { $include=0; }
           if ($include) {
      push(@results,$timestamp.':'.$log);
           }
       }
       close IN;
       return join('&',sort(@results));
   }
   
   
 # ---------------------------------------------------- Fork once and dissociate  # ---------------------------------------------------- Fork once and dissociate
 $fpid=fork;  $fpid=fork;
 exit if $fpid;  exit if $fpid;
Line 255  sub make_new_child { Line 367  sub make_new_child {
     my $userinput = <$client>;      my $userinput = <$client>;
     chomp($userinput);      chomp($userinput);
                   
     my ($conserver,$querytmp,      my ($conserver,$query,
  $customtmp,$customshowtmp)=split(/&/,$userinput);   $arg1,$arg2,$arg3)=split(/&/,$userinput);
     my $query=unescape($querytmp);      my $query=unescape($query);
     my $custom=unescape($customtmp);  
     my $customshow=unescape($customshowtmp);  
   
             #send query id which is pid_unixdatetime_runningcounter              #send query id which is pid_unixdatetime_runningcounter
     $queryid = $thisserver;      $queryid = $thisserver;
Line 268  sub make_new_child { Line 378  sub make_new_child {
     $queryid .= $run;      $queryid .= $run;
     print $client "$queryid\n";      print $client "$queryid\n";
           
     &logthis("QUERY: $query");      &logthis("QUERY: $query - $arg1 - $arg2 - $arg3");
     &logthis("QUERY: $query");  
     sleep 1;      sleep 1;
   
               my $result='';
   
   # ---------- At this point, query is received, query-ID assigned and sent back 
   # $query eq 'logquery' will mean that this is a query against log-files
   
   
      if (($query eq 'userlog') || ($query eq 'courselog')) {
   # ----------------------------------------------------- beginning of log query
   #
   # this goes against a user's log file
   #
          my $udom=&unescape($arg1);
          my $uname=&unescape($arg2);
                  my $command=&unescape($arg3);
                  my $path=&propath($udom,$uname);
                  if (-e "$path/activity.log") {
      if ($query eq 'userlog') {
                          $result=&userlog($path,$command);
                      } else {
                          $result=&courselog($path,$command);
                      }
                  } else {
      &logthis('Unable to do log query: '.$uname.'@'.$udom);
              $result='no_such_file';
          }
   # ------------------------------------------------------------ end of log query
             } else {
   # -------------------------------------------------------- This is an sql query
       my $custom=unescape($arg1);
       my $customshow=unescape($arg2);
             #prepare and execute the query              #prepare and execute the query
     my $sth = $dbh->prepare($query);      my $sth = $dbh->prepare($query);
     my $result;  
     my @files;      my @files;
     my $subsetflag=0;      my $subsetflag=0;
     if ($query) {      if ($query) {
Line 285  sub make_new_child { Line 425  sub make_new_child {
  else {   else {
     my $r1=$sth->fetchall_arrayref;      my $r1=$sth->fetchall_arrayref;
     my @r2;      my @r2;
     map {my $a=$_;       foreach (@$r1) {my $a=$_; 
  my @b=map {escape($_)} @$a;   my @b=map {escape($_)} @$a;
  push @files,@{$a}[3];   push @files,@{$a}[3];
  push @r2,join(",", @b)   push @r2,join(",", @b)
  } (@$r1);   }
     $result=join("&",@r2);      $result=join("&",@r2);
  }   }
     }      }
Line 337  sub make_new_child { Line 477  sub make_new_child {
     my $sth = $dbh->prepare($q2);      my $sth = $dbh->prepare($q2);
     $sth->execute();      $sth->execute();
     my $r1=$sth->fetchall_arrayref;      my $r1=$sth->fetchall_arrayref;
     map {my $a=$_;       foreach (@$r1) {my $a=$_; 
  my @b=map {escape($_)} @$a;   my @b=map {escape($_)} @$a;
  push @files,@{$a}[3];   push @files,@{$a}[3];
  push @r2,join(",", @b)   push @r2,join(",", @b)
  } (@$r1);   }
  }   }
 # &logthis("found: $stuff");  # &logthis("found: $stuff");
  $customresult.='&custom='.escape($m2).','.escape($stuff);   $customresult.='&custom='.escape($m2).','.escape($stuff);
Line 350  sub make_new_child { Line 490  sub make_new_child {
  $result=join("&",@r2) unless $query;   $result=join("&",@r2) unless $query;
  $result.=$customresult;   $result.=$customresult;
     }      }
     # reply with result  # ------------------------------------------------------------ end of sql query
     $result.="\n" if $result;     }
   
               # result does not need to be escaped because it has already been
               # escaped.
               #$result=&escape($result);
   
       # reply with result, append \n unless already there
   
       $result.="\n" unless ($result=~/\n$/);
             &reply("queryreply:$queryid:$result",$conserver);              &reply("queryreply:$queryid:$result",$conserver);
   
         }          }
Line 491  the parent process. Line 639  the parent process.
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 LON TCP-MySQL-Server Daemon for handling database requests.  Not yet written.
   
 =head1 README  =head1 README
   
 LON TCP-MySQL-Server Daemon for handling database requests.  Not yet written.
   
 =head1 PREREQUISITES  =head1 PREREQUISITES
   

Removed from v.1.40  
changed lines
  Added in v.1.50


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.