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

Diff for /loncom/auth/lonauth.pm between versions 1.121.2.21 and 1.121.2.24

version 1.121.2.21, 2021/01/04 03:48:29 version 1.121.2.24, 2021/12/30 05:11:28
Line 41  use Apache::lonlocal; Line 41  use Apache::lonlocal;
 use Apache::File();  use Apache::File();
 use HTML::Entities;  use HTML::Entities;
 use Digest::MD5;  use Digest::MD5;
   use CGI::Cookie();
     
 # ------------------------------------------------------------ Successful login  # ------------------------------------------------------------ Successful login
 sub success {  sub success {
     my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,      my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
  $form,$cid) = @_;   $form,$cid,$expirepub) = @_;
   
 # ------------------------------------------------------------ Get cookie ready  # ------------------------------------------------------------ Get cookie ready
     my $cookie =      my $cookie =
Line 173  sub success { Line 174  sub success {
     if ($defaultcookie) {      if ($defaultcookie) {
         $r->headers_out->add('Set-cookie' => $defaultcookie);          $r->headers_out->add('Set-cookie' => $defaultcookie);
     }      }
       if ($expirepub) {
           my $c = new CGI::Cookie(-name    => 'lonPubID',
                                   -value   => '',
                                   -expires => '-10y',);
           $r->headers_out->add('Set-cookie' => $c);
       }
     $r->send_http_header;      $r->send_http_header;
   
     my %lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
Line 203  ENDSUCCESS Line 210  ENDSUCCESS
 # --------------------------------------------------------------- Failed login!  # --------------------------------------------------------------- Failed login!
   
 sub failed {  sub failed {
     my ($r,$message,$form) = @_;      my ($r,$message,$form,$authhost) = @_;
     (undef,undef,undef,my $clientmathml,my $clientunicode) =      (undef,undef,undef,my $clientmathml,my $clientunicode) =
         &Apache::loncommon::decode_user_agent();          &Apache::loncommon::decode_user_agent();
     my $args = {};      my $args = {};
Line 224  sub failed { Line 231  sub failed {
     if ($udom) {      if ($udom) {
         $retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom;          $retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom;
     }      }
     if (exists($form->{role})) {      my $lonhost = $r->dir_config('lonHostID');
         my $role = &Apache::loncommon::cleanup_html($form->{role});      my $querystr;
         if ($role ne '') {      my $result = &set_retry_token($form,$lonhost,\$querystr);
             $retry .= (($retry=~/\?/)?'&':'?').'role='.$role;      if ($result eq 'fail') {
           if (exists($form->{role})) {
               my $role = &Apache::loncommon::cleanup_html($form->{role});
               if ($role ne '') {
                   $retry .= (($retry=~/\?/)?'&':'?').'role='.$role;
               }
         }          }
     }          if (exists($form->{symb})) {
     if (exists($form->{symb})) {              my $symb = &Apache::loncommon::cleanup_html($form->{symb});
         my $symb = &Apache::loncommon::cleanup_html($form->{symb});              if ($symb ne '') {
         if ($symb ne '') {                  $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb;
             $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb;              }
           }
           if (exists($form->{firsturl})) {
               my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
               if ($firsturl ne '') {
                   $retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl;
               }
         }          }
       } elsif ($querystr ne '') {
           $retry .= (($retry=~/\?/)?'&':'?').$querystr;
     }      }
     my $end_page = &Apache::loncommon::end_page();      my $end_page = &Apache::loncommon::end_page();
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
Line 297  sub handler { Line 317  sub handler {
     my $end_page =       my $end_page = 
         &Apache::loncommon::end_page();          &Apache::loncommon::end_page();
             my $dest = '/adm/roles';              my $dest = '/adm/roles';
             if ($env{'form.firsturl'} ne '') {              my %form = &get_form_items($r);
                 $dest = $env{'form.firsturl'};              if ($form{'logtoken'}) {
                   my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
                                                        $form{'serverid'});
                   unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
                           ($tmpinfo eq 'no_such_host')) {
                       my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
                       $firsturl = &unescape($firsturl);
                       my %info;
                       foreach my $item (@rest) {
                           my ($key,$value) = split(/=/,$item);
                           $info{$key} = &unescape($value);
                       }
                       if ($firsturl ne '') {
                           $info{'firsturl'} = $firsturl;
                           $dest = $firsturl;
                       }
                   }
             }              }
             $r->print(              $r->print(
                $start_page                 $start_page
Line 314  sub handler { Line 350  sub handler {
   
 # ---------------------------------------------------- No valid token, continue  # ---------------------------------------------------- No valid token, continue
   
       my %form = &get_form_items($r);
     my $buffer;  
     if ($r->header_in('Content-length') > 0) {  
  $r->read($buffer,$r->header_in('Content-length'),0);  
     }  
     my %form;  
     foreach my $pair (split(/&/,$buffer)) {  
        my ($name,$value) = split(/=/,$pair);  
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        $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);   \%form);
Line 370  sub handler { Line 394  sub handler {
         return OK;          return OK;
     }      }
   
     my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr)=split(/&/,$tmpinfo);      my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
     if ($rolestr) {      $firsturl = &unescape($firsturl);
         $rolestr = &unescape($rolestr);      foreach my $item (@rest) {
     }          my ($key,$value) = split(/=/,$item);
     if ($symbstr) {          $form{$key} = &unescape($value);
         $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 $upass = &Apache::loncommon::des_decrypt($des_key,$form{'upass0'});
     my $upass = &Apache::loncommon::des_decrypt($key,$form{'upass0'});  
   
 # ---------------------------------------------------------------- Authenticate  # ---------------------------------------------------------------- Authenticate
   
Line 452  sub handler { Line 462  sub handler {
  $firsturl='/adm/roles';   $firsturl='/adm/roles';
     }      }
   
     my $hosthere;      my ($hosthere,%sessiondata);
     if ($form{'iptoken'}) {      if ($form{'iptoken'}) {
         my %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});          %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
         my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});          my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
         if (($sessiondata{'domain'} eq $form{'udom'}) &&          if (($sessiondata{'domain'} eq $form{'udom'}) &&
             ($sessiondata{'username'} eq $form{'uname'})) {              ($sessiondata{'username'} eq $form{'uname'})) {
Line 548  sub handler { Line 558  sub handler {
                 my $lowest_load;                  my $lowest_load;
                 ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});                  ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});
                 if ($lowest_load > 100) {                  if ($lowest_load > 100) {
                     $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$form{'udom'});                      $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$form{'udom'});
                 }                  }
             }              }
             if ($otherserver ne '') {              if ($otherserver ne '') {
Line 621  sub handler { Line 631  sub handler {
   
 # ---------------------------------------------------------- Are we overloaded?  # ---------------------------------------------------------- Are we overloaded?
         if ((($userloadpercent>100.0)||($loadpercent>100.0))) {          if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
             my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'});              my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'});
             if (!$unloaded) {              if (!$unloaded) {
                 ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});                  ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
             }              }
Line 635  sub handler { Line 645  sub handler {
         if (($is_balancer) && ($hosthere)) {          if (($is_balancer) && ($hosthere)) {
             $form{'noloadbalance'} = $hosthere;              $form{'noloadbalance'} = $hosthere;
         }          }
           my $extra_env;
           if (($hosthere) && ($sessiondata{'sessionserver'} ne '')) {
               if ($sessiondata{'origurl'} ne '') {
                   $firsturl = $sessiondata{'origurl'};
                   $form{'firsturl'} = $sessiondata{'origurl'};
                   my @names = ('role','symb','linkprot','linkkey');
                   foreach my $item (@names) {
                       if ($sessiondata{$item} ne '') {
                           $form{$item} = $sessiondata{$item};
                       }
                   }
               }
           }
         &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,          &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
                  \%form);                   \%form);
         return OK;          return OK;
     }      }
 }  }
   
   sub get_form_items {
       my ($r) = @_;
       my $buffer;
       if ($r->header_in('Content-length') > 0) {
           $r->read($buffer,$r->header_in('Content-length'),0);
       }
       my %form;
       foreach my $pair (split(/&/,$buffer)) {
          my ($name,$value) = split(/=/,$pair);
          $value =~ tr/+/ /;
          $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
          $form{$name}=$value;
       }
       return %form;
   }
   
   sub set_retry_token {
       my ($form,$lonhost,$querystr) = @_;
       if (ref($form) eq 'HASH') {
           my ($firsturl,$token,$extras,@names);
           @names = ('role','symb','iptoken');
           foreach my $name (@names) {
               if ($form->{$name} ne '') {
                   $extras .= '&'.$name.'='.&escape($form->{$name});
                   last if ($name eq 'linkprot');
               }
           }
           my $firsturl = $form->{'firsturl'};
           if (($firsturl ne '') || ($extras ne '')) {
               $extras .= ':retry';
               $token = &Apache::lonnet::reply('tmpput:'.&escape($firsturl).
                                               $extras,$lonhost);
               if (($token eq 'con_lost') || ($token eq 'no_such_host')) {
                   return 'fail';
               } else {
                   if (ref($querystr)) {
                       $$querystr = 'retry='.$token;
                   }
                   return 'ok';
               }
           }
       }
       return;
   }
   
 sub check_can_host {  sub check_can_host {
     my ($r,$form,$authhost,$domdesc) = @_;      my ($r,$form,$authhost,$domdesc) = @_;
     return unless (ref($form) eq 'HASH');      return unless (ref($form) eq 'HASH');
Line 681  sub check_can_host { Line 749  sub check_can_host {
             if ($login_host ne '') {              if ($login_host ne '') {
                 my $protocol = $Apache::lonnet::protocol{$login_host};                  my $protocol = $Apache::lonnet::protocol{$login_host};
                 $protocol = 'http' if ($protocol ne 'https');                  $protocol = 'http' if ($protocol ne 'https');
                   my $alias = &Apache::lonnet::use_proxy_alias($r,$login_host);
                   $hostname = $alias if ($alias ne '');
                 my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';                  my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
                 $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').                  $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
                           '<h3>'.&mt('Account creation').'</h3>'.                            '<h3>'.&mt('Account creation').'</h3>'.
Removed from v.1.121.2.21  
changed lines
  Added in v.1.121.2.24

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