--- loncom/lond 2020/05/05 20:24:41 1.563 +++ loncom/lond 2021/02/08 14:50:53 1.565 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.563 2020/05/05 20:24:41 raeburn Exp $ +# $Id: lond,v 1.565 2021/02/08 14:50:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,7 +65,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.563 $'; #' stupid emacs +my $VERSION='$Revision: 1.565 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -310,6 +310,7 @@ my %trust = ( tokenauthuserfile => {anywhere => 1}, unsub => {content => 1,}, update => {shared => 1}, + updatebalcookie => {institutiononly => 1}, updateclickers => {remote => 1}, userhassession => {anywhere => 1}, userload => {anywhere => 1}, @@ -5076,7 +5077,7 @@ sub del_domain_handler { # domain directory. # # Parameters: -# $cmd - Command request keyword (get). +# $cmd - Command request keyword (getdom). # $tail - Tail of the command. This is a colon separated list # consisting of the domain and the 'namespace' # which selects the gdbm file to do the lookup in, @@ -5093,31 +5094,17 @@ sub del_domain_handler { sub get_domain_handler { my ($cmd, $tail, $client) = @_; - my $userinput = "$cmd:$tail"; 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); - } + my $res = LONCAPA::Lond::get_dom($userinput); + if ($res =~ /^error:/) { + &Failure($client, \$res, $userinput); } else { - &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting getdom\n",$userinput); + &Reply($client, \$res, $userinput); } } @@ -5130,38 +5117,24 @@ sub encrypted_get_domain_handler { 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()); - if ($hashref) { - for (my $i=0;$i<=$#queries;$i++) { - $qresult.="$hashref->{$queries[$i]}&"; - } - 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); + my $res = LONCAPA::Lond::get_dom($userinput); + if ($res =~ /^error:/) { + &Failure($client, \$res, $userinput); + } else { + if ($cipher) { + my $cmdlength=length($res); + $res.=" "; + my $encres=''; + for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { + $encres.= unpack("H16", + $cipher->encrypt(substr($res, + $encidx, + 8))); } + &Reply( $client,"enc:$cmdlength:$encres\n",$userinput); } else { - &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); + &Failure( $client, "error:no_key\n",$userinput); } - } else { - &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); } return 1; } @@ -5683,8 +5656,65 @@ sub tmp_del_handler { ®ister_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; +} +®ister_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0); + +# # Process the delbalcookie command. This command deletes a balancer -# cookie in the lonBalancedir directory created by switchserver +# cookie in the lonBalancedir directory on a load balancer node. # # Parameters: # $cmd - Command that got us here. @@ -5702,6 +5732,7 @@ sub del_balcookie_handler { my $userinput= "$cmd:$cookie"; chomp($cookie); + $cookie = &unescape($cookie); my $deleted = ''; if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) { my $execdir=$perlvar{'lonBalanceDir'};