[LON-CAPA-cvs] cvs: loncom / loncapa_apache.conf loncron lond /auth lonacc.pm lonlogin.pm lonlogout.pm migrateuser.pm switchserver.pm /lonnet/perl lonnet.pm doc/loncapafiles loncapafiles.lpml

raeburn raeburn at source.lon-capa.org
Sat Nov 24 11:19:21 EST 2018


raeburn		Sat Nov 24 16:19:21 2018 EDT

  Modified files:              
    /loncom/auth	lonacc.pm lonlogin.pm lonlogout.pm switchserver.pm 
                	migrateuser.pm 
    /loncom	lond loncron loncapa_apache.conf 
    /doc/loncapafiles	loncapafiles.lpml 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Domain config for load balancer to use cookie to record offload target.
    Subsequent requests by same user/browser will send requests to same target
    if remote session still active, and remote node not overloaded.
  
  
-------------- next part --------------
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.170 loncom/auth/lonacc.pm:1.171
--- loncom/auth/lonacc.pm:1.170	Mon Jul  2 20:53:07 2018
+++ loncom/auth/lonacc.pm	Sat Nov 24 16:19:04 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Cookie Based Access Handler
 #
-# $Id: lonacc.pm,v 1.170 2018/07/02 20:53:07 raeburn Exp $
+# $Id: lonacc.pm,v 1.171 2018/11/24 16:19:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -340,17 +340,21 @@
             ($is_balancer,$otherserver) =
                 &Apache::lonnet::check_loadbalancing($user,$domain,'login');
             if ($is_balancer) {
-                if ($otherserver eq '') {
+                # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
+                my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r);
+                if (($found_server) && ($balancer_cookie =~ /^\Q$domain\E_\Q$user\E_/)) {
+                    $otherserver = $found_server;
+                } elsif ($otherserver eq '') {
                     my $lowest_load;
                     ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($domain);
                     if ($lowest_load > 100) {
                         $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$domain);
                     }
-                }
-                if ($otherserver ne '') {
-                    my @hosts = &Apache::lonnet::current_machine_ids();
-                    if (grep(/^\Q$otherserver\E$/, at hosts)) {
-                        $hosthere = $otherserver;
+                    if ($otherserver ne '') {
+                        my @hosts = &Apache::lonnet::current_machine_ids();
+                        if (grep(/^\Q$otherserver\E$/, at hosts)) {
+                            $hosthere = $otherserver;
+                        }
                     }
                 }
             }
