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

Diff for /loncom/lonsql between versions 1.62 and 1.91

version 1.62, 2004/06/08 22:09:44 version 1.91, 2011/11/07 18:13:38
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 
   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 218  unless ($dbh = DBI->connect("DBI:mysql:l Line 233  unless ($dbh = DBI->connect("DBI:mysql:l
     system("echo 'Cannot connect to MySQL database!' |".      system("echo 'Cannot connect to MySQL database!' |".
            " mailto $emailto -s '$subj' > /dev/null");             " mailto $emailto -s '$subj' > /dev/null");
   
     open(SMP,'>/home/httpd/html/lon-status/mysql.txt');      open(SMP,">$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
     print SMP 'time='.time.'&mysql=defunct'."\n";      print SMP 'time='.time.'&mysql=defunct'."\n";
     close(SMP);      close(SMP);
   
     exit 1;      exit 1;
 } else {  } else {
       unlink("$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
     $dbh->disconnect;      $dbh->disconnect;
 }  }
   
Line 232  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 370  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 402  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') {              } elsif (($query eq 'fetchenrollment') || 
        ($query eq 'institutionalphotos')) {
                 # retrieve institutional class lists                  # retrieve institutional class lists
                 my $dom = &unescape($arg1);                  my $dom = &unescape($arg1);
                 my %affiliates = ();                  my %affiliates = ();
Line 415  sub make_new_child { Line 421  sub make_new_child {
                 my $locresult = '';                  my $locresult = '';
                 my $querystr = &unescape($arg3);                  my $querystr = &unescape($arg3);
                 foreach (split/%%/,$querystr) {                  foreach (split/%%/,$querystr) {
                     if (/^(\w+)=([^=]+)$/) {                      if (/^([^=]+)=([^=]+)$/) {
                         @{$affiliates{$1}} = split/,/,$2;                          @{$affiliates{$1}} = split/,/,$2;
                     }                      }
                 }                  }
                 $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);                  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.':');                  $result = &escape($locresult.':');
                 if ($locresult) {                  if ($locresult) {
                     $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));                      $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 '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 {
                 # 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 446  sub make_new_child { Line 509  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('<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;
   }
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 477  sub process_file { Line 651  sub process_file {
 }  }
   
 sub do_sql_query {  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);      $custom     = &unescape($custom);
     $customshow = &unescape($customshow);      $customshow = &unescape($customshow);
     #      #
Line 537  sub do_sql_query { Line 722  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 574  sub do_sql_query { Line 759  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'}/$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;
       }
       my $result = 0;
       foreach my $table (@{$aref}) {
           if ($table->[0] eq $table_id) { 
               $result = 1;
               last;
           }
       }
       return $result;
   }
   
 Returns: The input string with special characters escaped.  ###########################################
   
 =cut  sub portfolio_logging {
       my (%portlog) = @_;
 ########################################################      foreach my $key (keys(%portlog)) {
 ########################################################          if (ref($portlog{$key}) eq 'HASH') {
 sub escape {              foreach my $item (keys(%{$portlog{$key}})) {
     my $str=shift;                  &logthis($portlog{$key}{$item});
     $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 747  sub ishome { Line 1000  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 871  sub userlog { Line 1099  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.62  
changed lines
  Added in v.1.91

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.