Diff for /loncom/auth/lonlogin.pm between versions 1.172 and 1.180

version 1.172, 2018/01/12 15:26:39 version 1.180, 2020/10/16 23:27:45
Line 37  use Apache::lonauth(); Line 37  use Apache::lonauth();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::migrateuser();  use Apache::migrateuser();
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
 use CGI::Cookie();  use CGI::Cookie();
     
 sub handler {  sub handler {
Line 47  sub handler { Line 47  sub handler {
  (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
       $ENV{'REDIRECT_QUERY_STRING'}),        $ENV{'REDIRECT_QUERY_STRING'}),
  ['interface','username','domain','firsturl','localpath','localres',   ['interface','username','domain','firsturl','localpath','localres',
   'token','role','symb','iptoken']);    'token','role','symb','iptoken','btoken','ltoken','linkkey']);
     if (!defined($env{'form.firsturl'})) {      if (!defined($env{'form.firsturl'})) {
         &Apache::lonacc::get_posted_cgi($r,['firsturl']);          &Apache::lonacc::get_posted_cgi($r,['firsturl']);
     }      }
Line 56  sub handler { Line 56  sub handler {
             $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};              $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
         }          }
     }      }
       if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
           (!$env{'form.ltoken'}) && (!$env{'form.linkkey'})) {
           &Apache::lonacc::get_posted_cgi($r,['linkkey']);
       }
   
 # -- check if they are a migrating user  # -- check if they are a migrating user
     if (defined($env{'form.token'})) {      if (defined($env{'form.token'})) {
Line 64  sub handler { Line 68  sub handler {
   
 # For "public user" - remove any exising "public" cookie, as user really wants to log-in  # For "public user" - remove any exising "public" cookie, as user really wants to log-in
     my ($handle,$lonidsdir,$expirepub,$userdom);      my ($handle,$lonidsdir,$expirepub,$userdom);
       $lonidsdir=$r->dir_config('lonIDsDir');
     unless ($r->header_only) {      unless ($r->header_only) {
         $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);          $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
         if ($handle ne '') {          if ($handle ne '') {
             $lonidsdir=$r->dir_config('lonIDsDir');  
             if ($handle=~/^publicuser\_/) {              if ($handle=~/^publicuser\_/) {
                 unlink($r->dir_config('lonIDsDir')."/$handle.id");                  unlink($r->dir_config('lonIDsDir')."/$handle.id");
                 undef($handle);                  undef($handle);
Line 86  sub handler { Line 90  sub handler {
                                 -expires => '-10y',);                                  -expires => '-10y',);
         $r->header_out('Set-cookie' => $c);          $r->header_out('Set-cookie' => $c);
     } elsif (($handle eq '') && ($userdom ne '')) {      } elsif (($handle eq '') && ($userdom ne '')) {
         my $c = new CGI::Cookie(-name    => 'lonID',          my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
                                 -value   => '',          foreach my $name (keys(%cookies)) {
                                 -expires => '-10y',);              next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
         $r->headers_out->add('Set-cookie' => $c);              my $c = new CGI::Cookie(-name    => $name,
                                       -value   => '',
                                       -expires => '-10y',);
               $r->headers_out->add('Set-cookie' => $c);
           }
     }      }
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
Line 102  sub handler { Line 110  sub handler {
  return OK;   return OK;
     }      }
   
       my $lonhost = $r->dir_config('lonHostID');
       $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 %info = (
                            balcookie => $lonhost.':'.$balancer_cookie,
                          );
               if ($env{'form.ltoken'}) {
                   my %link_info = &Apache::lonnet::tmpget($env{'form.ltoken'});
                   if ($link_info{'linkprot'}) {
                       $info{'linkprot'} = $link_info{'linkprot'};
                   }
                   &Apache::lonnet::tmpdel($env{'form.ltoken'});
                   delete($env{'form.ltoken'});
               } elsif ($env{'form.linkkey'}) {
                   $info{'linkkey'} = $env{'form.linkkey'};
                   delete($env{'form.linkkey'});
               }
               my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
               if ($balancer_token) {
                   $dest .=  (($dest=~/\?/)?'&;':'?') . 'btoken='.$balancer_token;
               }
               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;
           }
       }
   
   #
   # Check if a LON-CAPA load balancer sent user here because user's browser sent
   # it a balancer cookie for an active session on this server.
   #
   
       my ($balcookie,$linkprot,$linkkey);
       if ($env{'form.btoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
           $balcookie = $info{'balcookie'};
           if ($balcookie) {
               if ($info{'linkprot'}) {
                   $linkprot = $info{'linkprot'};
               } elsif ($info{'linkkey'}) {
                   $linkkey = $info{'linkkey'};
               }
           }    
           &Apache::lonnet::tmpdel($env{'form.btoken'});
           delete($env{'form.btoken'});
       }
   
 #  #
 # If browser sent an old cookie for which the session file had been removed  # 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  # check if configuration for user's domain has a portal URL set.  If so
Line 119  sub handler { Line 190  sub handler {
         }          }
     }      }
   
     $env{'form.firsturl'} =~ s/(`)/'/g;  
   
 # -------------------------------- Prevent users from attempting to login twice  # -------------------------------- Prevent users from attempting to login twice
     if ($handle ne '') {      if ($handle ne '') {
         &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);          &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
Line 130  sub handler { Line 199  sub handler {
     &Apache::loncommon::end_page();      &Apache::loncommon::end_page();
         my $dest = '/adm/roles';          my $dest = '/adm/roles';
         if ($env{'form.firsturl'} ne '') {          if ($env{'form.firsturl'} ne '') {
             $dest = $env{'form.firsturl'};              $dest = $env{'form.firsturl'};
           }
           if (($env{'form.ltoken'}) || ($linkprot)) {
               unless ($linkprot) {
                   my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
                   $linkprot = $info{'linkprot'};
                   my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
                   delete($env{'form.ltoken'});
               }
               if ($linkprot) {
                   my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
                   if ($env{'user.linkprotector'}) {
                       my @protectors = split(/,/,$env{'user.linkprotector'});
                       unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
                           push(@protectors,$linkprotector);
                           @protectors = sort { $a <=> $b } @protectors;
                           &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
                   }
                   if ($env{'user.linkproturi'}) {
                       my @proturis = split(/,/,$env{'user.linkproturi'});
                       unless (grep(/^\Q$deeplink\E$/,@proturis)) {
                           push(@proturis,$deeplink);
                           @proturis = sort @proturis;
                           &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
                   }
               }
           } elsif (($env{'form.linkkey'}) || ($linkkey)) {
               if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
                   if ($linkkey eq '') {
                       $linkkey = $env{'form.linkkey'};
                   }
                   if ($env{'user.deeplinkkey'}) {
                       my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
                       unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
                           push(@linkkeys,$linkkey);
                           &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});  
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
                   }
                   my $deeplink = $env{'form.firsturl'};
                   if ($env{'user.keyedlinkuri'}) {
                       my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
                       unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
                           push(@keyeduris,$deeplink);
                           &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
                   }
               }
         }          }
  $r->print(   $r->print(
                   $start_page                    $start_page
Line 168  sub handler { Line 293  sub handler {
     my $iconpath=      my $iconpath=
  &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));   &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
   
     my $lonhost = $r->dir_config('lonHostID');  
     my $domain = &Apache::lonnet::default_login_domain();      my $domain = &Apache::lonnet::default_login_domain();
     my $defdom = $domain;      my $defdom = $domain;
     if ($lonhost ne '') {      if ($lonhost ne '') {
         unless ($sessiondata{'sessionserver'}) {          unless ($sessiondata{'sessionserver'}) {
             my $redirect = &check_loginvia($domain,$lonhost);              my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie,$linkprot);
             if ($redirect) {              if ($redirect) {
                 $r->print($redirect);                  $r->print($redirect);
                 return OK;                  return OK;
Line 182  sub handler { Line 306  sub handler {
     }      }
   
     if (($sessiondata{'domain'}) &&      if (($sessiondata{'domain'}) &&
         (&Apache::lonnet::domain($env{'form.domain'},'description'))) {          (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
         $domain=$sessiondata{'domain'};          $domain=$sessiondata{'domain'};
     } elsif (($env{'form.domain'}) &&      } elsif (($env{'form.domain'}) &&
  (&Apache::lonnet::domain($env{'form.domain'},'description'))) {   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
Line 273  sub handler { Line 397  sub handler {
         }          }
         $tokenextras .= '&iptoken='.&escape($env{'form.iptoken'});          $tokenextras .= '&iptoken='.&escape($env{'form.iptoken'});
     }      }
       if ($env{'form.ltoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
           &Apache::lonnet::tmpdel($env{'form.ltoken'});
           delete($env{'form.ltoken'});
           if ($info{'linkprot'}) {
               if (!$tokenextras) {
                   $tokenextras = '&&&';
               }
               $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
           }
       } elsif ($env{'form.linkkey'}) {
           if (!$tokenextras) {
               $tokenextras = '&&&';
           }
           $tokenextras .= '&linkkey='.&escape($env{'form.linkkey'});
       }
     my $logtoken=Apache::lonnet::reply(      my $logtoken=Apache::lonnet::reply(
        'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,         'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
        $lonhost);         $lonhost);
Line 285  sub handler { Line 425  sub handler {
             &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');              &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
         }          }
         my $spares='';          my $spares='';
  my $last;          my (@sparehosts,%spareservers);
         foreach my $hostid (sort          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
     {          if (ref($sparesref) eq 'HASH') {
  &Apache::lonnet::hostname($a) cmp              foreach my $key (keys(%{$sparesref})) {
     &Apache::lonnet::hostname($b);                  if (ref($sparesref->{$key}) eq 'ARRAY') {
     }                      my @sorted = sort { &Apache::lonnet::hostname($a) cmp
     keys(%Apache::lonnet::spareid)) {                                          &Apache::lonnet::hostname($b);
                                         } @{$sparesref->{$key}};
                       if (@sorted) {
                           if ($key eq 'primary') {
                               unshift(@sparehosts,@sorted);
                           } elsif ($key eq 'default') {
                               push(@sparehosts,@sorted);
                           }
                       }
                   }
               }
           }
           foreach my $hostid (@sparehosts) {
             next if ($hostid eq $lonhost);              next if ($hostid eq $lonhost);
     my $hostname = &Apache::lonnet::hostname($hostid);      my $hostname = &Apache::lonnet::hostname($hostid);
     next if (($last eq $hostname) || ($hostname eq ''));      next if (($hostname eq '') || ($spareservers{$hostname}));
             $spares.='<br /><font size="+1"><a href="http://'.              $spareservers{$hostname} = 1;
               my $protocol = $Apache::lonnet::protocol{$hostid};
               $protocol = 'http' if ($protocol ne 'https');
               $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
                 $hostname.                  $hostname.
                 '/adm/login?domain='.$authdomain.'">'.                  '/adm/login?domain='.$authdomain.'">'.
                 $hostname.'</a>'.                  $hostname.'</a>'.
                 ' '.&mt('(preferred)').'</font>'.$/;                  ' '.&mt('(preferred)').'</span>'.$/;
     $last=$hostname;  
         }          }
         if ($spares) {          if ($spares) {
             $spares.= '<br />';              $spares.= '<br />';
Line 312  sub handler { Line 466  sub handler {
     &Apache::lonnet::hostname($b);      &Apache::lonnet::hostname($b);
     }      }
     keys(%all_hostnames)) {      keys(%all_hostnames)) {
             next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});              next if ($hostid eq $lonhost);
             my $hostname = &Apache::lonnet::hostname($hostid);              my $hostname = &Apache::lonnet::hostname($hostid);
             next if (($last eq $hostname) || ($hostname eq ''));              next if (($hostname eq '') || ($spareservers{$hostname}));
             $spares.='<br /><a href="http://'.              my $protocol = $Apache::lonnet::protocol{$hostid};
               $protocol = 'http' if ($protocol ne 'https');
               $spares.='<br /><a href="'.$protocol.'://'.
              $hostname.               $hostname.
              '/adm/login?domain='.$authdomain.'">'.               '/adm/login?domain='.$authdomain.'">'.
              $hostname.'</a>';               $hostname.'</a>';
             $last=$hostname;  
          }           }
          $r->print(           $r->print(
    '<html>'     '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
   .'<head><title>'    .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
     .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
   .&mt('The LearningOnline Network with CAPA')    .&mt('The LearningOnline Network with CAPA')
   .'</title></head>'    .'</title></head>'
   .'<body bgcolor="#FFFFFF">'    .'<body bgcolor="#FFFFFF">'
   .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'    .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
   .'<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />'    .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
   .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');    .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
         if ($spares) {          if ($spares) {
             $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')              $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
Line 681  ENDDOCUMENT Line 837  ENDDOCUMENT
 }  }
   
 sub check_loginvia {  sub check_loginvia {
     my ($domain,$lonhost) = @_;      my ($domain,$lonhost,$lonidsdir,$balcookie,$linkprot) = @_;
     if ($domain eq '' || $lonhost eq '') {      if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
         return;          return;
     }      }
     my %domconfhash = &Apache::loncommon::get_domainconf($domain);      my %domconfhash = &Apache::loncommon::get_domainconf($domain);
Line 711  sub check_loginvia { Line 867  sub check_loginvia {
             }              }
             if ($newhost ne $lonhost) {              if ($newhost ne $lonhost) {
                 if (&Apache::lonnet::hostname($newhost) ne '') {                  if (&Apache::lonnet::hostname($newhost) ne '') {
                     $output = &redirect_page($newhost,$path);                      if ($balcookie) {
                           my ($balancer,$cookie) = split(/:/,$balcookie);
                           if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) {
                               my ($udom,$uname,$cookieid) = ($1,$2,$3);
                               unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') {
                                   if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) {
                                       while (my $filename=readdir($dh)) {
                                           if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) {
                                               my $handle = $1;
                                               my %hash =
                                                   &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir,
                                                                                        ['request.balancercookie',
                                                                                         'user.linkedenv']);
                                               if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") {
                                                   if (unlink("$lonidsdir/$filename")) {
                                                       if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
                                                           (-l "$lonidsdir/$hash{'user.linkedenv'}.id") &&
                                                           (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) {
                                                           unlink("$lonidsdir/$hash{'user.linkedenv'}.id");
                                                       }
                                                   }
                                               }
                                               last;
                                           }
                                       }
                                       closedir($dh);
                                   }
                               }
                           }
                       }
                       $output = &redirect_page($newhost,$path,$linkprot);
                 }                  }
             }              }
         }          }
Line 720  sub check_loginvia { Line 906  sub check_loginvia {
 }  }
   
 sub redirect_page {  sub redirect_page {
     my ($desthost,$path) = @_;      my ($desthost,$path,$linkprot) = @_;
       my $hostname = &Apache::lonnet::hostname($desthost);
     my $protocol = $Apache::lonnet::protocol{$desthost};      my $protocol = $Apache::lonnet::protocol{$desthost};
     $protocol = 'http' if ($protocol ne 'https');      $protocol = 'http' if ($protocol ne 'https');
     unless ($path =~ m{^/}) {      unless ($path =~ m{^/}) {
         $path = '/'.$path;          $path = '/'.$path;
     }      }
     my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;      my $url = $protocol.'://'.$hostname.$path;
     if ($env{'form.firsturl'} ne '') {      if ($env{'form.firsturl'} ne '') {
         $url .='?firsturl='.$env{'form.firsturl'};          $url .='?firsturl='.$env{'form.firsturl'};
     }      }
       if ($linkprot) {
           my $ltoken = &Apache::lonnet::tmpput({linkprot => $linkprot},$desthost);
           if ($ltoken) {
               $url .= (($url =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
           }
       }
     my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,      my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                                     {'redirect' => [0,$url],});                                                      {'redirect' => [0,$url],});
     my $end_page   = &Apache::loncommon::end_page();      my $end_page   = &Apache::loncommon::end_page();

Removed from v.1.172  
changed lines
  Added in v.1.180


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>