@@ -561,7 +565,7 @@
         my $checkexempt;
         if ($env{'user.loadbalexempt'} eq $r->dir_config('lonHostID')) {
             if ($env{'user.loadbalcheck.time'} + 600 > time) {
-                $checkexempt = 1;    
+                $checkexempt = 1;
             }
         }
         if ($env{'user.noloadbalance'} eq $r->dir_config('lonHostID')) {
@@ -571,12 +575,23 @@
             ($is_balancer,$otherserver) =
                 &Apache::lonnet::check_loadbalancing($env{'user.name'},
                                                      $env{'user.domain'});
+            if ($is_balancer) {
+                unless (($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) {
+                    # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
+                    my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r);
+                    if (($found_server) && ($balancer_cookie =~ /^\Q$env{'user.domain'}\E_\Q$env{'user.name'}\E_/)) {
+                        $otherserver = $found_server;
+                    }
+                }
+            }
         }
         if ($is_balancer) {
-            $r->set_handlers('PerlResponseHandler'=>
-                             [\&Apache::switchserver::handler]);
-            if ($otherserver ne '') {
-                $env{'form.otherserver'} = $otherserver;
+            unless (($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) {
+                $r->set_handlers('PerlResponseHandler'=>
+                                 [\&Apache::switchserver::handler]);
+                if ($otherserver ne '') {
+                    $env{'form.otherserver'} = $otherserver;
+                }
             }
             unless (($env{'form.origurl'}) || ($r->uri eq '/adm/roles') ||
                     ($r->uri eq '/adm/switchserver') || ($r->uri eq '/adm/sso')) {
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.173 loncom/auth/lonlogin.pm:1.174
--- loncom/auth/lonlogin.pm:1.173	Wed Jul  4 16:58:19 2018
+++ loncom/auth/lonlogin.pm	Sat Nov 24 16:19:04 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Login Screen
 #
-# $Id: lonlogin.pm,v 1.173 2018/07/04 16:58:19 raeburn Exp $
+# $Id: lonlogin.pm,v 1.174 2018/11/24 16:19:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -106,6 +106,30 @@
 	return OK;
     }
 
+    $env{'form.firsturl'} =~ s/(`)/'/g;
+
+# Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
+
+    my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
+    if ($found_server) {
+        my $hostname = &Apache::lonnet::hostname($found_server);
+        if ($hostname ne '') {
+            my $protocol = $Apache::lonnet::protocol{$found_server};
+            $protocol = 'http' if ($protocol ne 'https');
+            my $dest = '/adm/roles';
+            if ($env{'form.firsturl'} ne '') {
+                $dest = $env{'form.firsturl'};
+            }
+            my $url = $protocol.'://'.$hostname.$dest;
+            my $start_page =
+                &Apache::loncommon::start_page('Switching Server ...',undef,
+                                               {'redirect'       => [0,$url],});
+            my $end_page   = &Apache::loncommon::end_page();
+            $r->print($start_page.$end_page);
+            return OK;
+        }
+    }
+
 #
 # If browser sent an old cookie for which the session file had been removed
 # check if configuration for user's domain has a portal URL set.  If so
@@ -123,8 +147,6 @@
         }
     }
 
-    $env{'form.firsturl'} =~ s/(`)/'/g;
-
 # -------------------------------- Prevent users from attempting to login twice
     if ($handle ne '') {
         &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
Index: loncom/auth/lonlogout.pm
diff -u loncom/auth/lonlogout.pm:1.55 loncom/auth/lonlogout.pm:1.56
--- loncom/auth/lonlogout.pm:1.55	Wed Jul  4 16:58:19 2018
+++ loncom/auth/lonlogout.pm	Sat Nov 24 16:19:04 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Logout Handler
 #
-# $Id: lonlogout.pm,v 1.55 2018/07/04 16:58:19 raeburn Exp $
+# $Id: lonlogout.pm,v 1.56 2018/11/24 16:19:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -227,6 +227,13 @@
 $relogmessage
 $end_page
 ENDDOCUMENT
+    if ($env{'request.balancercookie'}) {
+        my ($balancer,$cookie) = split(/:/,$env{'request.balancercookie'});
+        if ((&Apache::lonnet::hostname($balancer)) && ($cookie =~ /^[a-f0-9]{32}$/)) {
+            $cookie = $env{'user.domain'}.'_'.$env{'user.name'}.'_'.$cookie;
+            &Apache::lonnet::delbalcookie($cookie,$balancer);
+        }
+    }
     $r->register_cleanup(\&flush_course_logs);
     return OK; 
 }
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.41 loncom/auth/switchserver.pm:1.42
--- loncom/auth/switchserver.pm:1.41	Wed Jul  4 16:58:19 2018
+++ loncom/auth/switchserver.pm	Sat Nov 24 16:19:04 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Switch Servers Handler
 #
-# $Id: switchserver.pm,v 1.41 2018/07/04 16:58:19 raeburn Exp $
+# $Id: switchserver.pm,v 1.42 2018/11/24 16:19:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -32,6 +32,7 @@
 use Apache::Constants qw(:common);
 use Apache::lonnet;
 use Apache::lonmenu;
+use Digest::MD5 qw(md5_hex);
 use CGI::Cookie();
 use Apache::lonlocal;
 use LONCAPA qw(:DEFAULT :match);
@@ -49,7 +50,7 @@
     }
     my $lonidsdir=$r->dir_config('lonIDsDir');
     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
-    
+
     return $r->dir_config('lonIDsDir')."/$handle.id";
 }
 
@@ -101,7 +102,7 @@
         if ($Apache::lonnet::protocol{$env{'form.otherserver'}} eq 'https') {
             $protocol = $Apache::lonnet::protocol{$env{'form.otherserver'}};
         }
-    } 
+    }
 
     if ($env{'user.name'} eq 'public'
 	&& $env{'user.domain'} eq 'public') {
@@ -176,7 +177,8 @@
             }
         }
     }
