--- loncom/lonsql 2001/04/16 18:36:22 1.33 +++ loncom/lonsql 2002/05/11 21:26:53 1.42 @@ -1,8 +1,62 @@ #!/usr/bin/perl + +# The LearningOnline Network +# lonsql - LON TCP-MySQL-Server Daemon for handling database requests. +# +# $Id: lonsql,v 1.42 2002/05/11 21:26:53 harris41 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 access.conf 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,24 +73,16 @@ 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"; - -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } -} -close(CONFIG); +# ------------------------------------------- Read access.conf and loncapa.conf +my $perlvarref=LONCAPA::Configuration::read_conf('access.conf','loncapa.conf'); +my %perlvar=%{$perlvarref}; # ------------------------------------- Make sure that database can be accessed { @@ -45,7 +91,11 @@ close(CONFIG); $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) ) { print "Cannot connect to database!\n"; - exit; + $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; @@ -79,6 +129,8 @@ while ($configline=) { } close(CONFIG); +$PREFORK=int($PREFORK/4); + $unixsock = "mysqlsock"; my $localfile="$perlvar{'lonSockDir'}/$unixsock"; my $server; @@ -253,11 +305,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); } } @@ -269,7 +321,14 @@ sub make_new_child { } else { @metalist=(); pop @metalist; - &find("$perlvar{'lonDocRoot'}/res"); + 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 @@ -288,21 +347,21 @@ sub make_new_child { 'creationdate','keywords','language', 'lastrevisiondate','mime','notes', 'owner','subject','title') { - $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//; + $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s; } my $m2=$m; my $docroot=$perlvar{'lonDocRoot'}; $m2=~s/^$docroot//; $m2=~s/\.meta$//; unless ($query) { - my $q2="select * from metadata where url like '$m2'"; + my $q2="select * from metadata where url like binary '$m2'"; 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); @@ -383,3 +442,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