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

Diff for /loncom/auth/lonauth.pm between versions 1.78 and 1.121.2.9

version 1.78, 2006/06/02 20:22:26 version 1.121.2.9, 2014/02/26 20:46: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 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) = @_;
   
     my $public=($username eq 'public' && $domain eq 'public');  
   
 # See if old ID present, if so, remove  
   
     my ($filename,$cookie,$userroles);  
     my $now=time;  
   
     if ($public) {  
  my $max_public=100;  
  my $oldest;  
  my $oldest_time=0;  
  for(my $next=1;$next<=$max_public;$next++) {  
     if (-e $lonids."/publicuser_$next.id") {  
  my $mtime=(stat($lonids."/publicuser_$next.id"))[9];  
  if ($mtime<$oldest_time || !$oldest_time) {  
     $oldest_time=$mtime;  
     $oldest=$next;  
  }  
     } else {  
  $cookie="publicuser_$next";  
  last;  
     }  
  }  
  if (!$cookie) { $cookie="publicuser_$oldest"; }  
     } else {  
  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 =
  $cookie="$username\_$now\_$domain\_$authhost";   &Apache::loncommon::init_user_environment($r, $username, $domain,
         $authhost, $form,
 # Initialize roles    {'extra_env' => $extra_env,});
   
  $userroles=Apache::lonnet::rolesinit($domain,$username,$authhost);  
     }  
 # ------------------------------------ Check browser type and MathML capability  
   
     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,  
         $clientunicode,$clientos) = &Apache::loncommon::decode_user_agent($r);  
   
 # -------------------------------------- Any accessibility options to remember?  
     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=Apache::lonnet::dump('environment',$domain,$username);  
     my ($tmp) = keys(%userenv);  
     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {  
  # default remote control to off  
  if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }  
     } else {  
  undef(%userenv);  
     }  
     if (($userenv{'interface'}) && (!$FORM{'interface'})) {  
  $FORM{'interface'}=$userenv{'interface'};  
     }  
     $env{'environment.remote'}=$userenv{'remote'};  
     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }  
   
 # --------------- Do not trust query string to be put directly into environment      my $public=($username eq 'public' && $domain eq 'public');
     foreach ('imagesuppress','appletsuppress',  
      'embedsuppress','fontenhance','blackwhite',  
      'interface','localpath','localres') {  
  $FORM{$_}=~s/[\n\r\=]//gs;  
     }  
 # --------------------------------------------------------- Write first profile  
   
     {  
  my %initial_env =   
     ("user.name"          => $username,  
      "user.domain"        => $domain,  
      "user.home"          => $authhost,  
      "browser.type"       => $clientbrowser,  
      "browser.version"    => $clientversion,  
      "browser.mathml"     => $clientmathml,  
      "browser.unicode"    => $clientunicode,  
      "browser.os"         => $clientos,  
      "server.domain"      => $r->dir_config('lonDefDomain'),  
      "request.course.fn"  => '',  
      "request.course.uri" => '',  
      "request.course.sec" => '',  
      "request.role"       => 'cm',  
      "request.role.adv"   => $env{'user.adv'},  
      "request.host"       => $ENV{'REMOTE_ADDR'},);  
   
         if ($FORM{'localpath'}) {  
     $initial_env{"browser.localpath"}  = $FORM{'localpath'};  
     $initial_env{"browser.localres"}   = $FORM{'localres'};  
         }  
   
  if ($public) {  
     $initial_env{"environment.remote"} = "off";  
  }  
  if ($FORM{'interface'}) {  
     $FORM{'interface'}=~s/\W//gs;  
     $initial_env{"browser.interface"} = $FORM{'interface'};  
     $env{'browser.interface'}=$FORM{'interface'};  
     foreach my $option ('imagesuppress','appletsuppress',  
  'embedsuppress','fontenhance','blackwhite') {  
  if (($FORM{$option} eq 'true') ||  
     ($userenv{$option} eq 'on')) {  
     $initial_env{"browser.$option"} = "on";  
  }  
     }  
  }  
   
  open(my $idf,">$lonids/$cookie.id");      if ($public or $lowerurl eq 'noredirect') { return $cookie; }
  unless (flock($idf,LOCK_EX)) {  
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
    'Could not obtain exclusive lock in lonauth: '.$!);  
     close($idf);  
     return 'error: '.$!;  
  }  
   
  while (my ($key,$value) = each(%initial_env)) {  
     print $idf (&escape($key).'='.&escape($value)."\n");  
  }  
  while (my ($key,$value) = each(%userenv)) {  
     print $idf (&escape($key).'='.&escape($value)."\n");  
  }  
  if ($userroles ne '') { print $idf "$userroles"; }  
  close($idf);  
     }  
     $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 205  sub success { Line 73  sub success {
     }      }
   
 # ------------------------------------------------------------ Get cookie ready  # ------------------------------------------------------------ Get cookie ready
   
     if ($public or $lowerurl eq 'noredirect') { return $cookie; }  
   
     $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);
               unless ($desturl=~/^(adm|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;
           }
       }
       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 $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 233  sub success { Line 145  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',         '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);
 $start_page  $start_page
 $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  $remoteinfo
 $maincall  $maincall
 $continuelink  $continuelink
