[BACK]Return to lonauth.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonauth.pm between versions 1.62 and 1.121.2.13

version 1.62, 2004/03/16 20:42:50 version 1.121.2.13, 2015/01/26 22:25:41
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 5/21/99,5/22,5/25,5/26,5/27,5/29,6/2,6/11,6/14,6/15  
 # 16/11,12/16,  
 # 1/14,2/24,2/28,2/29,3/7,5/29,5/30,5/31,6/1,6/5,6/29,  
 # 7/1,7/10,10/2,10/5,10/9,10/26,10/30,11/10,  
 # 05/28,05/29 Gerd Kortemeyer  
 # 07/28,08/03 Gerd Kortemeyer  
 # 8/20 Gerd Kortemeyer  
   
 package Apache::lonauth;  package Apache::lonauth;
   
 use strict;  use strict;
   use LONCAPA;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::File;  
 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 Apache::File();
 my %FORM;  use HTML::Entities;
    
 # ------------------------------------------------------------ Successful login  # ------------------------------------------------------------ Successful login
   
 sub success {  sub success {
     my ($r, $username, $domain, $authhost,$lowerurl) = @_;      my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
     my $lonids=$r->dir_config('lonIDsDir');   $form) = @_;
   
 # See if old ID present, if so, remove  
   
     my $filename;  
     opendir(DIR,$lonids);  
     while ($filename=readdir(DIR)) {  
        if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {  
   unlink($lonids.'/'.$filename);  
        }  
     }  
     closedir(DIR);  
   
 # Give them a new cookie  # ------------------------------------------------------------ Get cookie ready
       my $cookie =
     my $cookie;   &Apache::loncommon::init_user_environment($r, $username, $domain,
     my $now=time;    $authhost, $form,
     $cookie="$username\_$now\_$domain\_$authhost";    {'extra_env' => $extra_env,});
   
 # Initialize roles  
   
     my $userroles=Apache::lonnet::rolesinit($domain,$username,$authhost);  
   
 # ------------------------------------ Check browser type and MathML capability  
   
     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      my $public=($username eq 'public' && $domain eq 'public');
         $clientunicode,$clientos) = &Apache::loncommon::decode_user_agent($r);  
   
 # -------------------------------------- Any accessibility options to remember?      if ($public or $lowerurl eq 'noredirect') { return $cookie; }
     if (($FORM{'interface'}) && ($FORM{'remember'} eq 'true')) {  
  foreach ('imagesuppress','appletsuppress',  
  'embedsuppress','fontenhance','blackwhite') {  
     if ($FORM{$_} eq 'true') {  
  &Apache::lonnet::put('environment',{$_ => 'on'},  
      $domain,$username);  
     } else {  
  &Apache::lonnet::del('environment',[$_],$domain,$username);  
     }  
  }  
     }  
 # ------------------------------------------------------------- Get environment  
   
     my $userenv;  
     my %userenv=Apache::lonnet::dump('environment',$domain,$username);  
     my ($tmp) = keys(%userenv);  
     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {  
  foreach my $key (keys(%userenv)) {  
     $userenv.="environment.$key=$userenv{$key}\n";  
  }  
     }  
     if (($userenv{'interface'}) && (!$FORM{'interface'})) {  
  $FORM{'interface'}=$userenv{'interface'};  
     }  
     $ENV{'environment.remote'}=$userenv{'remote'};  
 # --------------- Do not trust query string to be put directly into environment  
     foreach ('imagesuppress','appletsuppress',  
      'embedsuppress','fontenhance','blackwhite',  
      'interface','localpath','localres') {  
  $FORM{$_}=~s/[\n\r\=]//gs;  
     }  
 # --------------------------------------------------------- Write first profile  
   
     {  
  my $idf=Apache::File->new(">$lonids/$cookie.id");  
  unless (flock($idf,LOCK_EX)) {  
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
    'Could not obtain exclusive lock in lonauth: '.$!);  
     $idf->close();  
     return 'error: '.$!;  
  }  
  if ($userenv ne '') { print $idf "$userenv\n"; }  
  print $idf "user.name=$username\n";  
  print $idf "user.domain=$domain\n";  
  print $idf "user.home=$authhost\n";  
  print $idf "browser.type=$clientbrowser\n";  
  print $idf "browser.version=$clientversion\n";  
  print $idf "browser.mathml=$clientmathml\n";  
  print $idf "browser.unicode=$clientunicode\n";  
  print $idf "browser.os=$clientos\n";  
         if ($FORM{'localpath'}) {  
            print $idf "browser.localpath=$FORM{'localpath'}\n";  
            print $idf "browser.localres=$FORM{'localres'}\n";  
         }  
  print $idf "request.course.fn=\n";  
  print $idf "request.course.uri=\n";  
  print $idf "request.course.sec=\n";  
  print $idf "request.role=cm\n";  
         print $idf "request.role.adv=$ENV{'user.adv'}\n";  
  print $idf "request.host=$ENV{'REMOTE_ADDR'}\n";  
  if ($FORM{'interface'}) {  
     $FORM{'interface'}=~s/\W//gs;  
     print $idf "browser.interface=$FORM{'interface'}\n";  
     $ENV{'browser.interface'}=$FORM{'interface'};  
     foreach ('imagesuppress','appletsuppress',  
      'embedsuppress','fontenhance','blackwhite') {  
  if (($FORM{$_} eq 'true') ||  
     ($userenv{$_} eq 'on')) {  
     print $idf "browser.$_=on\n";  
  }  
     }  
  }  
  if ($userroles ne '') { print $idf "$userroles"; }  
  $idf->close();  
     }  
     $ENV{'request.role'}='cm';  
     $ENV{'request.role.adv'}=$ENV{'user.adv'};  
     $ENV{'browser.type'}=$clientbrowser;  
 # -------------------------------------------------------------------- Log this  # -------------------------------------------------------------------- Log this
   
     &Apache::lonnet::log($domain,$username,$authhost,      &Apache::lonnet::log($domain,$username,$authhost,
Line 176  sub success { Line 73  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 $windowinfo=&Apache::lonmenu::open($clientos);      my $destination = $lowerurl;
     my $startupremote=&Apache::lonmenu::startupremote($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'};
           my $update=$env{'user.update.time'};
           if (!$update) {
               $update = $then;
           }
           if (exists($env{$envkey})) {
               my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus);
               &Apache::lonnet::role_status($envkey,$update,$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);
               $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;
           }
       }
       if ($destination =~ m{^/adm/roles}) {
           $destination  .= ($destination =~ /\?/) ? '&' : '?';
           $destination .= 'source=login';
       }
   
       my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
       my $startupremote=&Apache::lonmenu::startupremote($destination);
       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 $bodytag=&Apache::loncommon::bodytag('Successful Login');      my $brcrum = [{'href' => '',
     my $add=&addcontent();                     'text' => 'Successful Login'},];
       my $start_page=&Apache::loncommon::start_page('Successful Login',
                                                     $startupremote,
                                                     {'no_inline_link' => 1,
                                                      'bread_crumbs' => $brcrum,});
       my $end_page  =&Apache::loncommon::end_page();
   
       my $continuelink;
       if ($env{'environment.remote'} eq 'off') {
    $continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
       }
 # ------------------------------------------------- Output for successful login  # ------------------------------------------------- Output for successful login
   
     $r->send_cgi_header(<<ENDHEADER);      &Apache::loncommon::content_type($r,'text/html');
 Content-type: text/html$add      $r->header_out('Set-cookie' => $cookie);
 Set-cookie: $cookie      $r->send_http_header;
   
 ENDHEADER  
     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',         'pro' => 'Login problems?',
        'pro' => 'Problems',  
        'log' => 'loginproblems.html',  
        );         );
       my $loginhelp = &loginhelpdisplay($domain);
       if ($loginhelp) {
           $loginhelp = '<p><a href="'.$loginhelp.'">'.$lt{'pro'}.'</a></p>';
       }
   
       my $welcome = &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>'); 
     $r->print(<<ENDSUCCESS);      $r->print(<<ENDSUCCESS);
 <html>  $start_page
 <head>  
 <title>Successful Login to the LearningOnline Network with CAPA</title>  
 $startupremote  
 </head>  
 $bodytag  
 $setflags  $setflags
 $windowinfo  $windowinfo
 <h1>$lt{'wel'}</h1>  <h1>$lt{'wel'}</h1>
 $lt{'mes'}.<p>  $welcome
 <a href="/adm/$lt{'log'}">$lt{'pro'}?</a></p>  $loginhelp
   $remoteinfo
 $maincall  $maincall
 </body>  $continuelink
 </html>  $end_page
 ENDSUCCESS  ENDSUCCESS
       return;
 }  }
   
 # --------------------------------------------------------------- Failed login!  # --------------------------------------------------------------- Failed login!
   
 sub failed {  sub failed {
     my ($r,$message) = @_;      my ($r,$message,$form) = @_;
     my $bodytag=&Apache::loncommon::bodytag('Unsuccessful Login');      (undef,undef,undef,my $clientmathml,my $clientunicode) =
     my $add=&addcontent();          &Apache::loncommon::decode_user_agent();
     $r->send_cgi_header(<<ENDFHEADER);      my $args = {};
 Content-type: text/html$add      if ($clientunicode && !$clientmathml) {
           $args = {'browser.unicode' => 1};
 ENDFHEADER      }
     $r->print(<<ENDFAILED);  
 <html>      my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args);
 <head>      my $uname = &Apache::loncommon::cleanup_html($form->{'uname'});
 <title>Unsuccessful Login to the LearningOnline Network with CAPA</title>      my $udom = &Apache::loncommon::cleanup_html($form->{'udom'});
 </head>      if (&Apache::lonnet::domain($udom,'description') eq '') {
 $bodytag          undef($udom);
 <h1>Sorry ...</h1>      }
 <p><b>$message</b></p>      my $retry = '/adm/login';
 <p>Please <a href="/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}">log in again</a>.</p>      if ($uname eq $form->{'uname'}) {
 <p>          $retry .= '?username='.$uname;
 <a href="/adm/loginproblems.html">Problems?</a></p>      }
 </body>      if ($udom) {
 </html>          $retry .= (($retry=~/\?/)?'&amp;':'?').'domain='.$udom;
 ENDFAILED      }
 }      if (exists($form->{role})) {
           my $role = &Apache::loncommon::cleanup_html($form->{role});
 # --------------------------------------------------------------------- Charset          if ($role ne '') {
               $retry .= (($retry=~/\?/)?'&amp;':'?').'role='.$role;
 sub addcontent {          }
     my $encoding=&Apache::lonlocal::current_encoding;  
     if ($encoding) {  
  return '; charset='.$encoding;  
     } else {  
  return '';  
     }      }
 }      if (exists($form->{symb})) {
           my $symb = &Apache::loncommon::cleanup_html($form->{symb});
           if ($symb ne '') {
               $retry .= (($retry=~/\?/)?'&amp;':'?').'symb='.$symb;
           }
       }
       my $end_page = &Apache::loncommon::end_page();
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
       my @actions =
            (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
       my $loginhelp = &loginhelpdisplay($udom);
       if ($loginhelp) {
           push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>');
       }
       #FIXME: link to helpdesk might be added here
   
       $r->print(
          $start_page
         .'<h2>'.&mt('Sorry ...').'</h2>'
         .&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'<br /><br />'
         .&Apache::lonhtmlcommon::actionbox(\@actions)
         .$end_page
       );
    }
   
 # ------------------------------------------------------------------ Rerouting!  # ------------------------------------------------------------------ Rerouting!
   
 sub reroute {  sub reroute {
     my $r=shift;      my ($r) = @_;
     my $bodytag=&Apache::loncommon::bodytag('Rerouting');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_cgi_header(<<ENDRFHEADER);      $r->send_http_header;
 Content-type: text/html      my $msg='<b>'.&mt('Sorry ...').'</b><br />'
              .&mt('Please [_1]log in again[_2].');
 ENDRFHEADER      &Apache::loncommon::simple_error_page($r,'Rerouting',$msg,{'no_auto_mt_msg' => 1});
     $r->print(<<ENDRFAILED);  
 <html>  
 <head>  
 <title>Rerouting Login to the LearningOnline Network with CAPA</title>  
 </head>  
 $bodytag  
 <h1>Sorry ...</h1>  
 Please <a href="/">log in again</a>.  
 </body>  
 </html>  
 ENDRFAILED  
 }  }
   
 # ---------------------------------------------------------------- Main handler  # ---------------------------------------------------------------- Main handler
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
       my $londocroot = $r->dir_config('lonDocRoot');
       my $form;
 # Are we re-routing?  # Are we re-routing?
     if (-e '/home/httpd/html/lon-status/reroute.txt') {      if (-e "$londocroot/lon-status/reroute.txt") {
  &reroute($r);   &reroute($r);
  return OK;   return OK;
     }      }
