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

Diff for /loncom/lond between versions 1.489.2.35.2.1 and 1.489.2.38

version 1.489.2.35.2.1, 2020/01/13 14:05:54 version 1.489.2.38, 2020/05/05 20:28:56
Line 4576  sub course_lastaccess_handler { Line 4576  sub course_lastaccess_handler {
 }  }
 &register_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);  &register_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);
   
   sub course_sessions_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$cnum,$lastactivity) = split(':',$tail);
       my $dbsuffix = '_'.$cdom.'_'.$cnum.'.db';
       my (%sessions,$qresult);
       my $now=time;
       if (opendir(DIR,$perlvar{'lonIDsDir'})) {
           my $filename;
           while ($filename=readdir(DIR)) {
               next if ($filename=~/^\./);
               next if ($filename=~/^publicuser_/);
               next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);
               if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) {
                   my ($uname,$udom) = ($1,$2);
                   next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix");
                   my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];
                   if ($lastactivity < 0) {
                       next if ($mtime-$now > $lastactivity);
                   } else {
                       next if ($now-$mtime > $lastactivity);
                   }
                   $sessions{$uname.':'.$udom} = $mtime;
               }
           }
           closedir(DIR);
       }
       foreach my $user (keys(%sessions)) {
           $qresult.=&escape($user).'='.$sessions{$user}.'&';
       }
       if ($qresult) {
           chop($qresult);
       }
       &Reply($client, \$qresult, $userinput);
       return 1;
   }
   &register_handler("coursesessions",\&course_sessions_handler, 0, 1, 0);
   
 #  #
 # Puts an unencrypted entry in a namespace db file at the domain level   # Puts an unencrypted entry in a namespace db file at the domain level 
 #  #
Line 4646  sub get_domain_handler { Line 4684  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 4689  sub encrypted_get_domain_handler { Line 4693  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. 
Removed from v.1.489.2.35.2.1  
changed lines
  Added in v.1.489.2.38

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