--- loncom/lonsql 2001/11/28 21:49:27 1.38 +++ loncom/lonsql 2002/07/05 15:07:59 1.50 @@ -1,9 +1,61 @@ #!/usr/bin/perl + +# The LearningOnline Network +# lonsql - LON TCP-MySQL-Server Daemon for handling database requests. +# +# $Id: lonsql,v 1.50 2002/07/05 15:07:59 matthew Exp $ +# +# 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 # lonsql-based on the preforker:harsha jagasia:date:5/10/00 # 7/25 Gerd Kortemeyer # many different dates Scott Harrison +# YEAR=2001 +# many different dates Scott Harrison # 03/22/2001 Scott Harrison # 8/30 Gerd Kortemeyer +# 10/17,11/28,11/29,12/20 Scott Harrison +# YEAR=2001 +# 5/11 Scott Harrison +# +### + +############################################################################### +## ## +## ORGANIZATION OF THIS PERL SCRIPT ## +## 1. Modules used ## +## 2. Enable find subroutine ## +## 3. Read httpd config files and get variables ## +## 4. Make sure that database can be accessed ## +## 5. Make sure this process is running from user=www ## +## 6. Check if other instance is running ## +## 7. POD (plain old documentation, CPAN style) ## +## ## +############################################################################### + +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; use IO::Socket; use Symbol; @@ -28,17 +80,10 @@ sub wanted { $childmaxattempts=10; $run =0;#running counter to generate the query-id -# ------------------------------------ Read httpd access.conf and get variables -open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; - -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } -} -close(CONFIG); +# -------------------------------- Read loncapa_apache.conf and loncapa.conf +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf', + 'loncapa.conf'); +my %perlvar=%{$perlvarref}; # ------------------------------------- Make sure that database can be accessed { @@ -144,6 +189,97 @@ sub logthis { my $local=localtime($now); 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=) { + 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=) { + 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 $fpid=fork; exit if $fpid; @@ -231,11 +367,9 @@ sub make_new_child { my $userinput = <$client>; chomp($userinput); - my ($conserver,$querytmp, - $customtmp,$customshowtmp)=split(/&/,$userinput); - my $query=unescape($querytmp); - my $custom=unescape($customtmp); - my $customshow=unescape($customshowtmp); + my ($conserver,$query, + $arg1,$arg2,$arg3)=split(/&/,$userinput); + my $query=unescape($query); #send query id which is pid_unixdatetime_runningcounter $queryid = $thisserver; @@ -244,12 +378,42 @@ sub make_new_child { $queryid .= $run; print $client "$queryid\n"; - &logthis("QUERY: $query"); - &logthis("QUERY: $query"); + &logthis("QUERY: $query - $arg1 - $arg2 - $arg3"); 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 my $sth = $dbh->prepare($query); - my $result; + my @files; my $subsetflag=0; if ($query) { @@ -261,11 +425,11 @@ sub make_new_child { else { my $r1=$sth->fetchall_arrayref; my @r2; - map {my $a=$_; + foreach (@$r1) {my $a=$_; my @b=map {escape($_)} @$a; push @files,@{$a}[3]; push @r2,join(",", @b) - } (@$r1); + } $result=join("&",@r2); } } @@ -313,11 +477,11 @@ sub make_new_child { my $sth = $dbh->prepare($q2); $sth->execute(); my $r1=$sth->fetchall_arrayref; - map {my $a=$_; + foreach (@$r1) {my $a=$_; my @b=map {escape($_)} @$a; push @files,@{$a}[3]; push @r2,join(",", @b) - } (@$r1); + } } # &logthis("found: $stuff"); $customresult.='&custom='.escape($m2).','.escape($stuff); @@ -326,8 +490,16 @@ sub make_new_child { $result=join("&",@r2) unless $query; $result.=$customresult; } - # reply with result - $result.="\n" if $result; +# ------------------------------------------------------------ end of sql query + } + + # 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); } @@ -424,3 +596,75 @@ sub propath { my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; return $proname; } + +# ----------------------------------- POD (plain old documentation, CPAN style) + +=head1 NAME + +lonsql - LON TCP-MySQL-Server Daemon for handling database requests. + +=head1 SYNOPSIS + +This script should be run as user=www. The following is an example invocation +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 "

lonsql at pid $lonsqlpid responding

"; + $restartflag=0; + } else { + $errors++; $errors++; + print $fh "

lonsql at pid $lonsqlpid not responding

"; + $restartflag=1; + print $fh + "

Decided to clean up stale .pid file and restart lonsql

"; + } + } + if ($restartflag==1) { + $errors++; + print $fh '
Killall lonsql: '. + system('killall lonsql').' - '; + sleep 60; + print $fh unlink($lonsqlfile).' - '. + system('killall -9 lonsql'). + '
'; + print $fh "

lonsql not running, trying to start

"; + 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 + +linux + +=head1 SCRIPT CATEGORIES + +Server/Process + +=cut