Line 254  ENDSUCCESS Line 170  ENDSUCCESS
 # --------------------------------------------------------------- Failed login!  # --------------------------------------------------------------- Failed login!
   
 sub failed {  sub failed {
     my ($r,$message) = @_;      my ($r,$message,$form) = @_;
     my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,      (undef,undef,undef,my $clientmathml,my $clientunicode) =
     {'no_inline_link' => 1,});          &Apache::loncommon::decode_user_agent();
     my $end_page   = &Apache::loncommon::end_page();      my $args = {};
       if ($clientunicode && !$clientmathml) {
     my %lt=('sorry'  => &mt('Sorry ...'),          $args = {'browser.unicode' => 1};
     'please' =>       }
     &mt('Please [_1]log in again[_2].',  
  "<a href=\"/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}\">",      my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args);
  '</a>'),      my $uname = &Apache::loncommon::cleanup_html($form->{'uname'});
     'problemspage' => &mt('loginproblems.html'),      my $udom = &Apache::loncommon::cleanup_html($form->{'udom'});
     'problems'     => 'Problems',      if (&Apache::lonnet::domain($udom,'description') eq '') {
     );          undef($udom);
       }
       my $retry = '/adm/login';
       if ($uname eq $form->{'uname'}) {
           $retry .= '?username='.$uname;
       }
       if ($udom) {
           $retry .= (($retry=~/\?/)?'&amp;':'?').'domain='.$udom;
       }
       if (exists($form->{role})) {
           my $role = &Apache::loncommon::cleanup_html($form->{role});
           if ($role ne '') {
               $retry .= (($retry=~/\?/)?'&amp;':'?').'role='.$role;
           }
       }
       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');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
       my @actions =
     $r->print(<<ENDFAILED);           (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
 $start_page      my $loginhelp = &loginhelpdisplay($udom);
 <h1>$lt{'sorry'}</h1>      if ($loginhelp) {
 <p><b>$message</b></p>          push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>');
 <p>$lt{'please'}</p>      }
 <p>      #FIXME: link to helpdesk might be added here
 <a href="/adm/$lt{'problemspage'}">$lt{'problems'}</a></p>  
 $end_page      $r->print(
 ENDFAILED         $start_page
 }        .'<h2>'.&mt('Sorry ...').'</h2>'
         .&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'<br /><br />'
         .&Apache::lonhtmlcommon::actionbox(\@actions)
         .$end_page
       );
    }
   
 # ------------------------------------------------------------------ Rerouting!  # ------------------------------------------------------------------ Rerouting!
   
Line 287  sub reroute { Line 229  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='<b>'.&mt('Sorry ...').'</b><br />'
              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,{'no_auto_mt_msg' => 1});
 }  }
   
 # ---------------------------------------------------------------- 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 306  sub handler { Line 249  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
               &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
     my $start_page =       my $start_page = 
  &Apache::loncommon::start_page('Already logged in');          &Apache::loncommon::start_page('Already logged in');
     my $end_page =       my $end_page = 
  &Apache::loncommon::end_page();          &Apache::loncommon::end_page();
     $r->print(<<ENDFAILED);              my $dest = '/adm/roles';
 $start_page              if ($env{'form.firsturl'} ne '') {
 <h1>You are already logged in</h1>                  $dest = $env{'form.firsturl'};
 <p>Please either <a href="/adm/roles">continue the current session</a> or              }
 <a href="/adm/logout">logout</a>.</p>              $r->print(
 <p>                 $start_page
 <a href="/adm/loginproblems.html">Problems?</a></p>                .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
 $end_page                .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
 ENDFAILED                      ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
            return OK;                .'</p>'
  }                .$end_page
               );
               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{'upass0'}) || (!$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')) {      my %sessiondata;
  failed($r,'Information needed to verify your login information is missing, inaccessible or expired.');      if ($form{'iptoken'}) {
           %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
           my $delete = &Apache::lonnet::tmpdel($form{'token'});
       }
   
       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);
         return OK;          return OK;
     } else {      } else {
  my $reply = &Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'},   my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'},
    $FORM{'serverid'});     $form{'serverid'});
         if ( $reply ne 'ok' ) {          if ( $reply ne 'ok' ) {
             &failed($r,'Session could not be opened.');              &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");      &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token");
     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 397  ENDFAILED Line 369  ENDFAILED
     my $upass='';      my $upass='';
     for (my $i=0;$i<=2;$i++) {      for (my $i=0;$i<=2;$i++) {
  my $chunk=   my $chunk=
     $cipher->decrypt(unpack("a8",pack("H16",substr($FORM{'upass'.$i},0,16))));      $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},0,16))));
   
  $chunk.=   $chunk.=
     $cipher->decrypt(unpack("a8",pack("H16",substr($FORM{'upass'.$i},16,16))));      $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},16,16))));
   
  $chunk=substr($chunk,1,ord(substr($chunk,0,1)));   $chunk=substr($chunk,1,ord(substr($chunk,0,1)));
  $upass.=$chunk;   $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'}) {
           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 444  ENDFAILED Line 468  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.78  
changed lines
  Added in v.1.121.2.9

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.