--- loncom/lond 2020/01/13 14:05:54 1.489.2.35.2.1 +++ loncom/lond 2020/05/04 15:15:16 1.489.2.36 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.35.2.1 2020/01/13 14:05:54 raeburn Exp $ +# $Id: lond,v 1.489.2.36 2020/05/04 15:15:16 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -63,7 +63,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.489.2.35.2.1 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.36 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -4576,6 +4576,45 @@ sub course_lastaccess_handler { } ®ister_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_user)_\d+_($LONCAPA::match_domain)_/) { + my ($uname,$udom) = ($1,$2); + next unless (-e "$perlvar{'lonDaemons'}/$uname$dbsuffix"); + my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9]; + my $since=$now-$mtime; + if ($lastactivity < 0) { + next if ($since <= $lastactivity); + } else { + next if ($since > $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; +} +®ister_handler("coursesessions",\&course_sessions_handler, 0, 1, 0); + # # Puts an unencrypted entry in a namespace db file at the domain level # @@ -4646,40 +4685,6 @@ sub get_domain_handler { my ($udom,$namespace,$what)=split(/:/,$tail,3); 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; -} -®ister_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 $qresult=''; my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); @@ -4689,31 +4694,19 @@ sub encrypted_get_domain_handler { } if (&untie_domain_hash($hashref)) { $qresult=~s/\&$//; - if ($cipher) { - 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); - } + &Reply($client, \$qresult, $userinput); } else { &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); + "while attempting getdom\n",$userinput); } } else { &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); + "while attempting getdom\n",$userinput); } + return 1; } -®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0); +®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); # # Puts an id to a domains id database.