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

Diff for /loncom/lond between versions 1.489.2.35.2.3 and 1.489.2.36

version 1.489.2.35.2.3, 2020/10/26 04:08:56 version 1.489.2.36, 2020/05/04 15:15:16
Line 4589  sub course_sessions_handler { Line 4589  sub course_sessions_handler {
             next if ($filename=~/^\./);              next if ($filename=~/^\./);
             next if ($filename=~/^publicuser_/);              next if ($filename=~/^publicuser_/);
             next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);              next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);
             if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) {              if ($filename =~ /^($LONCAPA::match_user)_\d+_($LONCAPA::match_domain)_/) {
                 my ($uname,$udom) = ($1,$2);                  my ($uname,$udom) = ($1,$2);
                 next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix");                  next unless (-e "$perlvar{'lonDaemons'}/$uname$dbsuffix");
                 my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];                  my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];
                   my $since=$now-$mtime;
                 if ($lastactivity < 0) {                  if ($lastactivity < 0) {
                     next if ($mtime-$now > $lastactivity);                      next if ($since <= $lastactivity);
                 } else {                  } else {
                     next if ($now-$mtime > $lastactivity);                      next if ($since > $lastactivity);
                 }                  }
                 $sessions{$uname.':'.$udom} = $mtime;                  $sessions{$uname.':'.$udom} = $mtime;
             }              }
Line 4684  sub get_domain_handler { Line 4685  sub get_domain_handler {
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
     chomp($what);      chomp($what);
     if ($namespace =~ /^enc/) {  
         &Failure( $client, "refused\n", $userinput);  
     } else {  
         my @queries=split(/\&/,$what);  
         my $qresult='';  
         my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());  
         if ($hashref) {  
             for (my $i=0;$i<=$#queries;$i++) {  
                 $qresult.="$hashref->{$queries[$i]}&";  
             }  
             if (&untie_domain_hash($hashref)) {  
                 $qresult=~s/\&$//;  
                 &Reply($client, \$qresult, $userinput);  
             } else {  
                 &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".  
                           "while attempting getdom\n",$userinput);  
             }  
         } else {  
             &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".  
                      "while attempting getdom\n",$userinput);  
         }  
     }  
   
     return 1;  
 }  
 &register_handler("getdom", \&get_domain_handler, 0, 1, 0);  
   
 sub encrypted_get_domain_handler {  
     my ($cmd, $tail, $client) = @_;  
   
     my $userinput = "$cmd:$tail";  
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);  
     chomp($what);  
     my @queries=split(/\&/,$what);      my @queries=split(/\&/,$what);
     my $qresult='';      my $qresult='';
     my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());      my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
Line 4727  sub encrypted_get_domain_handler { Line 4694  sub encrypted_get_domain_handler {
         }          }
         if (&untie_domain_hash($hashref)) {          if (&untie_domain_hash($hashref)) {
             $qresult=~s/\&$//;              $qresult=~s/\&$//;
             if ($cipher) {              &Reply($client, \$qresult, $userinput);
                 my $cmdlength=length($qresult);  
                 $qresult.="         ";  
                 my $encqresult='';  
                 for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {  
                     $encqresult.= unpack("H16",  
                                          $cipher->encrypt(substr($qresult,  
                                                                  $encidx,  
                                                                  8)));  
                 }  
                 &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);  
             } else {  
                 &Failure( $client, "error:no_key\n", $userinput);  
             }  
         } else {          } else {
             &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
                       "while attempting egetdom\n",$userinput);                        "while attempting getdom\n",$userinput);
         }          }
     } else {      } else {
         &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".          &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
                  "while attempting egetdom\n",$userinput);                   "while attempting getdom\n",$userinput);
     }      }
   
     return 1;      return 1;
 }  }
 &register_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);  &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
   
 #  #
 #  Puts an id to a domains id database.   #  Puts an id to a domains id database. 
Line 5269  sub tmp_del_handler { Line 5224  sub tmp_del_handler {
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);  &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
   
 #  #
 #  Process the updatebalcookie command.  This command updates a  
 #  cookie in the lonBalancedir directory on a load balancer node.  
 #  
 # Parameters:  
 #   $cmd      - Command that got us here.  
 #   $tail     - Tail of the request (escaped cookie: escaped current entry)  
 #  
 #   $client   - socket open on the client process.  
 #  
 # Returns:  
 #   1     - Indicating processing should continue.  
 # Side Effects:  
 #   A cookie file is updated from the lonBalancedir directory  
 #   A reply is sent to the client.  
 #  
 sub update_balcookie_handler {  
     my ($cmd, $tail, $client) = @_;  
   
     my $userinput= "$cmd:$tail";  
     chomp($tail);  
     my ($cookie,$lastentry) = map { &unescape($_) } (split(/:/,$tail));  
   
     my $updatedone;  
     if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {  
         my $execdir=$perlvar{'lonBalanceDir'};  
         if (-e "$execdir/$cookie.id") {  
             my $doupdate;  
             if (open(my $fh,'<',"$execdir/$cookie.id")) {  
                 while (my $line = <$fh>) {  
                     chomp($line);  
                     if ($line eq $lastentry) {  
                         $doupdate = 1;  
                         last;  
                     }  
                 }  
                 close($fh);  
             }  
             if ($doupdate) {  
                 if (open(my $fh,'>',"$execdir/$cookie.id")) {  
                     print $fh $clientname;  
                     close($fh);  
                     $updatedone = 1;  
                 }  
             }  
         }  
     }  
     if ($updatedone) {  
         &Reply($client, "ok\n", $userinput);  
     } else {  
         &Failure( $client, "error: ".($!+0)."file update failed ".  
                   "while attempting updatebalcookie\n", $userinput);  
     }  
     return 1;  
 }  
 &register_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0);  
   
 #  
 #  Process the delbalcookie command. This command deletes a balancer  #  Process the delbalcookie command. This command deletes a balancer
 #  cookie in the lonBalancedir directory on a load balancer node.  #  cookie in the lonBalancedir directory created by switchserver
 #  #
 # Parameters:  # Parameters:
 #   $cmd      - Command that got us here.  #   $cmd      - Command that got us here.
Line 5345  sub del_balcookie_handler { Line 5243  sub del_balcookie_handler {
     my $userinput= "$cmd:$cookie";      my $userinput= "$cmd:$cookie";
   
     chomp($cookie);      chomp($cookie);
     $cookie = &unescape($cookie);  
     my $deleted = '';      my $deleted = '';
     if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {      if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
         my $execdir=$perlvar{'lonBalanceDir'};          my $execdir=$perlvar{'lonBalanceDir'};
Removed from v.1.489.2.35.2.3  
changed lines
  Added in v.1.489.2.36

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>