Diff for /loncom/auth/lonauth.pm between versions 1.88 and 1.101.8.7

version 1.88, 2007/07/25 22:35:47 version 1.101.8.7, 2011/09/27 20:18:45
Line 32  use strict; Line 32  use strict;
 use LONCAPA;  use LONCAPA;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use CGI qw(:standard);  use CGI qw(:standard);
 use CGI::Cookie();  
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
 use Crypt::DES;  use Crypt::DES;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonmenu();  use Apache::lonmenu();
   use Apache::createaccount;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonlocal;  use Apache::lonlocal;
   use HTML::Entities;
     
 # ------------------------------------------------------------ Successful login  # ------------------------------------------------------------ Successful login
 sub success {  sub success {
Line 73  sub success { Line 74  sub success {
 # ------------------------------------------------------------ Get cookie ready  # ------------------------------------------------------------ Get cookie ready
     $cookie="lonID=$cookie; path=/";      $cookie="lonID=$cookie; path=/";
 # -------------------------------------------------------- Menu script and info  # -------------------------------------------------------- Menu script and info
       my $destination = $lowerurl;
   
       if (defined($form->{role})) {
           my $envkey = 'user.role.'.$form->{role};
           my $now=time;
           my $then=$env{'user.login.time'};
           my $refresh=$env{'user.refresh.time'};
           if (exists($env{$envkey})) {
               my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus);
               &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
                                            \$trolecode,\$tstatus,\$tstart,\$tend);
               if ($tstatus eq 'is') {
                   $destination  .= ($destination =~ /\?/) ? '&' : '?';
                   my $newrole = &HTML::Entities::encode($form->{role},'"<>&');
                   $destination .= 'selectrole=1&'.$newrole.'=1';
               }
           }
       }
       if (defined($form->{symb})) {
           my $destsymb = $form->{symb};
           $destination  .= ($destination =~ /\?/) ? '&' : '?';
           if ($destsymb =~ /___/) {
               # FIXME Need to deal with encrypted symbs and urls as needed.
               my ($map,$resid,$desturl)=split(/___/,$destsymb);
               unless ($desturl=~/^(adm|uploaded|editupload|public)/) {
                   $desturl = &Apache::lonnet::clutter($desturl);
               }
               $desturl = &HTML::Entities::encode($desturl,'"<>&');
               $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
               $destination .= '&destinationurl='.$desturl.
                               '&destsymb='.$destsymb;
           } else {
               $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
               $destination .= '&destinationurl='.$destsymb;
           }
       }
   
     my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});      my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
     my $startupremote=&Apache::lonmenu::startupremote($lowerurl);      my $startupremote=&Apache::lonmenu::startupremote($destination);
     my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl);      my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl);
     my $setflags=&Apache::lonmenu::setflags();      my $setflags=&Apache::lonmenu::setflags();
     my $maincall=&Apache::lonmenu::maincall();      my $maincall=&Apache::lonmenu::maincall();
       my $brcrum = [{'href' => '',
                      'text' => 'Successful Login'},];
     my $start_page=&Apache::loncommon::start_page('Successful Login',      my $start_page=&Apache::loncommon::start_page('Successful Login',
   $startupremote,                                                    $startupremote,
   {'no_inline_link' => 1,});                                                    {'no_inline_link' => 1,
                                                      'bread_crumbs' => $brcrum,});
     my $end_page  =&Apache::loncommon::end_page();      my $end_page  =&Apache::loncommon::end_page();
   
     my $continuelink;      my $continuelink;
     if (($env{'browser.interface'} eq 'textual') ||      if ($env{'environment.remote'} eq 'off') {
         ($env{'environment.remote'} eq 'off')) {   $continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
  $continuelink="<a href=\"$lowerurl\">".&mt('Continue')."</a>";  
     }      }
 # ------------------------------------------------- Output for successful login  # ------------------------------------------------- Output for successful login
   
Line 96  sub success { Line 136  sub success {
   
     my %lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
        'wel' => 'Welcome',         'wel' => 'Welcome',
        'mes' => 'Welcome to the Learning<i>Online</i> Network with CAPA. Please wait while your session is being set up',         'mes' => 'Welcome to the Learning<i>Online</i> Network with CAPA. Please wait while your session is being set up.',
        'pro' => 'Problems',         'pro' => 'Login problems?',
        'log' => 'loginproblems.html',         'log' => 'loginproblems.html',
        );         );
     $r->print(<<ENDSUCCESS);      $r->print(<<ENDSUCCESS);
