[BACK]Return to lonsql CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lonsql between versions 1.52 and 1.98

version 1.52, 2002/08/13 19:40:57 version 1.98, 2019/04/24 01:44:38
Line 39  lonsql - LON TCP-MySQL-Server Daemon for Line 39  lonsql - LON TCP-MySQL-Server Daemon for
 This script should be run as user=www.    This script should be run as user=www.  
 Note that a lonsql.pid file contains the pid of the parent process.  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  =head2 Purpose within LON-CAPA
 of documentation.  
   
 =head1 Internals  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.
   
 =over 4  Thus, lonc and lond spend effectively no time waiting on results from
   the database.
   
   =head1 Internals
   
 =cut  =cut
   
 use strict;  use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
   use LONCAPA;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::lonmetadata();
   use Apache::lonnet;
   
 use IO::Socket;  use IO::Socket;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
 use IO::Select;  use IO::Select;
 use IO::File;  
 use Socket;  
 use Fcntl;  
 use Tie::RefHash;  
 use DBI;  use DBI;
 use File::Find;  use File::Find;
   use localenroll;
   use GDBM_File;
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
 =pod  =pod
   
   =over 4
   
 =item Global Variables  =item Global Variables
   
 =over 4  =over 4
Line 152  my $run =0;              # running count Line 202  my $run =0;              # running count
 #  #
 # Read loncapa_apache.conf and loncapa.conf  # Read loncapa_apache.conf and loncapa.conf
 #  #
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf',  my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.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  # Make sure that database can be accessed
 #  #
