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

Diff for /loncom/lonsql between versions 1.72 and 1.81

version 1.72, 2006/02/07 22:30:31 version 1.81, 2007/04/12 00:00:55
Line 102  the database. Line 102  the database.
 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 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 localenroll;
   use GDBM_File;
   
 ########################################################  ########################################################
 ########################################################  ########################################################
Line 203  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.conf');  my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
 my %perlvar=%{$perlvarref};  
 #  #
 # Write the /home/www/.my.cnf file   # Write the /home/www/.my.cnf file 
 my $conf_file = '/home/www/.my.cnf';  my $conf_file = '/home/www/.my.cnf';
Line 250  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 $thisserver;  
 my %hostname;  
 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)=split(/:/,$configline);  
     $name=~s/\s//g;  
     $thisserver=$name if ($id eq $perlvar{'lonHostID'});  
     $hostname{$id}=$name;  
     #$PREFORK++;  
 }  
 close(CONFIG);  
 #  #
 #$PREFORK=int($PREFORK/4);  #$PREFORK=int($PREFORK/4);
   
Line 388  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/\:(\w+)$//;
               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 420  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';
Line 442  sub make_new_child { Line 429  sub make_new_child {
                     $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);                      $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);
                 } elsif ($query eq 'institutionalphotos') {                  } elsif ($query eq 'institutionalphotos') {
                     my $crs = &unescape($arg2);                      my $crs = &unescape($arg2);
                     $locresult = &localenroll::institutional_photos($dom,$crs,\%affiliates,\%replies,'update');      eval {
    local($SIG{__DIE__})='DEFAULT';
    $locresult = &localenroll::institutional_photos($dom,$crs,\%affiliates,\%replies,'update');
       };
       if ($@) {
    $locresult = 'error';
       }
                 }                  }
                 $result = &escape($locresult.':');                  $result = &escape($locresult.':');
                 if ($locresult) {                  if ($locresult) {
Line 462  sub make_new_child { Line 455  sub make_new_child {
                 } else {                  } else {
                     $result = 'success';                      $result = 'success';
                 }                  }
               } elsif (($query eq 'portfolio_metadata') || 
                       ($query eq 'portfolio_access')) {
                   $result = &portfolio_table_update($query,$arg1,$arg2,
                                                     $arg3);
             } else {              } else {
                 # Do an sql query                  # 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              # result does not need to be escaped because it has already been
             # escaped.              # escaped.
             #$result=&escape($result);              #$result=&escape($result);
             &reply("queryreply:$queryid:$result",$conserver);              &Apache::lonnet::reply("queryreply:$queryid:$result",$conserver);
         }          }
         # tidy up gracefully and finish          # tidy up gracefully and finish
         #          #
Line 515  sub process_file { Line 512  sub process_file {
 }  }
   
 sub do_sql_query {  sub do_sql_query {
     my ($query,$custom,$customshow) = @_;      my ($query,$custom,$customshow,$searchdomain) = @_;
 #    &logthis('doing query '.$query);  
   #
   # 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);      $custom     = &unescape($custom);
     $customshow = &unescape($customshow);      $customshow = &unescape($customshow);
     #      #
Line 576  sub do_sql_query { Line 583  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 613  sub do_sql_query { Line 620  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  
   
 =item &logthis  
   
 Inputs: $message, the message to log  sub portfolio_table_update { 
       my ($query,$arg1,$arg2,$arg3) = @_;
 Returns: nothing      my %tablenames = (
                          'portfolio'   => 'portfolio_metadata',
 Writes $message to the logfile.                         'access'      => 'portfolio_access',
                          'addedfields' => 'portfolio_addedfields',
 =cut                       );
       my $result = 'ok';
 ########################################################      my $tablechk = &check_table($query);
 ########################################################      if ($tablechk == 0) {
 sub logthis {          my $request =
     my $message=shift;     &LONCAPA::lonmetadata::create_metadata_storage($query,$query);
     my $execdir=$perlvar{'lonDaemons'};          $dbh->do($request);
     my $fh=IO::File->new(">>$execdir/logs/lonsql.log");          if ($dbh->err) {
     my $now=time;              &logthis("create $query".
     my $local=localtime($now);                       " ERROR: ".$dbh->errstr);
     print $fh "$local ($$): $message\n";                       $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  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'}/".$hostname{$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 "sethost:$server:$cmd\n";  
     my $answer=<$sclient>;  
     chomp($answer);  
     $answer="con_lost" if (!$answer);  
     return $answer;  
 }  }
   
 ########################################################  ###########################################
 ########################################################  sub check_table {
       my ($table_id) = @_;
 =pod      my $sth=$dbh->prepare('SHOW TABLES');
       $sth->execute();
 =item &reply      my $aref = $sth->fetchall_arrayref;
       $sth->finish();
 Sends a command to a server.      if ($sth->err()) {
           &logthis("fetchall_arrayref after SHOW TABLES".
 Inputs: $cmd,$server              " ERROR: ".$sth->errstr);
           return undef;
 Returns: The results of the message or 'con_lost' on error.      }
       my $result = 0;
 =cut      foreach my $table (@{$aref}) {
           if ($table->[0] eq $table_id) { 
 ########################################################              $result = 1;
 ########################################################              last;
 sub reply {          }
   my ($cmd,$server)=@_;      }
   my $answer;      return $result;
   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;  
 }  }
   
 ########################################################  ###########################################
 ########################################################  
   
 =pod  
   
 =item &escape  
   
 Escape special characters in a string.  sub portfolio_logging {
       my (%portlog) = @_;
 Inputs: string to escape      foreach my $key (keys(%portlog)) {
           if (ref($portlog{$key}) eq 'HASH') {
 Returns: The input string with special characters escaped.              foreach my $item (keys(%{$portlog{$key}})) {
                   &logthis($portlog{$key}{$item});
 =cut              }
           }
 ########################################################      }
 ########################################################  
 sub escape {  
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  
     return $str;  
 }  }
   
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
 =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 786  sub ishome { Line 833  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 910  sub userlog { Line 932  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;
Removed from v.1.72  
changed lines
  Added in v.1.81

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.