--- loncom/lonsql 2004/05/20 14:15:29 1.61 +++ loncom/lonsql 2007/08/25 13:45:56 1.85 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.61 2004/05/20 14:15:29 matthew Exp $ +# $Id: lonsql,v 1.85 2007/08/25 13:45:56 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -102,19 +102,19 @@ the database. use strict; use lib '/home/httpd/lib/perl/'; +use LONCAPA; use LONCAPA::Configuration; use LONCAPA::lonmetadata(); +use Apache::lonnet; use IO::Socket; use Symbol; use POSIX; use IO::Select; -use IO::File; -use Socket; -use Fcntl; -use Tie::RefHash; use DBI; use File::Find; +use localenroll; +use GDBM_File; ######################################################## ######################################################## @@ -202,8 +202,24 @@ my $run =0; # running count # # Read loncapa_apache.conf and loncapa.conf # -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar=%{$perlvarref}; +my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')}; +# +# 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 # @@ -223,6 +239,7 @@ unless ($dbh = DBI->connect("DBI:mysql:l exit 1; } else { + unlink('/home/httpd/html/lon-status/mysql.txt'); $dbh->disconnect; } @@ -231,29 +248,15 @@ unless ($dbh = DBI->connect("DBI:mysql:l # my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid"; if (-e $pidfile) { - my $lfh=IO::File->new("$pidfile"); + open(my $lfh,"$pidfile"); my $pide=<$lfh>; chomp($pide); if (kill 0 => $pide) { die "already running"; } } -# -# 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; - $thisserver=$name if ($id eq $perlvar{'lonHostID'}); - $PREFORK++; -} -close(CONFIG); # -$PREFORK=int($PREFORK/4); +#$PREFORK=int($PREFORK/4); # # Create a socket to talk to lond @@ -369,20 +372,22 @@ sub make_new_child { $run = $run+1; my $userinput = <$client>; chomp($userinput); + $userinput=~s/\:($LONCAPA::domain_re)$//; + my $searchdomain=$1; # my ($conserver,$query, $arg1,$arg2,$arg3)=split(/&/,$userinput); my $query=unescape($query); # #send query id which is pid_unixdatetime_runningcounter - my $queryid = $thisserver; + my $queryid = &Apache::lonnet::hostname($perlvar{'lonHostID'}); $queryid .="_".($$)."_"; $queryid .= time."_"; $queryid .= $run; print $client "$queryid\n"; # - # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3"); - sleep 1; + # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid"); + # sleep 1; # my $result=''; # @@ -401,19 +406,133 @@ sub make_new_child { } else { $result=&courselog($path,$command); } + $result = &escape($result); } else { &logthis('Unable to do log query: '.$uname.'@'.$udom); $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 'usersearch') { + my $srchdomain = &unescape($arg1); + my @items = split(/%%/,$arg2); + my ($srchby,$srchtype) = map {&unescape($_)} @items; + my $srchterm = &unescape($arg3); + my $quoted_dom = $dbh->quote( $srchdomain ); + my ($query,$quoted_srchterm,@fields); + my ($table_columns,$table_indices) = + &LONCAPA::lonmetadata::describe_metadata_storage('allusers'); + foreach my $coldata (@{$table_columns}) { + push(@fields,$coldata->{'name'}); + } + my $fieldlist = join(',',@fields); + $query = "SELECT $fieldlist FROM allusers WHERE (domain = $quoted_dom AND "; + if ($srchby eq 'lastfirst') { + my ($fraglast,$fragfirst) = split(/,/,$srchterm); + $fragfirst =~ s/^\s+//; + $fraglast =~ s/\s+$//; + if ($srchtype eq 'exact') { + $query .= 'lastname = '.$dbh->quote($fraglast). + ' AND firstname = '.$dbh->quote($fragfirst); + } else { + $query .= 'lastname LIKE '.$dbh->quote('%'.$fraglast.'%').' AND firstname LIKE '.$dbh->quote('%'.$fragfirst.'%'); + } + } else { + my %srchfield = ( + uname => 'username', + lastname => 'lastname', + ); + if ($srchtype eq 'exact') { + $query .= $srchfield{$srchby}.' = '.$dbh->quote($srchterm); + } else { + $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote('%'.$srchterm.'%'); + } + } + $query .= ") ORDER BY username "; + my $sth = $dbh->prepare($query); + if ($sth->execute()) { + my @results; + while (my @row = $sth->fetchrow_array) { + my @items; + for (my $i=0; $i<@row; $i++) { + push(@items,&escape($fields[$i]).'='.&escape($row[$i])); + } + push(@results,join(":", @items)); + } + $sth->finish; + $result = &escape(join("&",@results)); + } else { + &logthis(''. + 'WARNING: Could not retrieve from database:'. + $sth->errstr().''); + } + } elsif ($query eq 'instdirsearch') { + $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3); + } 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'; + } + } elsif (($query eq 'portfolio_metadata') || + ($query eq 'portfolio_access')) { + $result = &portfolio_table_update($query,$arg1,$arg2, + $arg3); + } elsif ($query eq 'allusers') { + my ($uname,$udom) = map {&unescape($_);} ($arg1,$arg2); + my %userdata; + my (@data) = split(/\%\%/,$arg3); + foreach my $item (@data) { + my ($key,$value) = split(/=/,$item); + $userdata{$key} = &unescape($value); + } + $userdata{'username'} = $uname; + $userdata{'domain'} = $udom; + $result = &allusers_table_update($query,$uname,$udom,\%userdata); } 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("queryreply:$queryid:$result",$conserver); + &Apache::lonnet::reply("queryreply:$queryid:$result",$conserver); } # tidy up gracefully and finish # @@ -428,6 +547,30 @@ sub make_new_child { } } +sub do_inst_dir_search { + my ($domain,$srchby,$srchterm,$srchtype) = @_; + $srchby = &unescape($srchby); + $srchterm = &unescape($srchterm); + $srchtype = &unescape($srchtype); + my (%instusers,%instids,$result,$response); + eval { + local($SIG{__DIE__})='DEFAULT'; + $result=&localenroll::get_userinfo($domain,undef,undef,\%instusers, + \%instids,undef,$srchby,$srchterm, + $srchtype); + }; + if ($result eq 'ok') { + if (%instusers) { + foreach my $key (keys(%instusers)) { + my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key}); + $response .=&escape(&escape($key).'='.$usrstr).'&'; + } + } + $response=~s/\&$//; + } + return $response; +} + ######################################################## ######################################################## @@ -459,7 +602,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); # @@ -519,7 +673,7 @@ sub do_sql_query { my $customresult=''; my @results; foreach my $metafile (@metalist) { - my $fh=IO::File->new($metafile); + open(my $fh,$metafile); my @lines=<$fh>; my $stuff=join('',@lines); if ($stuff=~/$custom/s) { @@ -556,142 +710,210 @@ sub do_sql_query { } # End of &do_sql_query } # End of scoping curly braces for &process_file and &do_sql_query -######################################################## -######################################################## - -=pod - -=item &logthis - -Inputs: $message, the message to log - -Returns: nothing - -Writes $message to the logfile. - -=cut -######################################################## -######################################################## -sub logthis { - my $message=shift; - my $execdir=$perlvar{'lonDaemons'}; - my $fh=IO::File->new(">>$execdir/logs/lonsql.log"); - my $now=time; - my $local=localtime($now); - print $fh "$local ($$): $message\n"; +sub portfolio_table_update { + my ($query,$arg1,$arg2,$arg3) = @_; + my %tablenames = ( + 'portfolio' => 'portfolio_metadata', + 'access' => 'portfolio_access', + 'addedfields' => 'portfolio_addedfields', + ); + my $result = 'ok'; + my $tablechk = &check_table($query); + if ($tablechk == 0) { + my $request = + &LONCAPA::lonmetadata::create_metadata_storage($query,$query); + $dbh->do($request); + if ($dbh->err) { + &logthis("create $query". + " ERROR: ".$dbh->errstr); + $result = 'error'; + } + } + if ($result eq 'ok') { + my ($uname,$udom,$group) = split(/:/,&unescape($arg1)); + my $file_name = &unescape($arg2); + my $action = $arg3; + my $is_course = 0; + if ($group ne '') { + $is_course = 1; + } + my $urlstart = '/uploaded/'.$udom.'/'.$uname; + my $pathstart = &propath($udom,$uname).'/userfiles'; + my ($fullpath,$url); + if ($is_course) { + $fullpath = $pathstart.'/groups/'.$group.'/portfolio'. + $file_name; + $url = $urlstart.'/groups/'.$group.'/portfolio'.$file_name; + } else { + $fullpath = $pathstart.'/portfolio'.$file_name; + $url = $urlstart.'/portfolio'.$file_name; + } + if ($query eq 'portfolio_metadata') { + if ($action eq 'delete') { + my %loghash = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef,\%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group,'update'); + } elsif (-e $fullpath.'.meta') { + my %loghash = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef,\%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group,'update'); + if (keys(%loghash) > 0) { + &portfolio_logging(%loghash); + } + } + } elsif ($query eq 'portfolio_access') { + my %access = &get_access_hash($uname,$udom,$group.$file_name); + my %loghash = + &LONCAPA::lonmetadata::process_portfolio_access_data($dbh,undef, + \%tablenames,$url,$fullpath,\%access,'update'); + if (keys(%loghash) > 0) { + &portfolio_logging(%loghash); + } else { + my $available = 0; + foreach my $key (keys(%access)) { + my ($num,$scope,$end,$start) = + ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/); + if ($scope eq 'public' || $scope eq 'guest') { + $available = 1; + last; + } + } + if ($available) { + # Retrieve current values + my $condition = 'url='.$dbh->quote("$url"); + my ($error,$row) = + &LONCAPA::lonmetadata::lookup_metadata($dbh,$condition,undef, + 'portfolio_metadata'); + if (!$error) { + if (!(ref($row->[0]) eq 'ARRAY')) { + my %loghash = + &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,undef, + \%tablenames,$url,$fullpath,$is_course,$udom,$uname,$group); + if (keys(%loghash) > 0) { + &portfolio_logging(%loghash); + } + } + } + } + } + } + } + return $result; } -# -------------------------------------------------- Non-critical communication - -######################################################## -######################################################## - -=pod - -=item &subreply - -Sends a command to a server. Called only by &reply. - -Inputs: $cmd,$server - -Returns: The results of the message or 'con_lost' on error. - -=cut - -######################################################## -######################################################## -sub subreply { - my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; - my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", - Type => SOCK_STREAM, - Timeout => 10) - or return "con_lost"; - print $sclient "$cmd\n"; - my $answer=<$sclient>; - chomp($answer); - $answer="con_lost" if (!$answer); - return $answer; +sub get_access_hash { + my ($uname,$udom,$file) = @_; + my $hashref = &tie_user_hash($udom,$uname,'file_permissions', + &GDBM_READER()); + my %curr_perms; + my %access; + if ($hashref) { + while (my ($key,$value) = each(%$hashref)) { + $key = &unescape($key); + next if ($key =~ /^error: 2 /); + $curr_perms{$key}=&Apache::lonnet::thaw_unescape($value); + } + if (!&untie_user_hash($hashref)) { + &logthis("error: ".($!+0)." untie (GDBM) Failed"); + } + } else { + &logthis("error: ".($!+0)." tie (GDBM) Failed"); + } + if (keys(%curr_perms) > 0) { + if (ref($curr_perms{$file."\0".'accesscontrol'}) eq 'HASH') { + foreach my $acl (keys(%{$curr_perms{$file."\0".'accesscontrol'}})) { + $access{$acl} = $curr_perms{$file."\0".$acl}; + } + } + } + return %access; } -######################################################## -######################################################## - -=pod - -=item &reply - -Sends a command to a server. - -Inputs: $cmd,$server - -Returns: The results of the message or 'con_lost' on error. - -=cut - -######################################################## -######################################################## -sub reply { - my ($cmd,$server)=@_; - my $answer; - if ($server ne $perlvar{'lonHostID'}) { - $answer=subreply($cmd,$server); - if ($answer eq 'con_lost') { - $answer=subreply("ping",$server); - $answer=subreply($cmd,$server); - } - } else { - $answer='self_reply'; - $answer=subreply($cmd,$server); - } - return $answer; +sub allusers_table_update { + my ($query,$uname,$udom,$userdata) = @_; + my %tablenames = ( + 'allusers' => 'allusers', + ); + my $result = 'ok'; + my $tablechk = &check_table($query); + if ($tablechk == 0) { + my $request = + &LONCAPA::lonmetadata::create_metadata_storage($query,$query); + $dbh->do($request); + if ($dbh->err) { + &logthis("create $query". + " ERROR: ".$dbh->errstr); + $result = 'error'; + } + } + if ($result eq 'ok') { + my %loghash = + &LONCAPA::lonmetadata::process_allusers_data($dbh,undef, + \%tablenames,$uname,$udom,$userdata,'update'); + foreach my $key (keys(%loghash)) { + &logthis($loghash{$key}); + } + } + return $result; } -######################################################## -######################################################## - -=pod - -=item &escape - -Escape special characters in a string. - -Inputs: string to escape - -Returns: The input string with special characters escaped. +########################################### +sub check_table { + my ($table_id) = @_; + my $sth=$dbh->prepare('SHOW TABLES'); + $sth->execute(); + my $aref = $sth->fetchall_arrayref; + $sth->finish(); + if ($sth->err()) { + &logthis("fetchall_arrayref after SHOW TABLES". + " ERROR: ".$sth->errstr); + return undef; + } + my $result = 0; + foreach my $table (@{$aref}) { + if ($table->[0] eq $table_id) { + $result = 1; + last; + } + } + return $result; +} -=cut +########################################### -######################################################## -######################################################## -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; +sub portfolio_logging { + my (%portlog) = @_; + foreach my $key (keys(%portlog)) { + if (ref($portlog{$key}) eq 'HASH') { + foreach my $item (keys(%{$portlog{$key}})) { + &logthis($portlog{$key}{$item}); + } + } + } } + ######################################################## ######################################################## =pod -=item &unescape +=item &logthis -Unescape special characters in a string. +Inputs: $message, the message to log -Inputs: string to unescape +Returns: nothing -Returns: The input string with special characters unescaped. +Writes $message to the logfile. =cut ######################################################## ######################################################## -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; +sub logthis { + my $message=shift; + my $execdir=$perlvar{'lonDaemons'}; + open(my $fh,">>$execdir/logs/lonsql.log"); + my $now=time; + my $local=localtime($now); + print $fh "$local ($$): $message\n"; } ######################################################## @@ -729,31 +951,6 @@ sub ishome { =pod -=item &propath - -Inputs: user name, user domain - -Returns: The full path to the users directory. - -=cut - -######################################################## -######################################################## -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 - =item &courselog Inputs: $path, $command @@ -853,11 +1050,13 @@ sub userlog { { $include=0; } if (($filters{'end'}) && ($timestamp>$filters{'end'})) { $include=0; } + if (($filters{'action'} eq 'Role') && ($log !~/^Role/)) + { $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); + push(@results,$timestamp.':'.$host.':'.&escape($log)); } } close IN; 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.