Line 105  $start_page Line 145  $start_page
 $setflags  $setflags
 $windowinfo  $windowinfo
 <h1>$lt{'wel'}</h1>  <h1>$lt{'wel'}</h1>
 $lt{'mes'}.<p>  $lt{'mes'}<p>
 <a href="/adm/$lt{'log'}">$lt{'pro'}?</a></p>  <a href="/adm/$lt{'log'}">$lt{'pro'}</a></p>
 $remoteinfo  $remoteinfo
 $maincall  $maincall
 $continuelink  $continuelink
Line 120  sub failed { Line 160  sub failed {
     my ($r,$message,$form) = @_;      my ($r,$message,$form) = @_;
     my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,      my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,
     {'no_inline_link' => 1,});      {'no_inline_link' => 1,});
       my $retry = '/adm/login?username='.$form->{'uname'}.
                   '&domain='.$form->{'udom'};
       if (exists($form->{role})) {
           $retry .= '&role='.$form->{role};
       }
       if (exists($form->{symb})) {
           $retry .= '&symb='.$form->{symb};
       }
     my $end_page   = &Apache::loncommon::end_page();      my $end_page   = &Apache::loncommon::end_page();
   
     $message = &mt($message);  
     my %lt=('sorry'  => &mt('Sorry ...'),  
     'please' =>   
     &mt('Please [_1]log in again[_2].',  
  "<a href=\"/adm/login?username=$form->{'uname'}&domain=$form->{'udom'}\">",  
  '</a>'),  
     'problemspage' => &mt('loginproblems.html'),  
     'problems'     => 'Problems',  
     );  
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
       $r->print(
     $r->print(<<ENDFAILED);         $start_page
 $start_page        .'<h1>'.&mt('Sorry ...').'</h1>'
 <h1>$lt{'sorry'}</h1>        .'<p class="LC_warning">'.&mt($message).'</p>'
 <p><b>$message</b></p>        .'<p>'.&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>')
 <p>$lt{'please'}</p>        .'</p>'
 <p>        .'<p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'
 <a href="/adm/$lt{'problemspage'}">$lt{'problems'}</a></p>        .$end_page
 $end_page      );
 ENDFAILED   }
 }  
   
 # ------------------------------------------------------------------ Rerouting!  # ------------------------------------------------------------------ Rerouting!
   
Line 151  sub reroute { Line 188  sub reroute {
     my ($r) = @_;      my ($r) = @_;
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
     my $msg='<h1>Sorry ...</h1>      my $msg='<h1>'.&mt('Sorry ...').'</h1>'
              Please <a href="/">log in again</a>.';             .&mt('Please [_1]log in again[_2].');
     &Apache::loncommon::simple_error_page($r,'Rerouting',$msg);      &Apache::loncommon::simple_error_page($r,'Rerouting',$msg);
 }  }
   
Line 170  sub handler { Line 207  sub handler {
     &Apache::lonlocal::get_language_handle($r);      &Apache::lonlocal::get_language_handle($r);
   
 # -------------------------------- Prevent users from attempting to login twice  # -------------------------------- Prevent users from attempting to login twice
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));      my $handle = &Apache::lonnet::check_for_valid_session($r);
     my $lonid=$cookies{'lonID'};      if ($handle ne '') {
     my $cookie;  
     if ($lonid) {  
  my $handle=&LONCAPA::clean_handle($lonid->value);  
         my $lonidsdir=$r->dir_config('lonIDsDir');          my $lonidsdir=$r->dir_config('lonIDsDir');
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {          if ($handle=~/^publicuser\_/) {
   # For "public user" - remove it, we apparently really want to login
               unlink($r->dir_config('lonIDsDir')."/$handle.id");
           } else {
 # Indeed, a valid token is found  # Indeed, a valid token is found
     &Apache::loncommon::content_type($r,'text/html');              &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
     $r->send_http_header;              &Apache::loncommon::content_type($r,'text/html');
     my $start_page =               $r->send_http_header;
  &Apache::loncommon::start_page('Already logged in');              my $start_page =
     my $end_page =                   &Apache::loncommon::start_page('Already logged in');
  &Apache::loncommon::end_page();              my $end_page =
     $r->print(<<ENDFAILED);                  &Apache::loncommon::end_page();
 $start_page              my $dest = '/adm/roles';
 <h1>You are already logged in</h1>              if ($env{'form.firsturl'} ne '') {
 <p>Please either <a href="/adm/roles">continue the current session</a> or                  $dest = $env{'form.firsturl'};
 <a href="/adm/logout">logout</a>.</p>              }
 <p>              $r->print(
 <a href="/adm/loginproblems.html">Problems?</a></p>                 $start_page
 $end_page                .'<h1>'.&mt('You are already logged in!').'</h1>'
 ENDFAILED                .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
            return OK;                      ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
  }                .'</p>'
                 .$end_page
               );
               return OK;
           }
     }      }
   
 # ---------------------------------------------------- No valid token, continue  # ---------------------------------------------------- No valid token, continue
