--- loncom/lonsql 2002/09/09 14:04:02 1.53 +++ loncom/lonsql 2007/09/12 20:29:13 1.89 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.53 2002/09/09 14:04:02 harris41 Exp $ +# $Id: lonsql,v 1.89 2007/09/12 20:29:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,10 +39,59 @@ lonsql - LON TCP-MySQL-Server Daemon for This script should be run as user=www. Note that a lonsql.pid file contains the pid of the parent process. -=head1 DESCRIPTION +=head1 OVERVIEW -lonsql is many things to many people. To me, it is a source file in need -of documentation. +=head2 Purpose within LON-CAPA + +LON-CAPA is meant to distribute A LOT of educational content to A LOT +of people. It is ineffective to directly rely on contents within the +ext2 filesystem to be speedily scanned for on-the-fly searches of +content descriptions. (Simply put, it takes a cumbersome amount of +time to open, read, analyze, and close thousands of files.) + +The solution is to index various data fields that are descriptive of +the educational resources on a LON-CAPA server machine in a +database. Descriptive data fields are referred to as "metadata". The +question then arises as to how this metadata is handled in terms of +the rest of the LON-CAPA network without burdening client and daemon +processes. + +The obvious solution, using lonc to send a query to a lond process, +doesn't work so well in general as you can see in the following +example: + + lonc= loncapa client process A-lonc= a lonc process on Server A + lond= loncapa daemon process + + database command + A-lonc --------TCP/IP----------------> B-lond + +The problem emerges that A-lonc and B-lond are kept waiting for the +MySQL server to "do its stuff", or in other words, perform the +conceivably sophisticated, data-intensive, time-sucking database +transaction. By tying up a lonc and lond process, this significantly +cripples the capabilities of LON-CAPA servers. + +The solution is to offload the work onto another process, and use +lonc and lond just for requests and notifications of completed +processing: + + database command + + A-lonc ---------TCP/IP-----------------> B-lond =====> B-lonsql + <---------------------------------/ | + "ok, I'll get back to you..." | + | + / + A-lond <------------------------------- B-lonc <====== + "Guess what? I have the result!" + +Of course, depending on success or failure, the messages may vary, but +the principle remains the same where a separate pool of children +processes (lonsql's) handle the MySQL database manipulations. + +Thus, lonc and lond spend effectively no time waiting on results from +the database. =head1 Internals @@ -53,18 +102,19 @@ of documentation. 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; ######################################################## ######################################################## @@ -152,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 # @@ -166,8 +232,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; } @@ -176,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 @@ -227,7 +285,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 @@ -298,7 +356,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"; @@ -314,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=''; # @@ -346,27 +406,101 @@ 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 ($srchby,$srchtype,$srchterm); + if ((&unescape($arg1) eq $searchdomain) && + ($arg2 =~ /\%\%/)) { + ($srchby,$srchtype) = + map {&unescape($_);} (split(/\%\%/,$arg2)); + my $srchterm = &unescape($arg3); + } else { + ($srchby,$srchtype,$srchterm) = + map {&unescape($_);} ($arg1,$arg2,$arg3); + } + $result = &do_user_search($searchdomain,$srchby, + $srchtype,$srchterm); + } elsif ($query eq 'instdirsearch') { + $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3); + } elsif ($query eq 'getinstuser') { + $result = &get_inst_user($searchdomain,$arg1,$arg2); + } 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 with result, append \n unless already there - $result.="\n" unless ($result=~/\n$/); - &reply("queryreply:$queryid:$result",$conserver); + &Apache::lonnet::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 @@ -375,6 +509,117 @@ sub make_new_child { } } +sub do_user_search { + my ($domain,$srchby,$srchtype,$srchterm) = @_; + my $result; + my $quoted_dom = $dbh->quote( $domain ); + 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); + } elsif ($srchtype eq 'begins') { + $query .= 'lastname LIKE '.$dbh->quote($fraglast.'%'). + ' AND firstname LIKE '.$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); + } elsif ($srchtype eq 'begins') { + $query .= $srchfield{$srchby}.' LIKE '.$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])); + } + my $userstr = join(':', @items); + push(@results,&escape($userstr)); + } + $sth->finish; + $result = join('&',@results); + } else { + &logthis(''. + 'WARNING: Could not retrieve from database:'. + $sth->errstr().''); + } + return $result; +} + +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/\&$//; + } else { + $response = 'unavailable'; + } + return $response; +} + +sub get_inst_user { + my ($domain,$uname,$id) = @_; + $uname = &unescape($uname); + $id = &unescape($id); + my (%instusers,%instids,$result,$response); + eval { + local($SIG{__DIE__})='DEFAULT'; + $result=&localenroll::get_userinfo($domain,$uname,$id,\%instusers, + \%instids); + }; + if ($result eq 'ok') { + if (keys(%instusers) > 0) { + foreach my $key (keys(%instusers)) { + my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key}); + $response .= &escape(&escape($key).'='.$usrstr).'&'; + } + } + $response=~s/\&$//; + } else { + $response = 'unavailable'; + } + return $response; +} + ######################################################## ######################################################## @@ -406,7 +651,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); # @@ -421,8 +677,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) { @@ -465,7 +722,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) { @@ -502,142 +759,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); +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'; + } } - } else { - $answer='self_reply'; - $answer=subreply($cmd,$server); - } - return $answer; + 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"; } ######################################################## @@ -675,31 +1000,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 @@ -799,11 +1099,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; @@ -854,7 +1156,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); @@ -865,7 +1167,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"; @@ -875,23 +1177,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.