-    my %temp=('switchserver' => time.':'.$env{'form.otherserver'},
+    my $now = time;
+    my %temp=('switchserver' => $now.':'.$env{'form.otherserver'},
 	      $env{'form.role'});
     &Apache::lonnet::put('email_status',\%temp);
     my $logmsg = "Switch Server to $env{'form.otherserver'}";
@@ -212,13 +214,42 @@
 	   
 # ---------------------------------------------------------------- Get handover
 
-    my ($is_balancer) = &Apache::lonnet::check_loadbalancing($env{'user.name'},$env{'user.domain'});
+    my $newcookieid;
+    (my $is_balancer,undef,my $setcookie) =
+        &Apache::lonnet::check_loadbalancing($env{'user.name'},$env{'user.domain'});
+    if ($is_balancer && $setcookie && $env{'form.otherserver'}) {
+
+        # Set a balancer cookie unless browser already sent LON-CAPA load balancer
+        # cookie which points at the target server
+        my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
+
+        unless (($found_server eq $env{'form.otherserver'}) &&
+                ($balancer_cookie =~ /^\Q$env{'user.domain'}\E_\Q$env{'user.name'}\E_/)) {
+            my @hosts = &Apache::lonnet::current_machine_ids();
+            my $desthost = $env{'form.otherserver'};
+            unless (grep(/^\Q$desthost\E$/, at hosts)) {
+                my $balancedir=$r->dir_config('lonBalanceDir');
+                $newcookieid = &md5_hex(&md5_hex($now.{}.rand().$$));
+                my $cookie = $env{'user.domain'}.'_'.$env{'user.name'}.'_'.$newcookieid;
+                my $balcookie = "balanceID=$cookie; path=/; HttpOnly;";
+                if (open(my $fh,'>',"$balancedir/$cookie.id")) {
+                    print $fh $env{'form.otherserver'};
+                    close($fh);
+                }
+                $r->headers_out->add('Set-cookie' => $balcookie);
+            }
+        }
+    }
+
     my %info=('ip'       => $ENV{'REMOTE_ADDR'},
 	      'domain'   => $env{'user.domain'},
 	      'username' => $env{'user.name'},
 	      'role'     => $env{'form.role'},
 	      'server'   => $r->dir_config('lonHostID'),
 	      'balancer' => $is_balancer);
+    if ($newcookieid) {
+        $info{'balcookie'} = $newcookieid;
+    }
     if ($env{'form.origurl'}) {
         $info{'origurl'} = $env{'form.origurl'};
     }
Index: loncom/auth/migrateuser.pm
diff -u loncom/auth/migrateuser.pm:1.34 loncom/auth/migrateuser.pm:1.35
--- loncom/auth/migrateuser.pm:1.34	Wed Jul  4 16:58:19 2018
+++ loncom/auth/migrateuser.pm	Sat Nov 24 16:19:04 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.34 2018/07/04 16:58:19 raeburn Exp $
+# $Id: migrateuser.pm,v 1.35 2018/11/24 16:19:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -69,6 +69,9 @@
             $extra_env{'request.sso.reloginserver'} = 
                 $data->{'sso.reloginserver'};
         }
+        if (($data->{'balancer'}) && ($data->{'server'}) && ($data->{'balcookie'})) {
+            $extra_env{'request.balancercookie'} = $data->{'server'}.':'.$data->{'balcookie'};
+        }
     }
     return \%extra_env;
 }
@@ -217,6 +220,11 @@
                     }
                 }
             }