Line 228  ENDFAILED Line 269  ENDFAILED
     my $role   = $r->dir_config('lonRole');      my $role   = $r->dir_config('lonRole');
     my $domain = $r->dir_config('lonDefDomain');      my $domain = $r->dir_config('lonDefDomain');
     my $prodir = $r->dir_config('lonUsersDir');      my $prodir = $r->dir_config('lonUsersDir');
       my $contact_name = &mt('LON-CAPA helpdesk');
   
 # ---------------------------------------- Get the information from login token  # ---------------------------------------- Get the information from login token
   
     my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},      my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
                                       $form{'serverid'});                                        $form{'serverid'});
   
     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {      if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
          ($tmpinfo eq 'no_such_host')) {
  &failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);   &failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
         return OK;          return OK;
     } else {      } else {
Line 246  ENDFAILED Line 289  ENDFAILED
     return OK;      return OK;
  }   }
     }      }
     my ($key,$firsturl)=split(/&/,$tmpinfo);  
       if (!&Apache::lonnet::domain($form{'udom'})) {
           &failed($r,'The domain you provided is not a valid LON-CAPA domain.',\%form);
           return OK;
       }
   
       my ($key,$firsturl,$rolestr,$symbstr)=split(/&/,$tmpinfo);
       if ($rolestr) {
           $rolestr = &unescape($rolestr);
       }
       if ($symbstr) {
           $symbstr= &unescape($symbstr);
       }
       if ($rolestr =~ /^role=/) {
           (undef,$form{'role'}) = split('=',$rolestr);
       }
       if ($symbstr =~ /^symb=/) { 
           (undef,$form{'symb'}) = split('=',$symbstr);
       }
   
     my $keybin=pack("H16",$key);      my $keybin=pack("H16",$key);
   
Line 270  ENDFAILED Line 331  ENDFAILED
     }      }
   
 # ---------------------------------------------------------------- Authenticate  # ---------------------------------------------------------------- Authenticate
     my $authhost=Apache::lonnet::authenticate($form{'uname'},      my @cancreate;
                                               $upass,      my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
                                               $form{'udom'});      if (ref($domconfig{'usercreation'}) eq 'HASH') {
           if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
               if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                   @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}};
               } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') && 
                        ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) {
                   @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'});
               }
           }
       }
       my $defaultauth;
       if (grep(/^login$/,@cancreate)) {
           $defaultauth = 1;
       }
       my $clientcancheckhost = 1;
       my $authhost=Apache::lonnet::authenticate($form{'uname'},$upass,
                                                 $form{'udom'},$defaultauth,
                                                 $clientcancheckhost);
           
 # --------------------------------------------------------------------- Failed?  # --------------------------------------------------------------------- Failed?
   
