--- loncom/lonnet/perl/lonnet.pm 2018/09/20 14:17:11 1.1384
+++ loncom/lonnet/perl/lonnet.pm 2018/11/28 05:05:36 1.1391
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1384 2018/09/20 14:17:11 raeburn Exp $
+# $Id: lonnet.pm,v 1.1391 2018/11/28 05:05:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -73,7 +73,7 @@ package Apache::lonnet;
use strict;
use HTTP::Date;
use Image::Magick;
-
+use CGI::Cookie;
use Encode;
@@ -237,10 +237,12 @@ sub get_servercerts_info {
}
return if ($hostname eq '');
my ($rep,$uselocal);
- if (grep { $_ eq $lonhost } ¤t_machine_ids()) {
+ if ($context eq 'install') {
+ $uselocal = 1;
+ } elsif (grep { $_ eq $lonhost } ¤t_machine_ids()) {
$uselocal = 1;
}
- if (($context ne 'cgi') && ($uselocal)) {
+ if (($context ne 'cgi') && ($context ne 'install') && ($uselocal)) {
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
if ($distro eq '') {
$uselocal = 0;
@@ -898,6 +900,7 @@ sub userload {
while ($filename=readdir(LONIDS)) {
next if ($filename eq '.' || $filename eq '..');
next if ($filename =~ /publicuser_\d+\.id/);
+ next if ($filename =~ /^[a-f0-9]+_linked\.id$/);
my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
if ($curtime-$mtime < 1800) { $numusers++; }
}
@@ -1026,6 +1029,75 @@ sub find_existing_session {
return;
}
+# check if user's browser sent load balancer cookie and server still has session
+# and is not overloaded.
+sub check_for_balancer_cookie {
+ my ($r,$update_mtime) = @_;
+ my ($otherserver,$cookie);
+ my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+ if (exists($cookies{'balanceID'})) {
+ my $balid = $cookies{'balanceID'};
+ $cookie=&LONCAPA::clean_handle($balid->value);
+ my $balancedir=$r->dir_config('lonBalanceDir');
+ if ((-d $balancedir) && (-e "$balancedir/$cookie.id")) {
+ if ($cookie =~ /^($match_domain)_($match_username)_[a-f0-9]+$/) {
+ my ($possudom,$possuname) = ($1,$2);
+ my $has_session = 0;
+ if ((&domain($possudom) ne '') &&
+ (&homeserver($possuname,$possudom) ne 'no_host')) {
+ my $try_server;
+ my $opened = open(my $idf,'+<',"$balancedir/$cookie.id");
+ if ($opened) {
+ flock($idf,LOCK_SH);
+ while (my $line = <$idf>) {
+ chomp($line);
+ if (&hostname($line) ne '') {
+ $try_server = $line;
+ last;
+ }
+ }
+ close($idf);
+ if (($try_server) &&
+ (&has_user_session($try_server,$possudom,$possuname))) {
+ my $lowest_load = 30000;
+ ($otherserver,$lowest_load) =
+ &compare_server_load($try_server,undef,$lowest_load);
+ if ($otherserver ne '' && $lowest_load < 100) {
+ $has_session = 1;
+ } else {
+ undef($otherserver);
+ }
+ }
+ }
+ }
+ if ($has_session) {
+ if ($update_mtime) {
+ my $atime = my $mtime = time;
+ utime($atime,$mtime,"$balancedir/$cookie.id");
+ }
+ } else {
+ unlink("$balancedir/$cookie.id");
+ }
+ }
+ }
+ }
+ return ($otherserver,$cookie);
+}
+
+sub delbalcookie {
+ my ($cookie,$balancer) =@_;
+ if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
+ my ($udom,$uname) = ($1,$2);
+ my $uprimary_id = &domain($udom,'primary');
+ my $uintdom = &internet_dom($uprimary_id);
+ my $intdom = &internet_dom($balancer);
+ my $serverhomedom = &host_domain($balancer);
+ if (($uintdom ne '') && ($uintdom eq $intdom)) {
+ return &reply("delbalcookie:$cookie",$balancer);
+ }
+ }
+}
+
# -------------------------------- ask if server already has a session for user
sub has_user_session {
my ($lonid,$udom,$uname) = @_;
@@ -1061,7 +1133,7 @@ sub choose_server {
if (ref($balancers) eq 'HASH') {
next if (exists($balancers->{$lonhost}));
}
- }
+ }
my $loginvia;
if ($checkloginvia) {
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
@@ -1363,7 +1435,7 @@ sub get_lonbalancer_config {
sub check_loadbalancing {
my ($uname,$udom,$caller) = @_;
my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom,
- $rule_in_effect,$offloadto,$otherserver);
+ $rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);
my $lonhost = $perlvar{'lonHostID'};
my @hosts = ¤t_machine_ids();
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1390,7 +1462,7 @@ sub check_loadbalancing {
}
}
if (ref($result) eq 'HASH') {
- ($is_balancer,$currtargets,$currrules) =
+ ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
&check_balancer_result($result,@hosts);
if ($is_balancer) {
if (ref($currrules) eq 'HASH') {
@@ -1451,7 +1523,7 @@ sub check_loadbalancing {
}
}
if (ref($result) eq 'HASH') {
- ($is_balancer,$currtargets,$currrules) =
+ ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
&check_balancer_result($result,@hosts);
if ($is_balancer) {
if (ref($currrules) eq 'HASH') {
@@ -1517,20 +1589,22 @@ sub check_loadbalancing {
$is_balancer = 0;
if ($uname ne '' && $udom ne '') {
if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
-
- &appenv({'user.loadbalexempt' => $lonhost,
+ &appenv({'user.loadbalexempt' => $lonhost,
'user.loadbalcheck.time' => time});
}
}
}
}
+ unless ($homeintdom) {
+ undef($setcookie);
+ }
}
- return ($is_balancer,$otherserver);
+ return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);
}
sub check_balancer_result {
my ($result,@hosts) = @_;
- my ($is_balancer,$currtargets,$currrules);
+ my ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
if (ref($result) eq 'HASH') {
if ($result->{'lonhost'} ne '') {
my $currbalancer = $result->{'lonhost'};
@@ -1538,20 +1612,26 @@ sub check_balancer_result {
$is_balancer = 1;
$currtargets = $result->{'targets'};
$currrules = $result->{'rules'};
+ $dom_balancers = $currbalancer;
}
+ $dom_balancers = $currbalancer;
} else {
- foreach my $key (keys(%{$result})) {
- if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
- (ref($result->{$key}) eq 'HASH')) {
- $is_balancer = 1;
- $currrules = $result->{$key}{'rules'};
- $currtargets = $result->{$key}{'targets'};
- last;
+ if (keys(%{$result})) {
+ foreach my $key (keys(%{$result})) {
+ if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
+ (ref($result->{$key}) eq 'HASH')) {
+ $is_balancer = 1;
+ $currrules = $result->{$key}{'rules'};
+ $currtargets = $result->{$key}{'targets'};
+ $setcookie = $result->{$key}{'cookie'};
+ last;
+ }
}
+ $dom_balancers = join(',',sort(keys(%{$result})));
}
}
}
- return ($is_balancer,$currtargets,$currrules);
+ return ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
}
sub get_loadbalancer_targets {
@@ -3197,8 +3277,17 @@ sub ssi {
$request->header(Cookie => $ENV{'HTTP_COOKIE'});
my $lonhost = $perlvar{'lonHostID'};
+ my $islocal;
+ if (($env{'request.course.id'}) &&
+ ($form{'grade_courseid'} eq $env{'request.course.id'}) &&
+ ($form{'grade_username'} ne '') && ($form{'grade_domain'} ne '') &&
+ ($form{'grade_symb'} ne '') &&
+ (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.
+ ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
+ $islocal = 1;
+ }
my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
- '','','',1);
+ '','','',$islocal);
if (wantarray) {
return ($response->content, $response);
@@ -5232,7 +5321,12 @@ sub set_first_access {
}
$cachedkey='';
my $firstaccess=&get_first_access($type,$symb,$map);
- if (!$firstaccess) {
+ if ($firstaccess) {
+ &logthis("First access time already set ($firstaccess) when attempting ".
+ "to set new value (type: $type, extent: $res) for $uname:$udom ".
+ "in $courseid");
+ return 'already_set';
+ } else {
my $start = time;
my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},
$udom,$uname);
@@ -5248,6 +5342,9 @@ sub set_first_access {
if (($cachedtime) && (abs($start-$cachedtime) < 5)) {
$cachedtimes{"$courseid\0$res"} = $start;
}
+ } elsif ($putres ne 'refused') {
+ &logthis("Result: $putres when attempting to set first access time ".
+ "(type: $type, extent: $res) for $uname:$udom in $courseid");
}
return $putres;
}