Line 289  sub handler { Line 248  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=$lonid->value;  
         $handle=~s/\W//g;  
         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
     $r->send_cgi_header(<<ENDFHEADER);              &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
 Content-type: text/html      &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
 ENDFHEADER      my $start_page = 
     my $bodytag=&Apache::loncommon::bodytag('Already logged in');          &Apache::loncommon::start_page('Already logged in');
     $r->print(<<ENDFAILED);      my $end_page = 
 <html>          &Apache::loncommon::end_page();
 <head>              my $dest = '/adm/roles';
 <title>Already logged in</title>              if ($env{'form.firsturl'} ne '') {
 </head>                  $dest = $env{'form.firsturl'};
 $bodytag              }
 <h1>You are already logged in</h1>              $r->print(
 <p>Please either <a href="/adm/roles">continue the current session</a> or                 $start_page
 <a href="/adm/logout">logout</a>.</p>                .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
 <p>                .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
 <a href="/adm/loginproblems.html">Problems?</a></p>                      ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
 </body>                .'</p>'
 </html>                .$end_page
 ENDFAILED              );
            return OK;              return OK;
  }          }
     }      }
   
 # ---------------------------------------------------- No valid token, continue  # ---------------------------------------------------- No valid token, continue
   
   
     my $buffer;      my $buffer;
     $r->read($buffer,$r->header_in('Content-length'),0);      if ($r->header_in('Content-length') > 0) {
     my @pairs=split(/&/,$buffer);   $r->read($buffer,$r->header_in('Content-length'),0);
     my $pair; my $name; my $value;      }
     undef %FORM;      my %form;
     %FORM=();      foreach my $pair (split(/&/,$buffer)) {
     foreach $pair (@pairs) {         my ($name,$value) = split(/=/,$pair);
        ($name,$value) = split(/=/,$pair);  
        $value =~ tr/+/ /;         $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        $FORM{$name}=$value;         $form{$name}=$value;
     }       }
   
     if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) {      if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
  failed($r,'Username, password and domain need to be specified.');   &failed($r,'Username, password and domain need to be specified.',
    \%form);
         return OK;          return OK;
     }      }
   
 # split user logging in and "su"-user  # split user logging in and "su"-user
   
     ($FORM{'uname'},$FORM{'suname'})=split(/\:/,$FORM{'uname'});      ($form{'uname'},$form{'suname'})=split(/\:/,$form{'uname'});
     $FORM{'uname'} =~ s/\W//g;      $form{'uname'} = &LONCAPA::clean_username($form{'uname'});
     $FORM{'suname'} =~ s/\W//g;      $form{'suname'}= &LONCAPA::clean_username($form{'suname'});
     $FORM{'udom'}  =~ s/\W//g;      $form{'udom'}  = &LONCAPA::clean_domain(  $form{'udom'});
   
     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') || 
  failed($r,'Information needed to verify your login information is missing, inaccessible or expired.');          ($tmpinfo eq 'no_such_host')) {
    &failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
         return OK;          return OK;
     } else {      } else {
         unless (&Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'},   my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'},
                                          $FORM{'serverid'}) eq 'ok') {     $form{'serverid'});
             &failed($r,'Session could not be opened.');          if ( $reply ne 'ok' ) {
               &failed($r,'Session could not be opened.',\%form);
       &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token");
       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,$iptokenstr)=split(/&/,$tmpinfo);
       if ($rolestr) {
           $rolestr = &unescape($rolestr);
       }
       if ($symbstr) {
           $symbstr= &unescape($symbstr);
       }
       if ($iptokenstr) {
           $iptokenstr = &unescape($iptokenstr);
       }
       if ($rolestr =~ /^role=/) {
           (undef,$form{'role'}) = split('=',$rolestr);
       }
       if ($symbstr =~ /^symb=/) { 
           (undef,$form{'symb'}) = split('=',$symbstr);
       }
       if ($iptokenstr =~ /^iptoken=/) {
           (undef,$form{'iptoken'}) = split('=',$iptokenstr);
       }
   
     my $keybin=pack("H16",$key);      my $keybin=pack("H16",$key);
   
