version 1.562, 2020/05/04 17:05:10
|
version 1.565, 2021/02/08 14:50:53
|
Line 310 my %trust = (
|
Line 310 my %trust = (
|
tokenauthuserfile => {anywhere => 1}, |
tokenauthuserfile => {anywhere => 1}, |
unsub => {content => 1,}, |
unsub => {content => 1,}, |
update => {shared => 1}, |
update => {shared => 1}, |
|
updatebalcookie => {institutiononly => 1}, |
updateclickers => {remote => 1}, |
updateclickers => {remote => 1}, |
userhassession => {anywhere => 1}, |
userhassession => {anywhere => 1}, |
userload => {anywhere => 1}, |
userload => {anywhere => 1}, |
Line 4891 sub course_sessions_handler {
|
Line 4892 sub course_sessions_handler {
|
my ($uname,$udom) = ($1,$2); |
my ($uname,$udom) = ($1,$2); |
next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix"); |
next unless (-e "$perlvar{'lonDaemons'}/tmp/$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 ($since <= $lastactivity); |
next if ($mtime-$now > $lastactivity); |
} else { |
} else { |
next if ($since > $lastactivity); |
next if ($now-$mtime > $lastactivity); |
} |
} |
$sessions{$uname.':'.$udom} = $mtime; |
$sessions{$uname.':'.$udom} = $mtime; |
} |
} |
Line 5077 sub del_domain_handler {
|
Line 5077 sub del_domain_handler {
|
# domain directory. |
# domain directory. |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Command request keyword (get). |
# $cmd - Command request keyword (getdom). |
# $tail - Tail of the command. This is a colon separated list |
# $tail - Tail of the command. This is a colon separated list |
# consisting of the domain and the 'namespace' |
# consisting of the domain and the 'namespace' |
# which selects the gdbm file to do the lookup in, |
# which selects the gdbm file to do the lookup in, |
Line 5094 sub del_domain_handler {
|
Line 5094 sub del_domain_handler {
|
sub get_domain_handler { |
sub get_domain_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
chomp($what); |
|
if ($namespace =~ /^enc/) { |
if ($namespace =~ /^enc/) { |
&Failure( $client, "refused\n", $userinput); |
&Failure( $client, "refused\n", $userinput); |
} else { |
} else { |
my @queries=split(/\&/,$what); |
my $res = LONCAPA::Lond::get_dom($userinput); |
my $qresult=''; |
if ($res =~ /^error:/) { |
my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); |
&Failure($client, \$res, $userinput); |
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 { |
} else { |
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
&Reply($client, \$res, $userinput); |
"while attempting getdom\n",$userinput); |
|
} |
} |
} |
} |
|
|
Line 5131 sub encrypted_get_domain_handler {
|
Line 5117 sub encrypted_get_domain_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
my $res = LONCAPA::Lond::get_dom($userinput); |
chomp($what); |
if ($res =~ /^error:/) { |
my @queries=split(/\&/,$what); |
&Failure($client, \$res, $userinput); |
my $qresult=''; |
} else { |
my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); |
if ($cipher) { |
if ($hashref) { |
my $cmdlength=length($res); |
for (my $i=0;$i<=$#queries;$i++) { |
$res.=" "; |
$qresult.="$hashref->{$queries[$i]}&"; |
my $encres=''; |
} |
for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
if (&untie_domain_hash($hashref)) { |
$encres.= unpack("H16", |
$qresult=~s/\&$//; |
$cipher->encrypt(substr($res, |
if ($cipher) { |
$encidx, |
my $cmdlength=length($qresult); |
8))); |
$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,"enc:$cmdlength:$encres\n",$userinput); |
} else { |
} else { |
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure( $client, "error:no_key\n",$userinput); |
"while attempting egetdom\n",$userinput); |
|
} |
} |
} else { |
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting egetdom\n",$userinput); |
|
} |
} |
return 1; |
return 1; |
} |
} |
Line 5684 sub tmp_del_handler {
|
Line 5656 sub tmp_del_handler {
|
®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0); |
®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 |
# 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: |
# Parameters: |
# $cmd - Command that got us here. |
# $cmd - Command that got us here. |
Line 5703 sub del_balcookie_handler {
|
Line 5732 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'}; |