Line 280  ENDFAILED Line 358  ENDFAILED
  &failed($r,'Username and/or password could not be authenticated.',   &failed($r,'Username and/or password could not be authenticated.',
  \%form);   \%form);
         return OK;          return OK;
       } elsif ($authhost eq 'no_account_on_host') {
           my %domconfig = 
               &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
           if (grep(/^login$/,@cancreate)) {
               my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
               unless (&check_can_host($r,\%form,'no_account_on_host',$domdesc)) {
                   return OK;     
               }
               my $start_page = 
                   &Apache::loncommon::start_page('Create a user account in LON-CAPA',
                                                  '',{'no_inline_link'   => 1,});
               my $lonhost = $r->dir_config('lonHostID');
               my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
               my $contacts = 
                   &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                                                           $form{'udom'},$origmail);
               my ($contact_email) = split(',',$contacts); 
               my $output = &Apache::createaccount::username_check($form{'uname'}, 
                                                                   $form{'udom'},$domdesc,'',
                                                                   $lonhost,$contact_email,$contact_name);
               &Apache::loncommon::content_type($r,'text/html');
               $r->send_http_header;
               &Apache::createaccount::print_header($r,$start_page);
               $r->print('<h3>'.&mt('Account creation').'</h3>'.
                         &mt('Although your username and password were authenticated, you do not currently have a LON-CAPA account at this institution.').'<br />'.
                         $output.&Apache::loncommon::end_page());
               return OK;
           } else {
               &failed($r,'Although your username and password were authenticated, you do not currently have a LON-CAPA account in this domain, and you are not permitted to create one.',\%form);
               return OK;
           }
     }      }
   
     if (($firsturl eq '') ||       if (($firsturl eq '') || 
Line 310  ENDFAILED Line 419  ENDFAILED
     }      }
   
     if ($r->dir_config("lonBalancer") eq 'yes') {      if ($r->dir_config("lonBalancer") eq 'yes') {
  &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,          my $otherserver = &Apache::lonnet::spareserver(30000,undef,1,$form{'udom'});
  \%form);          if (!$otherserver) {
  $r->internal_redirect('/adm/switchserver');              ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
           }
           if ($otherserver) {
               &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
                        \%form);
               $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl);
           } else {
               $r->print(&noswitch());
           }
           return OK;
     } else {      } else {
  &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,          if (!&check_can_host($r,\%form,$authhost)) {
  \%form);              my ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
               if ($otherserver) {
                   &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
                            \%form);
                   $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl);
               } else {
                   $r->print(&noswitch());
               }
               return OK;
           }
   # ------------------------------------------------------- Do the load balancing
   
   # ---------------------------------------------------------- Determine own load
           my $loadlim = $r->dir_config('lonLoadLim');
           my $loadavg;
           {
               my $loadfile=Apache::File->new('/proc/loadavg');
               $loadavg=<$loadfile>;
           }
           $loadavg =~ s/\s.*//g;
           my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
           my $userloadpercent=&Apache::lonnet::userload();
   
   # ---------------------------------------------------------- Are we overloaded?
           if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
               my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'});
               if (!$unloaded) {
                   ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
               }
               if ($unloaded) {
                   &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',
                            undef,\%form);
                   $r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl);
                   return OK;
               }
           }
           &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
                    \%form);
           return OK;
       }
   }
   
   sub check_can_host {
       my ($r,$form,$authhost,$domdesc) = @_;
       return unless (ref($form) eq 'HASH');
       my $canhost = 1;
       my $lonhost = $r->dir_config('lonHostID');
       my $udom = $form->{'udom'};
       my @intdoms;
       my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
       if (ref($internet_names) eq 'ARRAY') {
           @intdoms = @{$internet_names};
       }
       my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
       my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
       unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
           my $machine_dom = &Apache::lonnet::host_domain($lonhost);
           my $hostname = &Apache::lonnet::hostname($lonhost);
           my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
           my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
           my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
           my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
           my $loncaparev;
           if ($authhost eq 'no_account_on_host') {
               $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom);
           } else {
               $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom,$lonhost);
           }
           $canhost = &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
                                                        $udomdefaults{'remotesessions'},
                                                        $defdomdefaults{'hostedsessions'});
       }
       unless ($canhost) {
           if ($authhost eq 'no_account_on_host') {
               my $checkloginvia = 1;
               my ($login_host,$hostname) =
                   &Apache::lonnet::choose_server($udom,$checkloginvia);
               &Apache::loncommon::content_type($r,'text/html');
               $r->send_http_header;
               if ($login_host ne '') {
                   my $protocol = $Apache::lonnet::protocol{$login_host};
                   $protocol = 'http' if ($protocol ne 'https');
                   my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
                   $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
                             '<h3>'.&mt('Account creation').'</h3>'.
                             &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
                             '<p>'.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'</p>'.
                             '<p>'.&mt('[_1]Log in[_2]','<a href="'.$newurl.'">','</a>').
                             &Apache::loncommon::end_page());
               } else {
                   $r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable').
                             '<h3>'.&mt('Account creation unavailable').'</h3>'.
                             &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
                             '<p>'.&mt('Currently a LON-CAPA server is not available within the [_1] domain for you to log-in to, to create an account.',$domdesc).'</p>'.
                             &Apache::loncommon::end_page());
               }
           } else {
               &success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef,
                        $form);
               my ($otherserver) = &Apache::lonnet::choose_server($udom);
               $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
           }
     }      }
     return OK;      return $canhost;
   }
   
   sub noswitch {
       my $result = &Apache::loncommon::start_page('Access to LON-CAPA unavailable').
                    '<h3>'.&mt('Session unavailable').'</h3>'.
                    &mt('This LON-CAPA server is unable to host your session.').'<br />'.
                    '<p>'.&mt('Currently no other LON-CAPA server is available to host your session either.').'</p>'.
                    &Apache::loncommon::end_page();
       return $result;
 }  }
   
 1;  1;

Removed from v.1.88  
changed lines
  Added in v.1.101.8.7


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.