Diff for /loncom/auth/lonauth.pm between versions 1.83 and 1.86

version 1.83, 2006/09/19 21:36:24 version 1.86, 2006/10/12 18:18:01
Line 40  use Apache::lonnet; Line 40  use Apache::lonnet;
 use Apache::lonmenu();  use Apache::lonmenu();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonlocal;  use Apache::lonlocal;
 use GDBM_File;   
 my %FORM;  
   
 # ------------------------------------------------------------ Successful login  # ------------------------------------------------------------ Successful login
   
 sub success {  sub success {
     my ($r, $username, $domain, $authhost, $lowerurl, $extra_env) = @_;      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) {  # ------------------------------------------------------------ Get cookie ready
  my $max_public=100;      my $cookie =
  my $oldest;   &Apache::loncommon::init_user_environment($r, $username, $domain,
  my $oldest_time=0;    $authhost, $form,
  for(my $next=1;$next<=$max_public;$next++) {    {'extra_env' => $extra_env,});
     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  
   
  $cookie="$username\_$now\_$domain\_$authhost";  
       
 # Initialize roles  
   
  $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 $public=($username eq 'public' && $domain eq 'public');
     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      if ($public or $lowerurl eq 'noredirect') { return $cookie; }
     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";  
  }  
     }  
  }  
   
  $env{'user.environment'} = "$lonids/$cookie.id";  
   
  if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",  
  &GDBM_WRCREAT(),0640)) {  
     &add_to_env(\%disk_env,\%initial_env);  
     &add_to_env(\%disk_env,\%userenv,'environment.');  
     &add_to_env(\%disk_env,$userroles);  
     &add_to_env(\%disk_env,$extra_env);  
     untie(%disk_env);  
  } else {  
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
    'Could not create environment storage in lonauth: '.$!);  
     return 'error: '.$!;  
  }  
     }  
     $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 203  sub success { Line 71  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 $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
     my $startupremote=&Apache::lonmenu::startupremote($lowerurl);      my $startupremote=&Apache::lonmenu::startupremote($lowerurl);
     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();
Line 249  $end_page Line 114  $end_page
 ENDSUCCESS  ENDSUCCESS
 }  }
   
 sub add_to_env {  
     my ($idf,$env_data,$prefix) = @_;  
     while (my ($key,$value) = each(%$env_data)) {  
  $idf->{$prefix.$key} = $value;  
  $env{$prefix.$key}   = $value;  
     }  
 }  
   
 # --------------------------------------------------------------- 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,      my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,
     {'no_inline_link' => 1,});      {'no_inline_link' => 1,});
     my $end_page   = &Apache::loncommon::end_page();      my $end_page   = &Apache::loncommon::end_page();
Line 268  sub failed { Line 125  sub failed {
     my %lt=('sorry'  => &mt('Sorry ...'),      my %lt=('sorry'  => &mt('Sorry ...'),
     'please' =>       'please' => 
     &mt('Please [_1]log in again[_2].',      &mt('Please [_1]log in again[_2].',
  "<a href=\"/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}\">",   "<a href=\"/adm/login?username=$form->{'uname'}&domain=$form->{'udom'}\">",
  '</a>'),   '</a>'),
     'problemspage' => &mt('loginproblems.html'),      'problemspage' => &mt('loginproblems.html'),
     'problems'     => 'Problems',      'problems'     => 'Problems',
Line 302  sub reroute { Line 159  sub reroute {
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
       my $form;
 # Are we re-routing?  # Are we re-routing?
     if (-e '/home/httpd/html/lon-status/reroute.txt') {      if (-e '/home/httpd/html/lon-status/reroute.txt') {
  &reroute($r);   &reroute($r);
Line 344  ENDFAILED Line 201  ENDFAILED
   
   
     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'} =~ s/\W//g;
     $FORM{'suname'} =~ s/\W//g;      $form{'suname'} =~ s/\W//g;
     $FORM{'udom'}  =~ s/\W//g;      $form{'udom'}  =~ s/\W//g;
   
     my $role   = $r->dir_config('lonRole');      my $role   = $r->dir_config('lonRole');
     my $domain = $r->dir_config('lonDefDomain');      my $domain = $r->dir_config('lonDefDomain');
Line 374  ENDFAILED Line 231  ENDFAILED
   
 # ---------------------------------------- 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.');   &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;
  }   }
     }      }
Line 403  ENDFAILED Line 260  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'},      my $authhost=Apache::lonnet::authenticate($form{'uname'},
                                               $upass,                                                $upass,
                                               $FORM{'udom'});                                                $form{'udom'});
           
 # --------------------------------------------------------------------- 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;
     }      }
   
Line 429  ENDFAILED Line 287  ENDFAILED
  $firsturl='/adm/roles';   $firsturl='/adm/roles';
     }      }
 # --------------------------------- 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 450  ENDFAILED Line 308  ENDFAILED
     &Apache::lonnet::logthis('Non-privileged user attempting switch user');      &Apache::lonnet::logthis('Non-privileged user attempting switch user');
  }   }
     }      }
   
     if ($r->dir_config("lonBalancer") eq 'yes') {      if ($r->dir_config("lonBalancer") eq 'yes') {
  &success($r,$FORM{'uname'},$FORM{'udom'},$authhost,'noredirect');   &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
    \%form);
  $r->internal_redirect('/adm/switchserver');   $r->internal_redirect('/adm/switchserver');
     } else {      } else {
  &success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);   &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
    \%form);
     }      }
     return OK;      return OK;
 }  }

Removed from v.1.83  
changed lines
  Added in v.1.86


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.