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

[raeburn]

raeburn		Wed Mar 10 02:49:49 2010 EDT

  Modified files:              (Branch: version_2_9_X)
    /loncom/auth	lonlogin.pm 
  Log:
  - Backport 1.126, 1.127, 1.128, 1.133.
  
  
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.106.4.6 loncom/auth/lonlogin.pm:1.106.4.7
--- loncom/auth/lonlogin.pm:1.106.4.6	Fri Mar  5 17:37:21 2010
+++ loncom/auth/lonlogin.pm	Wed Mar 10 02:49:49 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Login Screen
 #
-# $Id: lonlogin.pm,v 1.106.4.6 2010/03/05 17:37:21 raeburn Exp $
+# $Id: lonlogin.pm,v 1.106.4.7 2010/03/10 02:49:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -120,7 +120,16 @@
     my $iconpath= 
 	&Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
 
+    my $lonhost = $r->dir_config('lonHostID');
     my $domain = &Apache::lonnet::default_login_domain();
+    if ($lonhost ne '') {
+        my $redirect = &check_loginvia($domain,$lonhost);
+        if ($redirect) {
+            $r->print($redirect);
+            return OK;
+        }
+    }
+
     if (($env{'form.domain'}) && 
 	(&Apache::lonnet::domain($env{'form.domain'},'description'))) {
 	$domain=$env{'form.domain'};
@@ -128,7 +137,6 @@
     my $role    = $r->dir_config('lonRole');
     my $loadlim = $r->dir_config('lonLoadLim');
     my $servadm = $r->dir_config('lonAdmEMail');
-    my $lonhost = $r->dir_config('lonHostID');
     my $tabdir  = $r->dir_config('lonTabDir');
     my $include = $r->dir_config('lonIncludes');
     my $expire  = $r->dir_config('lonExpire');
@@ -689,6 +697,62 @@
     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,$path) = @_;
+    my $protocol = $Apache::lonnet::protocol{$desthost};
+    $protocol = 'http' if ($protocol ne 'https');
+    unless ($path =~ m{^/}) {
+        $path = '/'.$path;
+    }
+    my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
+    if ($env{'form.firsturl'} ne '') {
+        $url .='?firsturl='.$env{'form.firsturl'};
+    }
+    my $start_page = &Apache::loncommon::start_page('Switching Server',undef,
+                                                    {'redirect' => [0,$url],});
+    my $end_page   = &Apache::loncommon::end_page();
+    return $start_page.$end_page;
+}
+
 sub contactdisplay {
     my ($lt,$servadm,$showadminmail,$version,$authdomain,$helpdeskscript) = @_;
     my $contactblock;