--- nsdl/lonsql 2005/11/29 21:02:52 1.10 +++ nsdl/lonsql 2006/07/28 17:55:18 1.11 @@ -1,9 +1,9 @@ #!/usr/bin/perl # The LearningOnline Network -# lonsql - LON TCP-NSDL Query Handler. +# lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.10 2005/11/29 21:02:52 www Exp $ +# $Id: lonsql,v 1.11 2006/07/28 17:55:18 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -102,6 +102,7 @@ the database. use strict; use lib '/home/httpd/lib/perl/'; +use LONCAPA; use LONCAPA::Configuration; use LONCAPA::lonmetadata(); @@ -113,13 +114,36 @@ use IO::File; use Socket; use Fcntl; use Tie::RefHash; -use HTML::LCParser(); -use LWP::UserAgent(); -use HTTP::Headers; -use HTTP::Date; +use DBI; use File::Find; use localenroll; +# FOR NSDL + + use HTML::LCParser(); + use LWP::UserAgent(); + use HTTP::Headers; + use HTTP::Date; + +######################################################## +######################################################## + +=pod + +=item Global Variables + +=over 4 + +=item dbh + +=back + +=cut + +######################################################## +######################################################## +my $dbh; + ######################################################## ######################################################## @@ -207,6 +231,29 @@ ENDMYCNF # +# 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"; + my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + 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; +} + +# # Check if other instance running # my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid"; @@ -221,12 +268,14 @@ if (-e $pidfile) { # Read hosts file # my $thisserver; +my %hostname; 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)=split(/:/,$configline); $name=~s/\s//g; $thisserver=$name if ($id eq $perlvar{'lonHostID'}); + $hostname{$id}=$name; #$PREFORK++; } close(CONFIG); @@ -325,7 +374,20 @@ sub make_new_child { # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; - + #open database handle + # making dbh global to avoid garbage collector + unless ($dbh = DBI->connect("DBI:mysql:loncapa","www", + $perlvar{'lonSqlAccess'}, + { RaiseError =>0,PrintError=>0})) { + sleep(10+int(rand(20))); + &logthis("WARNING: Couldn't connect to database". + ": $@"); + # "($st secs): $@"); + print "database handle error\n"; + exit; + } + # make sure that a database disconnection occurs with + # ending kill signals $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT; # handle connections until we've reached $MAX_CLIENTS_PER_CHILD for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { @@ -334,6 +396,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); @@ -371,7 +435,8 @@ sub make_new_child { $result='no_such_file'; } # end of log query - } elsif ($query eq 'fetchenrollment') { + } elsif (($query eq 'fetchenrollment') || + ($query eq 'institutionalphotos')) { # retrieve institutional class lists my $dom = &unescape($arg1); my %affiliates = (); @@ -383,7 +448,18 @@ sub make_new_child { @{$affiliates{$1}} = split/,/,$2; } } - $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies); + 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)); @@ -404,7 +480,7 @@ sub make_new_child { } } else { # Do an sql query - $result = &nsdl_query($query,$arg1,$arg2); + $result = &nsdl_query($query,$arg1,$arg2,$searchdomain); } # result does not need to be escaped because it has already been # escaped. @@ -413,13 +489,96 @@ sub make_new_child { } # tidy up gracefully and finish # - + # close the database handle + $dbh->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 # process death. exit; } } + + +######################################################## +######################################################## + +# +# Takes SQL query +# sends it to NSDL +# + +sub nsdl_query { + my $query=shift; + my ($keyword)=($query=~/\"\%([^\%]+)\%\"/); + $keyword=&escape($keyword); + my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword; + my $ua=new LWP::UserAgent; + my $response=$ua->get($url); + my $parser=HTML::LCParser->new(\$response->content); + my $is=''; + my $cont=''; + my $token; + my %result=(); + my $allresults=''; + while ($token=$parser->get_token) { + if ($token->[0] eq 'T') { + $cont.=$token->[1]; + } elsif ($token->[0] eq 'S') { + if ($token->[1] eq 'record') { + %result=(); + } elsif ($token->[1]=~/^dc\:/) { + $is=$token->[1]; + $cont=''; + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'record') { +# +# Now store it away +# + my $url=$result{'dc:identifier'}; + if ($url=~/^http\:/) { + $url=~s/^http:\//\/ext/; + } else { + $url=''; + } + if ($url) { + my ($mime)=($url=~/\.(\w+)$/); + $mime=~tr/A-Z/a-z/; + my $createdate=$result{'dc:date'}; + if ($createdate) { + unless ($createdate=~/\:\d+$/) { + $createdate.=' 00:00:00'; + } + } + unless ($createdate=~/^\d+\-\d+\-\d+\s+\d+\:\d+\:\d+$/) { + $createdate=''; + } + $createdate=&escape($createdate); + + $allresults.='&'. + &escape($result{'dc:title'}).','. + &escape($result{'dc:creator'}).','. + &escape($result{'dc:subject'}).','. + &escape($url).',,,,'. + &escape($result{'dc:description'}).','. + &escape($mime).',seniso,'.$createdate.','.$createdate.','.&escape('public@nsdl'). + ',public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,'; + } + %result=(); + } elsif ($token->[1]=~/^dc\:/) { + $result{$is}=$cont; + } + } + } + $allresults=~s/^\&//; + + return $allresults; +} + + +######################################################## ######################################################## =pod @@ -466,12 +625,12 @@ Returns: The results of the message or ' ######################################################## sub subreply { my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; + my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server}; my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; + print $sclient "sethost:$server:$cmd\n"; my $answer=<$sclient>; chomp($answer); $answer="con_lost" if (!$answer); @@ -516,52 +675,6 @@ sub reply { =pod -=item &escape - -Escape special characters in a string. - -Inputs: string to escape - -Returns: The input string with special characters escaped. - -=cut - -######################################################## -######################################################## -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; -} - -######################################################## -######################################################## - -=pod - -=item &unescape - -Unescape special characters in a string. - -Inputs: string to unescape - -Returns: The input string with special characters unescaped. - -=cut - -######################################################## -######################################################## -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; -} - -######################################################## -######################################################## - -=pod - =item &ishome Determine if the current machine is the home server for a user. @@ -790,79 +903,14 @@ sub HUPSMAN { # sig exec("$execdir/lonsql"); # here we go again } -# -# Takes SQL query -# sends it to NSDL -# - -sub nsdl_query { - my $query=shift; - my ($keyword)=($query=~/\"\%([^\%]+)\%\"/); - $keyword=&escape($keyword); - my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword; - my $ua=new LWP::UserAgent; - my $response=$ua->get($url); - my $parser=HTML::LCParser->new(\$response->content); - my $is=''; - my $cont=''; - my $token; - my %result=(); - my $allresults=''; - while ($token=$parser->get_token) { - if ($token->[0] eq 'T') { - $cont.=$token->[1]; - } elsif ($token->[0] eq 'S') { - if ($token->[1] eq 'record') { - %result=(); - } elsif ($token->[1]=~/^dc\:/) { - $is=$token->[1]; - $cont=''; - } - } elsif ($token->[0] eq 'E') { - if ($token->[1] eq 'record') { -# -# Now store it away -# - my $url=$result{'dc:identifier'}; - if ($url=~/^http\:/) { - $url=~s/^http:\//\/ext/; - } else { - $url=''; - } - if ($url) { - my ($mime)=($url=~/\.(\w+)$/); - $mime=~tr/A-Z/a-z/; - my $createdate=$result{'dc:date'}; - if ($createdate) { - unless ($createdate=~/\:\d+$/) { - $createdate.=' 00:00:00'; - } - } - unless ($createdate=~/^\d+\-\d+\-\d+\s+\d+\:\d+\:\d+$/) { - $createdate=''; - } - $createdate=&escape($createdate); - - $allresults.='&'. - &escape($result{'dc:title'}).','. - &escape($result{'dc:creator'}).','. - &escape($result{'dc:subject'}).','. - &escape($url).',,,,'. - &escape($result{'dc:description'}).','. - &escape($mime).',seniso,'.$createdate.','.$createdate.','.&escape('public@nsdl'). - ',public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,'; - } - %result=(); - } elsif ($token->[1]=~/^dc\:/) { - $result{$is}=$cont; - } - } - } - $allresults=~s/^\&//; - - return $allresults; +sub DISCONNECT { + $dbh->disconnect or + &logthis("WARNING: Couldn't disconnect from database ". + " $DBI::errstr : $@"); + exit; } + =pod =back