--- loncom/lonsql 2007/01/03 01:59:42 1.79 +++ loncom/lonsql 2007/07/25 22:40:00 1.82 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.79 2007/01/03 01:59:42 raeburn Exp $ +# $Id: lonsql,v 1.82 2007/07/25 22:40:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -105,20 +105,16 @@ 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; -use Storable qw(thaw); ######################################################## ######################################################## @@ -206,8 +202,7 @@ 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'; @@ -253,27 +248,13 @@ 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 $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); # #$PREFORK=int($PREFORK/4); @@ -399,13 +380,13 @@ sub make_new_child { 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"); + # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid"); sleep 1; # my $result=''; @@ -425,6 +406,7 @@ 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'; @@ -459,6 +441,57 @@ sub make_new_child { 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); + 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 'prepare activity log') { my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2); &logthis('preparing activity log tables for '.$cid); @@ -477,6 +510,17 @@ sub make_new_child { ($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,$searchdomain); @@ -484,7 +528,7 @@ sub make_new_child { # 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 # @@ -601,7 +645,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) { @@ -736,7 +780,7 @@ sub get_access_hash { while (my ($key,$value) = each(%$hashref)) { $key = &unescape($key); next if ($key =~ /^error: 2 /); - $curr_perms{$key}=&thaw_unescape($value); + $curr_perms{$key}=&Apache::lonnet::thaw_unescape($value); } if (!&untie_user_hash($hashref)) { &logthis("error: ".($!+0)." untie (GDBM) Failed"); @@ -754,14 +798,32 @@ sub get_access_hash { return %access; } -sub thaw_unescape { - my ($value)=@_; - if ($value =~ /^__FROZEN__/) { - substr($value,0,10,undef); - $value=&unescape($value); - return &thaw($value); +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 &unescape($value); + return $result; } ########################################### @@ -820,78 +882,12 @@ Writes $message to the logfile. sub logthis { my $message=shift; my $execdir=$perlvar{'lonDaemons'}; - my $fh=IO::File->new(">>$execdir/logs/lonsql.log"); + open(my $fh,">>$execdir/logs/lonsql.log"); my $now=time; my $local=localtime($now); print $fh "$local ($$): $message\n"; } -# -------------------------------------------------- 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'}/".$hostname{$server}; - my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", - Type => SOCK_STREAM, - Timeout => 10) - or return "con_lost"; - print $sclient "sethost:$server:$cmd\n"; - my $answer=<$sclient>; - chomp($answer); - $answer="con_lost" if (!$answer); - return $answer; -} - -######################################################## -######################################################## - -=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; -} - ######################################################## ######################################################## @@ -927,31 +923,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 @@ -1051,11 +1022,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.