+            unless ($hosthere) {
+                if (($dataref->{'balancer'}) && ($dataref->{'balcookie'})) {
+                    &Apache::lonnet::delbalcookie($dataref->{'balcookie'},$dataref->{'balancer'});
+                }
+            }
         }
         if ($dataref->{'sso.login'}) {
             $url .= '/adm/roles';
Index: loncom/lond
diff -u loncom/lond:1.550 loncom/lond:1.551
--- loncom/lond:1.550	Mon Oct 29 02:57:30 2018
+++ loncom/lond	Sat Nov 24 16:19:09 2018
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.550 2018/10/29 02:57:30 raeburn Exp $
+# $Id: lond,v 1.551 2018/11/24 16:19:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -65,7 +65,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.550 $'; #' stupid emacs
+my $VERSION='$Revision: 1.551 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -224,6 +224,7 @@
                dcmaildump => {remote => 1, domroles => 1},
                dcmailput => {remote => 1, domroles => 1},
                del => {remote => 1, domroles => 1, enroll => 1, content => 1},
+               delbalcookie => {institutiononly => 1},
                deldom => {remote => 1, domroles => 1}, # not currently used
                devalidatecache => {institutiononly => 1},
                domroleput => {remote => 1, enroll => 1},
@@ -5521,6 +5522,58 @@
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
 
 #
+#  Process the delbalcookie command. This command deletes a balancer
+#  cookie in the lonBalancedir directory created by switchserver
+#
+# Parameters:
+#   $cmd      - Command that got us here.
+#   $cookie   - Cookie to be deleted.
+#   $client   - socket open on the client process.
+#
+# Returns:
+#   1     - Indicating processing should continue.
+# Side Effects:
+#   A cookie file is deleted from the lonBalancedir directory
+#   A reply is sent to the client.
+sub del_balcookie_handler {
+    my ($cmd, $cookie, $client) = @_;
+
+    my $userinput= "$cmd:$cookie";
+
+    chomp($cookie);
+    my $deleted = '';
+    if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
+        my $execdir=$perlvar{'lonBalanceDir'};
+        if (-e "$execdir/$cookie.id") {
+            if (open(my $fh,'<',"$execdir/$cookie.id")) {
+                my $dodelete;
+                while (my $line = <$fh>) {
+                    chomp($line);
+                    if ($line eq $clientname) {
+                        $dodelete = 1;
+                        last;      
+                    }
+                }
+                close($fh); 
+                if ($dodelete) {
+                    if (unlink("$execdir/$cookie.id")) {
+                        $deleted = 1;
+                    }
+                }
+            }
+        }
+    }
+    if ($deleted) {
+        &Reply($client, "ok\n", $userinput);
+    } else {
+        &Failure( $client, "error: ".($!+0)."Unlinking cookie file Failed ".
+                  "while attempting delbalcookie\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0);
+
+#
 #   Processes the setannounce command.  This command
 #   creates a file named announce.txt in the top directory of
 #   the documentn root and sets its contents.  The announce.txt file is
Index: loncom/loncron
diff -u loncom/loncron:1.114 loncom/loncron:1.115
--- loncom/loncron:1.114	Sun Nov 18 22:50:46 2018
+++ loncom/loncron	Sat Nov 24 16:19:09 2018
@@ -2,7 +2,7 @@
 
 # Housekeeping program, started by cron, loncontrol and loncron.pl
 #
-# $Id: loncron,v 1.114 2018/11/18 22:50:46 raeburn Exp $
+# $Id: loncron,v 1.115 2018/11/24 16:19:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -511,6 +511,34 @@
     &log($fh,"<h3>$active open session(s)</h3>");
 }
 
+# -------------------------------------------------------- clean out balanceIDs
+
+sub clean_balanceIDs {
+    my ($fh)=@_;
+    &log($fh,'<hr /><a name="balcookies" /><h2>Session Tokens</h2>');
+    my $cleaned=0;
+    my $active=0;
+    if (-d $perlvar{'lonBalanceDir'}) {
+        while (my $fname=<$perlvar{'balanceDir'}/*.id>) {
+            my ($dev,$ino,$mode,$nlink,
+                $uid,$gid,$rdev,$size,
+                $atime,$mtime,$ctime,
+                $blksize,$blocks)=stat($fname);
+            my $now=time;
+            my $since=$now-$mtime;
+            if ($since>$perlvar{'lonExpire'}) {
+                $cleaned++;
+                &log($fh,"Unlinking $fname<br />");
+                unlink("$fname");
+            } else {
+                $active++;
+            }
+        }
+    }
+    &log($fh,"<p>Cleaned up ".$cleaned." stale balancer files</p>");
+    &log($fh,"<h3>$active unexpired balancer files</h3>");
+}
+
 # ------------------------------------------------ clean out webDAV Session IDs
 sub clean_webDAV_sessionIDs {
     my ($fh)=@_;
@@ -1471,6 +1499,7 @@
 	&log_machine_info($fh);
 	&clean_tmp($fh);
 	&clean_lonIDs($fh);
+        &clean_balanceIDs($fh);
         &clean_webDAV_sessionIDs($fh);
 	&check_httpd_logs($fh);
 	&rotate_lonnet_logs($fh);
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.263 loncom/loncapa_apache.conf:1.264
--- loncom/loncapa_apache.conf:1.263	Wed Jul 18 13:44:55 2018
+++ loncom/loncapa_apache.conf	Sat Nov 24 16:19:09 2018
@@ -2,7 +2,7 @@
 ## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
 ##
 
-# $Id: loncapa_apache.conf,v 1.263 2018/07/18 13:44:55 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.264 2018/11/24 16:19:09 raeburn Exp $
 
 #
 # LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -1733,6 +1733,7 @@
 
 PerlSetVar	 lonVersion  '<!-- VERSION -->'
 PerlSetVar       lonIDsDir    /home/httpd/lonIDs
+PerlSetVar       lonBalanceDir /home/httpd/balanceIDs
 PerlSetVar       lonDAVsessDir /home/httpd/webdav/sessionIDs
 PerlSetVar       lonTabDir    /home/httpd/lonTabs
 PerlSetVar       lonUsersDir  /home/httpd/lonUsers
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.975 doc/loncapafiles/loncapafiles.lpml:1.976
--- doc/loncapafiles/loncapafiles.lpml:1.975	Sat Nov 24 16:00:15 2018
+++ doc/loncapafiles/loncapafiles.lpml	Sat Nov 24 16:19:14 2018
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.975 2018/11/24 16:00:15 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.976 2018/11/24 16:19:14 raeburn Exp $ -->
 
 <!--
 
@@ -498,6 +498,12 @@
 </directory>
 <directory dist='default'>
    <protectionlevel>modest_delete</protectionlevel>
+ <targetdir dist='default'>home/httpd/balanceIDs</targetdir>
+  <categoryname>server standard</categoryname>
+  <description>cookie jar</description>
+</directory>
+<directory dist='default'>
+   <protectionlevel>modest_delete</protectionlevel>
  <targetdir dist='default'>home/httpd/scantron</targetdir>
   <categoryname>server standard</categoryname>
   <description>uploaded scantron forms directory</description>
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1388 loncom/lonnet/perl/lonnet.pm:1.1389
--- loncom/lonnet/perl/lonnet.pm:1.1388	Thu Nov  1 18:20:40 2018
+++ loncom/lonnet/perl/lonnet.pm	Sat Nov 24 16:19:20 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1388 2018/11/01 18:20:40 raeburn Exp $
+# $Id: lonnet.pm,v 1.1389 2018/11/24 16:19:20 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -73,7 +73,7 @@
 use strict;
 use HTTP::Date;
 use Image::Magick;
-
+use CGI::Cookie;
 
 use Encode;
 
@@ -1028,6 +1028,75 @@
     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) = @_;
@@ -1063,7 +1132,7 @@
             if (ref($balancers) eq 'HASH') {
                 next if (exists($balancers->{$lonhost}));
             }
-        }   
+        }
         my $loginvia;
         if ($checkloginvia) {
             $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
@@ -1365,7 +1434,7 @@
 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);
     my $lonhost = $perlvar{'lonHostID'};
     my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1392,7 +1461,7 @@
         }
     }
     if (ref($result) eq 'HASH') {
-        ($is_balancer,$currtargets,$currrules) = 
+        ($is_balancer,$currtargets,$currrules,$setcookie) =
             &check_balancer_result($result, at hosts);
         if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {
@@ -1453,7 +1522,7 @@
             }
         }
         if (ref($result) eq 'HASH') {
-            ($is_balancer,$currtargets,$currrules) = 
+            ($is_balancer,$currtargets,$currrules,$setcookie) =
                 &check_balancer_result($result, at hosts);
             if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {
@@ -1519,20 +1588,22 @@
                 $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);
 }
 
 sub check_balancer_result {
     my ($result, at hosts) = @_;
-    my ($is_balancer,$currtargets,$currrules);
+    my ($is_balancer,$currtargets,$currrules,$setcookie);
     if (ref($result) eq 'HASH') {
         if ($result->{'lonhost'} ne '') {
             my $currbalancer = $result->{'lonhost'};
@@ -1548,12 +1619,13 @@
                     $is_balancer = 1;
                     $currrules = $result->{$key}{'rules'};
                     $currtargets = $result->{$key}{'targets'};
+                    $setcookie = $result->{$key}{'cookie'};
                     last;
                 }
             }
         }
     }
-    return ($is_balancer,$currtargets,$currrules);
+    return ($is_balancer,$currtargets,$currrules,$setcookie);
 }
 
 sub get_loadbalancer_targets {


More information about the LON-CAPA-cvs mailing list