Line 166  unless ($dbh = DBI->connect("DBI:mysql:l Line 231  unless ($dbh = DBI->connect("DBI:mysql:l
     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
     my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";      my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
     system("echo 'Cannot connect to MySQL database!' |".      system("echo 'Cannot connect to MySQL database!' |".
            " mailto $emailto -s '$subj' > /dev/null");             " mail -s '$subj' $emailto > /dev/null");
   
       open(SMP,">$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
       print SMP 'time='.time.'&mysql=defunct'."\n";
       close(SMP);
   
     exit 1;      exit 1;
 } else {  } else {
       unlink("$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
     $dbh->disconnect;      $dbh->disconnect;
 }  }
   
Line 177  unless ($dbh = DBI->connect("DBI:mysql:l Line 248  unless ($dbh = DBI->connect("DBI:mysql:l
 #  #
 my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";  my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
 if (-e $pidfile) {  if (-e $pidfile) {
    my $lfh=IO::File->new("$pidfile");     open(my $lfh,"$pidfile");
    my $pide=<$lfh>;     my $pide=<$lfh>;
    chomp($pide);     chomp($pide);
    if (kill 0 => $pide) { die "already running"; }     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  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=<CONFIG>) {  
     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  # Create a socket to talk to lond
Line 228  my $execdir=$perlvar{'lonDaemons'}; Line 285  my $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lonsql.pid");  open (PIDSAVE,">$execdir/logs/lonsql.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
 &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");  &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
   
 #  #
 # Ignore signals generated during initial startup  # Ignore signals generated during initial startup
Line 299  sub make_new_child { Line 356  sub make_new_child {
                                     $perlvar{'lonSqlAccess'},                                      $perlvar{'lonSqlAccess'},
                                     { RaiseError =>0,PrintError=>0})) {                                       { RaiseError =>0,PrintError=>0})) { 
             sleep(10+int(rand(20)));              sleep(10+int(rand(20)));
             &logthis("<font color=blue>WARNING: Couldn't connect to database".              &logthis("<font color='blue'>WARNING: Couldn't connect to database".
                      ": $@</font>");                       ": $@</font>");
                      #  "($st secs): $@</font>");                       #  "($st secs): $@</font>");
             print "database handle error\n";              print "database handle error\n";
Line 315  sub make_new_child { Line 372  sub make_new_child {
     $run = $run+1;      $run = $run+1;
     my $userinput = <$client>;      my $userinput = <$client>;
     chomp($userinput);      chomp($userinput);
               $userinput=~s/\:($LONCAPA::domain_re)$//;
               my $searchdomain=$1;
             #              #
     my ($conserver,$query,      my ($conserver,$query,
  $arg1,$arg2,$arg3)=split(/&/,$userinput);   $arg1,$arg2,$arg3)=split(/&/,$userinput);
     my $query=unescape($query);      my $query=unescape($query);
             #              #
             #send query id which is pid_unixdatetime_runningcounter              #send query id which is pid_unixdatetime_runningcounter
     my $queryid = $thisserver;      my $queryid = &Apache::lonnet::hostname($perlvar{'lonHostID'});
     $queryid .="_".($$)."_";      $queryid .="_".($$)."_";
     $queryid .= time."_";      $queryid .= time."_";
     $queryid .= $run;      $queryid .= $run;
     print $client "$queryid\n";      print $client "$queryid\n";
     #      #
     &logthis("QUERY: $query - $arg1 - $arg2 - $arg3");      # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid");
     sleep 1;      # sleep 1;
             #              #
             my $result='';              my $result='';
             #              #
Line 347  sub make_new_child { Line 406  sub make_new_child {
                     } else {                      } else {
                         $result=&courselog($path,$command);                          $result=&courselog($path,$command);
                     }                      }
                       $result = &escape($result);
                 } else {                  } else {
                     &logthis('Unable to do log query: '.$uname.'@'.$udom);                      &logthis('Unable to do log query: '.$uname.'@'.$udom);
                     $result='no_such_file';                      $result='no_such_file';
                 }                  }
                 # end of log query                  # 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));
                       $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 'getmultinstusers') {
                   $result = &get_multiple_instusers($searchdomain,$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 {              } else {
                   # Sanity checking of $query needed.
                 # Do an sql query                  # Do an sql query
                 $result = &do_sql_query($query,$arg1,$arg2);                  $result = &do_sql_query($query,$arg1,$arg2,$arg3,$searchdomain);
             }              }
             # result does not need to be escaped because it has already been              # result does not need to be escaped because it has already been
             # escaped.              # escaped.
             #$result=&escape($result);              #$result=&escape($result);
             # reply with result, append \n unless already there              &Apache::lonnet::reply("queryreply:$queryid:$result",$conserver);
     $result.="\n" unless ($result=~/\n$/);  
             &reply("queryreply:$queryid:$result",$conserver);  
         }          }
         # tidy up gracefully and finish          # tidy up gracefully and finish
         #          #
         # close the database handle          # close the database handle
  $dbh->disconnect   $dbh->disconnect
             or &logthis("<font color=blue>WARNING: Couldn't disconnect".              or &logthis("<font color='blue'>WARNING: Couldn't disconnect".
                         " from database  $DBI::errstr : $@</font>");                          " from database  $DBI::errstr : $@</font>");
         # this exit is VERY important, otherwise the child will become          # this exit is VERY important, otherwise the child will become
         # a producer of more and more children, forking yourself into          # a producer of more and more children, forking yourself into
Line 376  sub make_new_child { Line 512  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_ci => 'username collate latin1_general_ci',
                             uname    => 'username',
                             lastname => 'lastname',
                             email    => 'permanentemail',
                           );
           if (exists($srchfield{$srchby})) {
               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.'%');
               }
           } else {
               &logthis('<font color="blue">'.
                        'WARNING: Invalid srchby: '.$srchby.'</font>');  
               return $result;
           }
       }
       $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('<font color="blue">'.
                   'WARNING: Could not retrieve from database:'.
           $sth->errstr().'</font>');
       }
       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;
   }
   
   sub get_multiple_instusers {
       my ($domain,$data) = @_;
       my ($type,$users) = split(/=/,$data,2);
       my $requested = &Apache::lonnet::thaw_unescape($users);
       my $response;
       if (ref($requested) eq 'HASH') {
           my (%instusers,%instids,$result);
           eval {
               local($SIG{__DIE__})='DEFAULT';
               $result=&localenroll::get_multusersinfo($domain,$type,$requested,\%instusers,
                                                       \%instids);
           };
           if ($@) {
               $response = 'error';
           } elsif ($result eq 'ok') {
               $response = $result;
               if (keys(%instusers)) {
                   $response .= '='.&Apache::lonnet::freeze_escape(\%instusers);
               }
           } elsif ($result eq 'unavailable') {
               $response = $result;
           }
       } else {
           $response = 'invalid';
       }
       return $response;
   }
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 407  sub process_file { Line 690  sub process_file {
 }  }
   
 sub do_sql_query {  sub do_sql_query {
     my ($query,$custom,$customshow) = @_;      my ($query,$custom,$customshow,$domainstr,$searchdomain) = @_;
   
   #
   # limit to searchdomain if given and table is metadata
   #
       if ($domainstr && ($query=~/FROM metadata/)) {
           my $havingstr;
           $domainstr = &unescape($domainstr); 
           if ($domainstr =~ /,/) {
               foreach my $dom (split(/,/,$domainstr)) {
                   if ($dom =~ /^$LONCAPA::domain_re$/) {
                       $havingstr .= 'domain="'.$dom.'" OR ';
                   }
               }
               $havingstr =~ s/ OR $//;
           } else {
               if ($domainstr =~ /^$LONCAPA::domain_re$/) {
                   $havingstr = 'domain="'.$domainstr.'"';
               }
           }
           if ($havingstr) {
               $query.=' HAVING ('.$havingstr.')';
           }
       } elsif (($searchdomain) && ($query=~/FROM metadata/)) {
    $query.=' HAVING (domain="'.$searchdomain.'")';
       }
   #    &logthis('doing query ('.$searchdomain.')'.$query);
   
   
   
     $custom     = &unescape($custom);      $custom     = &unescape($custom);
     $customshow = &unescape($customshow);      $customshow = &unescape($customshow);
     #      #
Line 422  sub do_sql_query { Line 734  sub do_sql_query {
         #prepare and execute the query          #prepare and execute the query
         my $sth = $dbh->prepare($query);          my $sth = $dbh->prepare($query);
         unless ($sth->execute()) {          unless ($sth->execute()) {
             &logthis("<font color=blue>WARNING: ".              &logthis('<font color="blue">'.
                      "Could not retrieve from database: $@</font>");                       'WARNING: Could not retrieve from database:'.
                        $sth->errstr().'</font>');
         } else {          } else {
             my $aref=$sth->fetchall_arrayref;              my $aref=$sth->fetchall_arrayref;
             foreach my $row (@$aref) {              foreach my $row (@$aref) {
Line 466  sub do_sql_query { Line 779  sub do_sql_query {
     my $customresult='';      my $customresult='';
     my @results;      my @results;
     foreach my $metafile (@metalist) {      foreach my $metafile (@metalist) {
         my $fh=IO::File->new($metafile);          open(my $fh,$metafile);
         my @lines=<$fh>;          my @lines=<$fh>;
         my $stuff=join('',@lines);          my $stuff=join('',@lines);
         if ($stuff=~/$custom/s) {          if ($stuff=~/$custom/s) {
Line 503  sub do_sql_query { Line 816  sub do_sql_query {
 } # End of &do_sql_query  } # End of &do_sql_query
   
 } # End of scoping curly braces for &process_file and &do_sql_query  } # End of scoping curly braces for &process_file and &do_sql_query
 ########################################################  
 ########################################################  
   
 =pod  sub portfolio_table_update { 
       my ($query,$arg1,$arg2,$arg3) = @_;
 =item &logthis      my %tablenames = (
                          'portfolio'   => 'portfolio_metadata',
 Inputs: $message, the message to log                         'access'      => 'portfolio_access',
                          'addedfields' => 'portfolio_addedfields',
 Returns: nothing                       );
       my $result = 'ok';
 Writes $message to the logfile.      my $tablechk = &check_table($query);
       if ($tablechk == 0) {
 =cut          my $request =
      &LONCAPA::lonmetadata::create_metadata_storage($query,$query);
 ########################################################          $dbh->do($request);
 ########################################################          if ($dbh->err) {
 sub logthis {              &logthis("create $query".
     my $message=shift;                       " ERROR: ".$dbh->errstr);
     my $execdir=$perlvar{'lonDaemons'};                       $result = 'error';
     my $fh=IO::File->new(">>$execdir/logs/lonsql.log");          }
     my $now=time;      }
     my $local=localtime($now);      if ($result eq 'ok') {
     print $fh "$local ($$): $message\n";          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  sub get_access_hash {
       my ($uname,$udom,$file) = @_;
 ########################################################      my $hashref = &tie_user_hash($udom,$uname,'file_permissions',
 ########################################################                                   &GDBM_READER());
       my %curr_perms;
 =pod      my %access; 
       if ($hashref) {
 =item &subreply          while (my ($key,$value) = each(%$hashref)) {
               $key = &unescape($key);
 Sends a command to a server.  Called only by &reply.              next if ($key =~ /^error: 2 /);
               $curr_perms{$key}=&Apache::lonnet::thaw_unescape($value);
 Inputs: $cmd,$server          }
           if (!&untie_user_hash($hashref)) {
 Returns: The results of the message or 'con_lost' on error.              &logthis("error: ".($!+0)." untie (GDBM) Failed");
           }
 =cut      } else {
           &logthis("error: ".($!+0)." tie (GDBM) Failed");
 ########################################################      }
 ########################################################      if (keys(%curr_perms) > 0) {
 sub subreply {          if (ref($curr_perms{$file."\0".'accesscontrol'}) eq 'HASH') {
     my ($cmd,$server)=@_;              foreach my $acl (keys(%{$curr_perms{$file."\0".'accesscontrol'}})) {
     my $peerfile="$perlvar{'lonSockDir'}/$server";                  $access{$acl} = $curr_perms{$file."\0".$acl};
     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",              }
                                       Type    => SOCK_STREAM,          }
                                       Timeout => 10)      }
        or return "con_lost";      return %access;
     print $sclient "$cmd\n";  
     my $answer=<$sclient>;  
     chomp($answer);  
     $answer="con_lost" if (!$answer);  
     return $answer;  
 }  }
   
 ########################################################  sub allusers_table_update {
 ########################################################      my ($query,$uname,$udom,$userdata) = @_;
       my %tablenames = (
 =pod                         'allusers'   => 'allusers',
                        );
 =item &reply      my $result = 'ok';
       my $tablechk = &check_table($query);
 Sends a command to a server.      if ($tablechk == 0) {
           my $request =
 Inputs: $cmd,$server     &LONCAPA::lonmetadata::create_metadata_storage($query,$query);
           $dbh->do($request);
 Returns: The results of the message or 'con_lost' on error.          if ($dbh->err) {
               &logthis("create $query".
 =cut                       " ERROR: ".$dbh->errstr);
                        $result = 'error';
 ########################################################          }
 ########################################################      }
 sub reply {      if ($result eq 'ok') {
   my ($cmd,$server)=@_;          my %loghash = 
   my $answer;              &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
   if ($server ne $perlvar{'lonHostID'}) {                   \%tablenames,$uname,$udom,$userdata,'update');
     $answer=subreply($cmd,$server);          foreach my $key (keys(%loghash)) {
     if ($answer eq 'con_lost') {              &logthis($loghash{$key});
  $answer=subreply("ping",$server);          }
         $answer=subreply($cmd,$server);      }
     }      return $result;
   } else {  
     $answer='self_reply';  
     $answer=subreply($cmd,$server);  
   }   
   return $answer;  
 }  }
   
 ########################################################  ###########################################
 ########################################################  sub check_table {
       my ($table_id) = @_;
 =pod      my $sth=$dbh->prepare('SHOW TABLES');
       $sth->execute();
 =item &escape      my $aref = $sth->fetchall_arrayref;
       $sth->finish();
 Escape special characters in a string.      if ($sth->err()) {
           &logthis("fetchall_arrayref after SHOW TABLES".
 Inputs: string to escape              " ERROR: ".$sth->errstr);
           return undef;
 Returns: The input string with special characters escaped.      }
       my $result = 0;
       foreach my $table (@{$aref}) {
           if ($table->[0] eq $table_id) { 
               $result = 1;
               last;
           }
       }
       return $result;
   }
   
 =cut  ###########################################
   
 ########################################################  sub portfolio_logging {
 ########################################################      my (%portlog) = @_;
 sub escape {      foreach my $key (keys(%portlog)) {
     my $str=shift;          if (ref($portlog{$key}) eq 'HASH') {
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;              foreach my $item (keys(%{$portlog{$key}})) {
     return $str;                  &logthis($portlog{$key}{$item});
               }
           }
       }
 }  }
   
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
 =pod  =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  =cut
   
 ########################################################  ########################################################
 ########################################################  ########################################################
 sub unescape {  sub logthis {
     my $str=shift;      my $message=shift;
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;      my $execdir=$perlvar{'lonDaemons'};
     return $str;      open(my $fh,">>$execdir/logs/lonsql.log");
       my $now=time;
       my $local=localtime($now);
       print $fh "$local ($$): $message\n";
 }  }
   
 ########################################################  ########################################################
Line 676  sub ishome { Line 1057  sub ishome {
   
 =pod  =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  =item &courselog
   
 Inputs: $path, $command  Inputs: $path, $command
Line 800  sub userlog { Line 1156  sub userlog {
                                                              { $include=0; }                                                               { $include=0; }
         if (($filters{'end'}) && ($timestamp>$filters{'end'}))           if (($filters{'end'}) && ($timestamp>$filters{'end'})) 
                                                              { $include=0; }                                                               { $include=0; }
           if (($filters{'action'} eq 'Role') && ($log !~/^Role/))
                                                                { $include=0; }
         if (($filters{'action'} eq 'log') && ($log!~/^Log/)) { $include=0; }          if (($filters{'action'} eq 'log') && ($log!~/^Log/)) { $include=0; }
         if (($filters{'action'} eq 'check') && ($log!~/^Check/))           if (($filters{'action'} eq 'check') && ($log!~/^Check/)) 
                                                              { $include=0; }                                                               { $include=0; }
         if ($include) {          if ($include) {
    push(@results,$timestamp.':'.$log);     push(@results,$timestamp.':'.$host.':'.&escape($log));
         }          }
     }      }
     close IN;      close IN;
Line 855  sub HUNTSMAN {                      # si Line 1213  sub HUNTSMAN {                      # si
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lonsql.pid");      unlink("$execdir/logs/lonsql.pid");
     &logthis("<font color=red>CRITICAL: Shutting down</font>");      &logthis("<font color='red'>CRITICAL: Shutting down</font>");
     $unixsock = "mysqlsock";      $unixsock = "mysqlsock";
     my $port="$perlvar{'lonSockDir'}/$unixsock";      my $port="$perlvar{'lonSockDir'}/$unixsock";
     unlink($port);      unlink($port);
Line 866  sub HUPSMAN {                      # sig Line 1224  sub HUPSMAN {                      # sig
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     close($server);                # free up socket      close($server);                # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color='red'>CRITICAL: Restarting</font>");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     $unixsock = "mysqlsock";      $unixsock = "mysqlsock";
     my $port="$perlvar{'lonSockDir'}/$unixsock";      my $port="$perlvar{'lonSockDir'}/$unixsock";
Line 876  sub HUPSMAN {                      # sig Line 1234  sub HUPSMAN {                      # sig
   
 sub DISCONNECT {  sub DISCONNECT {
     $dbh->disconnect or       $dbh->disconnect or 
     &logthis("<font color=blue>WARNING: Couldn't disconnect from database ".      &logthis("<font color='blue'>WARNING: Couldn't disconnect from database ".
              " $DBI::errstr : $@</font>");               " $DBI::errstr : $@</font>");
     exit;      exit;
 }  }
   
   
   
   
   
   
   
   
   
   
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  
   
 =pod  =pod
   
 =back  =back
Removed from v.1.52  
changed lines
  Added in v.1.98

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
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.