Line 378  ENDFAILED Line 365  ENDFAILED
     else {      else {
  $cipher=new DES $keybin;   $cipher=new DES $keybin;
     }      }
       my $upass='';
       for (my $i=0;$i<=2;$i++) {
    my $chunk=
       $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},0,16))));
   
     my $upass=$cipher->decrypt(   $chunk.=
        unpack("a8",pack("H16",substr($FORM{'upass'},0,16))));      $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},16,16))));
   
     $upass.=$cipher->decrypt(  
        unpack("a8",pack("H16",substr($FORM{'upass'},16,16))));  
   
     $upass=substr($upass,1,ord(substr($upass,0,1)));   $chunk=substr($chunk,1,ord(substr($chunk,0,1)));
    $upass.=$chunk;
       }
   
 # ---------------------------------------------------------------- Authenticate  # ---------------------------------------------------------------- Authenticate
     my $authhost=Apache::lonnet::authenticate($FORM{'uname'},  
                                               $upass,      my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
                                               $FORM{'udom'});      my ($cancreate,$statustocreate) =
           &Apache::createaccount::get_creation_controls($form{'udom'},$domconfig{'usercreation'});
       my $defaultauth;
       if (ref($cancreate) eq 'ARRAY') {
           if (grep(/^login$/,@{$cancreate})) {
               $defaultauth = 1;
           }
       }
       my $clientcancheckhost = 1;
       my $authhost=Apache::lonnet::authenticate($form{'uname'},$upass,
                                                 $form{'udom'},$defaultauth,
                                                 $clientcancheckhost);
           
 # --------------------------------------------------------------------- Failed?  # --------------------------------------------------------------------- Failed?
   
     if ($authhost eq 'no_host') {      if ($authhost eq 'no_host') {
  failed($r,'Username and/or password could not be authenticated.');   &failed($r,'Username and/or password could not be authenticated.',
    \%form);
         return OK;          return OK;
       } elsif ($authhost eq 'no_account_on_host') {
           if ($defaultauth) {
               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,
                                                          undef,$statustocreate);
               &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 '') || 
  ($firsturl=~/^\/adm\/(logout|remote)/)) {   ($firsturl=~/^\/adm\/(logout|remote)/)) {
  $firsturl='/adm/roles';   $firsturl='/adm/roles';
     }      }
   
       my $hosthere;
       if ($form{'iptoken'}) {
           my %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
           my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
           if (($sessiondata{'domain'} eq $form{'udom'}) &&
               ($sessiondata{'username'} eq $form{'uname'})) {
               $hosthere = 1;
           }
       }
   
 # --------------------------------- Are we attempting to login as somebody else?  # --------------------------------- Are we attempting to login as somebody else?
     if ($FORM{'suname'}) {      if ($form{'suname'}) {
 # ------------ see if the original user has enough privileges to pull this stunt  # ------------ see if the original user has enough privileges to pull this stunt
  if (&Apache::lonnet::privileged($FORM{'uname'},$FORM{'udom'})) {   if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'})) {
 # ---------------------------------------------------- see if the su-user exists  # ---------------------------------------------------- see if the su-user exists
     unless (&Apache::lonnet::homeserver($FORM{'suname'},$FORM{'udom'})      unless (&Apache::lonnet::homeserver($form{'suname'},$form{'udom'})
  eq 'no_host') {   eq 'no_host') {
  &Apache::lonnet::logthis(&Apache::lonnet::homeserver($FORM{'suname'},$FORM{'udom'}));   &Apache::lonnet::logthis(&Apache::lonnet::homeserver($form{'suname'},$form{'udom'}));
 # ------------------------------ see if the su-user is not too highly privileged  # ------------------------------ see if the su-user is not too highly privileged
  unless (&Apache::lonnet::privileged($FORM{'suname'},$FORM{'udom'})) {   unless (&Apache::lonnet::privileged($form{'suname'},$form{'udom'})) {
 # -------------------------------------------------------- actually switch users  # -------------------------------------------------------- actually switch users
     &Apache::lonnet::logperm('User '.$FORM{'uname'}.' at '.$FORM{'udom'}.      &Apache::lonnet::logperm('User '.$form{'uname'}.' at '.$form{'udom'}.
  ' logging in as '.$FORM{'suname'});   ' logging in as '.$form{'suname'});
     $FORM{'uname'}=$FORM{'suname'};      $form{'uname'}=$form{'suname'};
  } else {   } else {
     &Apache::lonnet::logthis('Attempted switch user to privileged user');      &Apache::lonnet::logthis('Attempted switch user to privileged user');
  }   }
Line 425  ENDFAILED Line 469  ENDFAILED
     &Apache::lonnet::logthis('Non-privileged user attempting switch user');      &Apache::lonnet::logthis('Non-privileged user attempting switch user');
  }   }
     }      }
     &success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);  
     return OK;      my ($is_balancer,$otherserver);
   
       unless ($hosthere) {
           ($is_balancer,$otherserver) =
               &Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'});
       }
   
       if ($is_balancer) {
           if (!$otherserver) { 
               ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
           }
           if ($otherserver) {
               &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
                        \%form);
               my $switchto = '/adm/switchserver?otherserver='.$otherserver;
               if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
                   $switchto .= '&origurl='.$firsturl;
               }
               if ($form{'role'}) {
                   $switchto .= '&role='.$form{'role'};
               }
               if ($form{'symb'}) {
                   $switchto .= '&symb='.$form{'symb'};
               }
               $r->internal_redirect($switchto);
           } else {
               $r->print(&noswitch());
           }
           return OK;
       } else {
           if (!&check_can_host($r,\%form,$authhost)) {
               my ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
               if ($otherserver) {
                   &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
                            \%form);
                   my $switchto = '/adm/switchserver?otherserver='.$otherserver;
                   if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
                       $switchto .= '&origurl='.$firsturl;
                   }
                   if ($form{'role'}) {
                       $switchto .= '&role='.$form{'role'};
                   }
                   if ($form{'symb'}) {
                       $switchto .= '&symb='.$form{'symb'};
                   }
                   $r->internal_redirect($switchto);
               } 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 $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;
   }
   
   sub loginhelpdisplay {
       my ($authdomain) = @_;
       my $login_help = 1;
       my $lang = &Apache::lonlocal::current_language();
       if ($login_help) {
           my $dom = $authdomain;
           if ($dom eq '') {
               $dom = &Apache::lonnet::default_login_domain();
           }
           my %domconfhash = &Apache::loncommon::get_domainconf($dom);
           my $loginhelp_url;
           if ($lang) {
               $loginhelp_url = $domconfhash{$dom.'.login.helpurl_'.$lang};
               if ($loginhelp_url ne '') {
                   return $loginhelp_url;
               }
           }
           $loginhelp_url = $domconfhash{$dom.'.login.helpurl_nolang'};
           if ($loginhelp_url ne '') {
               return $loginhelp_url;
           } else {
               return '/adm/loginproblems.html';
           }
       }
       return;
 }  }
   
 1;  1;
Removed from v.1.62  
changed lines
  Added in v.1.121.2.13

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.