--- loncom/lonsql 2001/03/27 02:09:50 1.18 +++ loncom/lonsql 2002/06/17 20:25:51 1.45 @@ -1,8 +1,62 @@ #!/usr/bin/perl + +# The LearningOnline Network +# lonsql - LON TCP-MySQL-Server Daemon for handling database requests. +# +# $Id: lonsql,v 1.45 2002/06/17 20:25:51 www 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; use POSIX; @@ -19,25 +73,35 @@ require "find.pl"; sub wanted { (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && -f _ && - /^.*\.meta$/ && + /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ && push(@metalist,"$dir/$_"); } - $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"; +# -------------------------------- Read loncapa_apache.conf and loncapa.conf +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf', + 'loncapa.conf'); +my %perlvar=%{$perlvarref}; -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; +# ------------------------------------- Make sure that database can be accessed +{ + 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; } } -close(CONFIG); # --------------------------------------------- Check if other instance running @@ -60,13 +124,14 @@ while ($configline=) { chomp($ip); $hostip{$ip}=$id; - if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } $PREFORK++; } close(CONFIG); +$PREFORK=int($PREFORK/4); + $unixsock = "mysqlsock"; my $localfile="$perlvar{'lonSockDir'}/$unixsock"; my $server; @@ -124,6 +189,36 @@ sub logthis { my $local=localtime($now); print $fh "$local ($$): $message\n"; } + + + +# -------------------------------------------- Return path to profile directory + +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; +} + +# ------------------------------------------------------------------ Course log + +sub courselog { + my ($path,$command)=@_; + return 'not_yet_implemented'; +} + +# -------------------------------------------------------------------- User log + +sub userlog { + my ($path,$command)=@_; + return 'not_yet_implemented'; +} + + # ---------------------------------------------------- Fork once and dissociate $fpid=fork; exit if $fpid; @@ -191,12 +286,11 @@ sub make_new_child { #open database handle # making dbh global to avoid garbage collector unless ( - $dbh = DBI->connect("DBI:mysql:loncapa","www","123",{ RaiseError =>0,PrintError=>0}) + $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) ) { - my $st=120+int(rand(240)); + sleep(10+int(rand(20))); &logthis("WARNING: Couldn't connect to database ($st secs): $@"); print "database handle error\n"; - sleep($st); exit; }; @@ -212,9 +306,9 @@ sub make_new_child { my $userinput = <$client>; chomp($userinput); - my ($conserver,$querytmp,$customtmp)=split(/&/,$userinput); - my $query=unescape($querytmp); - my $custom=unescape($customtmp); + my ($conserver,$query, + $arg1,$arg2,$arg3)=split(/&/,$userinput); + my $query=unescape($query); #send query id which is pid_unixdatetime_runningcounter $queryid = $thisserver; @@ -223,32 +317,86 @@ sub make_new_child { $queryid .= $run; print $client "$queryid\n"; + &logthis("QUERY: $query"); + 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; - unless ($sth->execute()) - { - &logthis("WARNING: Could not retrieve from database: $@"); - $result=""; - } - else { - my $r1=$sth->fetchall_arrayref; - my @r2; map {my $a=$_; my @b=map {escape($_)} @$a; push @r2,join(",", @b)} (@$r1); - $result=join("&",@r2); - } + my @files; + my $subsetflag=0; + if ($query) { + unless ($sth->execute()) + { + &logthis("WARNING: Could not retrieve from database: $@"); + $result=""; + } + else { + my $r1=$sth->fetchall_arrayref; + my @r2; + foreach (@$r1) {my $a=$_; + my @b=map {escape($_)} @$a; + push @files,@{$a}[3]; + push @r2,join(",", @b) + } + $result=join("&",@r2); + } + } # do custom metadata searching here and build into result - if ($custom) { + if ($custom or $customshow) { &logthis("am going to do custom query for $custom"); - @metalist=(); pop @metalist; - &find("$perlvar{'lonDocRoot'}/res"); - &logthis("FILELIST:" . join(":::",@metalist)); + if ($query) { + @metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files; + } + else { + @metalist=(); pop @metalist; + opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}"); + my @homeusers=grep + {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")} + grep {!/^\.\.?$/} readdir(RESOURCES); + closedir RESOURCES; + foreach my $user (@homeusers) { + &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); + } + } +# &logthis("FILELIST:" . join(":::",@metalist)); # 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 @r2; foreach my $m (@metalist) { my $fh=IO::File->new($m); my @lines=<$fh>; @@ -258,16 +406,34 @@ sub make_new_child { 'creationdate','keywords','language', 'lastrevisiondate','mime','notes', 'owner','subject','title') { - $stuff=~s/\<$f[^\>]*\>.*?<\/$f[^\>]*\>//; + $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s; } - &logthis("found: $stuff"); - $customresult.='&custom='.escape($stuff); + my $m2=$m; my $docroot=$perlvar{'lonDocRoot'}; + $m2=~s/^$docroot//; + $m2=~s/\.meta$//; + unless ($query) { + my $q2="select * from metadata where url like binary '$m2'"; + my $sth = $dbh->prepare($q2); + $sth->execute(); + my $r1=$sth->fetchall_arrayref; + foreach (@$r1) {my $a=$_; + my @b=map {escape($_)} @$a; + push @files,@{$a}[3]; + push @r2,join(",", @b) + } + } +# &logthis("found: $stuff"); + $customresult.='&custom='.escape($m2).','.escape($stuff); } } + $result=join("&",@r2) unless $query; $result.=$customresult; } - # reply with result - $result.="\n" if $result; +# ------------------------------------------------------------ end of sql query + } + # reply with result, append \n unless already there + + $result.="\n" unless ($result=~/\n$/); &reply("queryreply:$queryid:$result",$conserver); } @@ -318,6 +484,7 @@ sub reply { } } else { $answer='self_reply'; + $answer=subreply($cmd,$server); } return $answer; } @@ -337,3 +504,101 @@ sub unescape { $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; return $str; } + +# --------------------------------------- Is this the home server of an author? +# (copied from lond, modification of the return value) +sub ishome { + my $author=shift; + $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + my ($udom,$uname)=split(/\//,$author); + my $proname=propath($udom,$uname); + if (-e $proname) { + return 1; + } else { + return 0; + } +} + +# -------------------------------------------- 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) + +=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