[LON-CAPA-cvs] cvs: loncom /auth lonlogin.pm

[raeburn]

raeburn		Wed Mar  3 17:00:01 2010 EDT

  Modified files:              
    /loncom/auth	lonlogin.pm 
  Log:
  - More flexibilty in redirection from log-in page for a server in a domain to 
    domain's load balancer or SSO server.
    - Append specified path from domain config to destination hostname.
    - No redirection if client IP is listed as exempt in domain config.
  
  
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.132 loncom/auth/lonlogin.pm:1.133
--- loncom/auth/lonlogin.pm:1.132	Mon Feb  8 13:28:40 2010
+++ loncom/auth/lonlogin.pm	Wed Mar  3 17:00:01 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Login Screen
 #
-# $Id: lonlogin.pm,v 1.132 2010/02/08 13:28:40 bisitz Exp $
+# $Id: lonlogin.pm,v 1.133 2010/03/03 17:00:01 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -121,15 +121,12 @@
 
     my $lonhost = $r->dir_config('lonHostID');
     my $domain = &Apache::lonnet::default_login_domain();
-    my %domconfhash = &Apache::loncommon::get_domainconf($domain);
     if ($lonhost ne '') {
-        my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
-        if (($loginvia ne '') && ($loginvia ne $lonhost)) {
-            if (&Apache::lonnet::hostname($loginvia) ne '') {
-                $r->print(&redirect_page($loginvia));
-                return OK;
-            }
-        }
+        my $redirect = &check_loginvia($domain,$lonhost);
+        if ($redirect) {
+            $r->print($redirect);
+            return OK;
+        } 
     }
 
     if (($env{'form.domain'}) && 
@@ -529,11 +526,53 @@
     return OK;
 }
 
+sub check_loginvia {
+    my ($domain,$lonhost) = @_;
+    if ($domain eq '' || $lonhost eq '') {
+        return;
+    }
+    my %domconfhash = &Apache::loncommon::get_domainconf($domain);
+    my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
+    my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
+    my $output;
+    if ($loginvia ne '') {
+        my $noredirect;
+        my $ip = $ENV{'REMOTE_ADDR'};
+        if ($ip eq '127.0.0.1') {
+            $noredirect = 1;
+        } else {
+            if ($loginvia_exempt ne '') {
+                my @exempt = split(',',$loginvia_exempt);
+                if (grep(/^\Q$ip\E$/,@exempt)) {
+                    $noredirect = 1;
+                }
+            }
+        }
+        unless ($noredirect) {
+            my ($newhost,$path);
+            if ($loginvia =~ /:/) {
+                ($newhost,$path) = split(':',$loginvia);
+            } else {
+                $newhost = $loginvia;
+            }
+            if ($newhost ne $lonhost) {
+                if (&Apache::lonnet::hostname($newhost) ne '') {
+                    $output = &redirect_page($newhost,$path);
+                }
+            }
+        }
+    }
+    return $output;
+}
+
 sub redirect_page {
-    my ($desthost) = @_;
+    my ($desthost,$path) = @_;
     my $protocol = $Apache::lonnet::protocol{$desthost};
     $protocol = 'http' if ($protocol ne 'https');
-    my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).'/';
+    unless ($path =~ m{^/}) {
+        $path = '/'.$path;
+    }
+    my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
     if ($env{'form.firsturl'} ne '') {
         $url .='?firsturl='.$env{'form.firsturl'};
     }