--- loncom/lonsql 2003/07/25 17:07:06 1.56 +++ loncom/lonsql 2006/03/27 19:51:42 1.71.2.2 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.56 2003/07/25 17:07:06 bowersj2 Exp $ +# $Id: lonsql,v 1.71.2.2 2006/03/27 19:51:42 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,42 +41,6 @@ Note that a lonsql.pid file contains the =head1 OVERVIEW -The SQL database in LON-CAPA is used for catalog searches against -resource metadata only. The authoritative version of the resource -metadata is an XML-file on the normal file system (same file name as -resource plus ".meta"). The SQL-database is a cache of these files, -and can be reconstructed from the XML files at any time. - -The current database is implemented assuming a non-adjustable -architecture involving these data fields (specific to each version of -a resource). - -=over 4 - -=item * title - -=item * author - -=item * subject - -=item * notes - -=item * abstract - -=item * mime - -=item * language - -=item * creationdate - -=item * lastrevisiondate - -=item * owner - -=item * copyright - -=back - =head2 Purpose within LON-CAPA LON-CAPA is meant to distribute A LOT of educational content to A LOT @@ -139,6 +103,7 @@ use strict; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; +use LONCAPA::lonmetadata(); use IO::Socket; use Symbol; @@ -150,6 +115,7 @@ use Fcntl; use Tie::RefHash; use DBI; use File::Find; +use localenroll; ######################################################## ######################################################## @@ -240,6 +206,23 @@ my $run =0; # running count my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); my %perlvar=%{$perlvarref}; # +# 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"; + } +} + + +# # Make sure that database can be accessed # my $dbh; @@ -251,8 +234,14 @@ unless ($dbh = DBI->connect("DBI:mysql:l my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!"; system("echo 'Cannot connect to MySQL database!' |". " mailto $emailto -s '$subj' > /dev/null"); + + open(SMP,'>/home/httpd/html/lon-status/mysql.txt'); + print SMP 'time='.time.'&mysql=defunct'."\n"; + close(SMP); + exit 1; } else { + unlink('/home/httpd/html/lon-status/mysql.txt'); $dbh->disconnect; } @@ -270,20 +259,18 @@ if (-e $pidfile) { # # Read hosts file # -my %hostip; my $thisserver; my $PREFORK=4; # number of children to maintain, at least four spare open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; while (my $configline=) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); - $hostip{$ip}=$id; + my ($id,$domain,$role,$name)=split(/:/,$configline); + $name=~s/\s//g; $thisserver=$name if ($id eq $perlvar{'lonHostID'}); - $PREFORK++; + #$PREFORK++; } close(CONFIG); # -$PREFORK=int($PREFORK/4); +#$PREFORK=int($PREFORK/4); # # Create a socket to talk to lond @@ -312,7 +299,7 @@ my $execdir=$perlvar{'lonDaemons'}; open (PIDSAVE,">$execdir/logs/lonsql.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); -&logthis("CRITICAL: ---------- Starting ----------"); +&logthis("CRITICAL: ---------- Starting ----------"); # # Ignore signals generated during initial startup @@ -383,7 +370,7 @@ sub make_new_child { $perlvar{'lonSqlAccess'}, { RaiseError =>0,PrintError=>0})) { sleep(10+int(rand(20))); - &logthis("WARNING: Couldn't connect to database". + &logthis("WARNING: Couldn't connect to database". ": $@"); # "($st secs): $@"); print "database handle error\n"; @@ -399,6 +386,8 @@ sub make_new_child { $run = $run+1; my $userinput = <$client>; chomp($userinput); + $userinput=~s/\:(\w+)$//; + my $searchdomain=$1; # my ($conserver,$query, $arg1,$arg2,$arg3)=split(/&/,$userinput); @@ -411,7 +400,7 @@ sub make_new_child { $queryid .= $run; print $client "$queryid\n"; # - &logthis("QUERY: $query - $arg1 - $arg2 - $arg3"); + # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3"); sleep 1; # my $result=''; @@ -436,22 +425,63 @@ sub make_new_child { $result='no_such_file'; } # end of log query + } elsif (($query eq 'fetchenrollment') || + ($query eq 'institutionalphotos')) { + # retrieve institutional class lists + my $dom = &unescape($arg1); + my %affiliates = (); + my %replies = (); + my $locresult = ''; + my $querystr = &unescape($arg3); + foreach (split/%%/,$querystr) { + if (/^([^=]+)=([^=]+)$/) { + @{$affiliates{$1}} = split/,/,$2; + } + } + 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'; + } + } + $result = &escape($locresult.':'); + if ($locresult) { + $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies)); + } + } elsif ($query eq 'prepare activity log') { + my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2); + &logthis('preparing activity log tables for '.$cid); + my $command = + qq{$perlvar{'lonDaemons'}/parse_activity_log.pl -course=$cid -domain=$domain}; + system($command); + &logthis($command); + my $returnvalue = $?>>8; + if ($returnvalue) { + $result = 'error: parse_activity_log.pl returned '. + $returnvalue; + } else { + $result = 'success'; + } } else { # Do an sql query - $result = &do_sql_query($query,$arg1,$arg2); + $result = &do_sql_query($query,$arg1,$arg2,$searchdomain); } # 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); } # tidy up gracefully and finish # # close the database handle $dbh->disconnect - or &logthis("WARNING: Couldn't disconnect". + or &logthis("WARNING: Couldn't disconnect". " from database $DBI::errstr : $@"); # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into @@ -491,7 +521,18 @@ sub process_file { } sub do_sql_query { - my ($query,$custom,$customshow) = @_; + my ($query,$custom,$customshow,$searchdomain) = @_; + +# +# limit to searchdomain if given and table is metadata +# + if (($searchdomain) && ($query=~/FROM metadata/)) { + $query.=' HAVING (domain="'.$searchdomain.'")'; + } +# &logthis('doing query ('.$searchdomain.')'.$query); + + + $custom = &unescape($custom); $customshow = &unescape($customshow); # @@ -506,8 +547,9 @@ sub do_sql_query { #prepare and execute the query my $sth = $dbh->prepare($query); unless ($sth->execute()) { - &logthis("WARNING: ". - "Could not retrieve from database: $@"); + &logthis(''. + 'WARNING: Could not retrieve from database:'. + $sth->errstr().''); } else { my $aref=$sth->fetchall_arrayref; foreach my $row (@$aref) { @@ -939,7 +981,7 @@ sub HUNTSMAN { # si kill 'INT' => keys %children; my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonsql.pid"); - &logthis("CRITICAL: Shutting down"); + &logthis("CRITICAL: Shutting down"); $unixsock = "mysqlsock"; my $port="$perlvar{'lonSockDir'}/$unixsock"; unlink($port); @@ -950,7 +992,7 @@ sub HUPSMAN { # sig local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; close($server); # free up socket - &logthis("CRITICAL: Restarting"); + &logthis("CRITICAL: Restarting"); my $execdir=$perlvar{'lonDaemons'}; $unixsock = "mysqlsock"; my $port="$perlvar{'lonSockDir'}/$unixsock"; @@ -960,23 +1002,12 @@ sub HUPSMAN { # sig sub DISCONNECT { $dbh->disconnect or - &logthis("WARNING: Couldn't disconnect from database ". + &logthis("WARNING: Couldn't disconnect from database ". " $DBI::errstr : $@"); exit; } - - - - - - - - - -# ----------------------------------- POD (plain old documentation, CPAN style) - =pod =back 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.