Diff for /loncom/auth/lonauth.pm between versions 1.168 and 1.175

version 1.168, 2021/10/26 15:52:54 version 1.175, 2022/06/26 04:03:47
Line 42  use Apache::lonlocal; Line 42  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,$skipcritical,$cid) = @_;   $form,$skipcritical,$cid,$expirepub) = @_;
   
 # ------------------------------------------------------------ Get cookie ready  # ------------------------------------------------------------ Get cookie ready
     my $cookie =      my $cookie =
Line 178  sub success { Line 179  sub success {
         $destination .= 'source=login';          $destination .= 'source=login';
     }      }
   
       my $brcrum = [{'href' => '',
                      'text' => 'Successful Login'},];
       my $args = {'no_inline_link' => 1,
                   'bread_crumbs' => $brcrum,};
       if (($env{'request.deeplink.login'} eq $lowerurl) &&
           (($env{'request.linkprot'}) || ($env{'request.linkkey'} ne ''))) {
           my %info;
           if ($env{'request.linkprot'}) {
               $info{'linkprot'} = $env{'request.linkprot'};
               if ($form->{'linkprotuser'}) {
                   $info{'linkprotuser'} = $form->{'linkprotuser'};
               }
               $args = {'only_body' => 1,};
           } elsif ($env{'request.linkkey'} ne '') {
               $info{'linkkey'} = $env{'request.linkkey'};
           }
           $info{'origurl'} = $lowerurl;
           my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link');
           unless (($token eq 'con_lost') || ($token eq 'refused') ||
                   ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
               $destination .= (($destination =~ /\?/) ? '&' : '?') . 'ttoken='.$token;
           }
       }
   
     my $windowname = 'loncapaclient';      my $windowname = 'loncapaclient';
     if ($env{'request.lti.login'}) {      if ($env{'request.lti.login'}) {
         $windowname .= 'lti';          $windowname .= 'lti';
     }      }
     my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";');      my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";');
     my $brcrum = [{'href' => '',  
                    'text' => 'Successful Login'},];  
     my $args = {'bread_crumbs' => $brcrum,};  
     unless ((defined($form->{role})) || (defined($form->{symb}))) {      unless ((defined($form->{role})) || (defined($form->{symb}))) {
         my $update=$env{'user.update.time'};          my $update=$env{'user.update.time'};
         if (!$update) {          if (!$update) {
Line 217  sub success { Line 239  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 ($start_page,$js,$pagebody,$end_page);      my ($start_page,$js,$pagebody,$end_page);
Line 225  sub success { Line 253  sub success {
         if ($env{'request.lti.target'} eq '') {          if ($env{'request.lti.target'} eq '') {
             my $ltitarget = (($destination =~ /\?/) ? '&' : '?').              my $ltitarget = (($destination =~ /\?/) ? '&' : '?').
                             'ltitarget=iframe';                              'ltitarget=iframe';
               &js_escape(\$destination);
             $js = <<"ENDJS";              $js = <<"ENDJS";
   
 <script type="text/javascript">  <script type="text/javascript">
Line 252  ENDJS Line 281  ENDJS
         $args->{'redirect'} = [0,$destination];          $args->{'redirect'} = [0,$destination];
         $start_page=&Apache::loncommon::start_page('Successful Login',          $start_page=&Apache::loncommon::start_page('Successful Login',
                                                    $js,$args);                                                     $js,$args);
           unless ($env{'request.linkprot'}) {
         my %lt=&Apache::lonlocal::texthash(              my %lt=&Apache::lonlocal::texthash(
            'wel' => 'Welcome',                     'wel' => 'Welcome',
            'pro' => 'Login problems?',                 'pro' => 'Login problems?',
           );            );
         $pagebody = "<h1>$lt{'wel'}</h1>\n".              $pagebody = "<h1>$lt{'wel'}</h1>\n".
                     &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>');                          &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>');
         my $loginhelp = &loginhelpdisplay($domain);              my $loginhelp = &loginhelpdisplay($domain);
         if ($loginhelp) {              if ($loginhelp) {
             $pagebody .= '<p><a href="'.$loginhelp.'">'.$lt{'pro'}.'</a></p>';                  $pagebody .= '<p><a href="'.$loginhelp.'">'.$lt{'pro'}.'</a></p>';
               }
         }          }
     }      }
     $end_page = &Apache::loncommon::end_page();      $end_page = &Apache::loncommon::end_page();
     $r->print(<<ENDSUCCESS);      $r->print(<<ENDSUCCESS);
 $start_page  $start_page
Line 277  ENDSUCCESS Line 307  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 = {};
     if ($clientunicode && !$clientmathml) {      if ($clientunicode && !$clientmathml) {
         $args = {'browser.unicode' => 1};          $args = {'browser.unicode' => 1};
     }      }
       if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) {
           if ($form->{linkprot}) {
               $args->{only_body} = 1;
           }
       }
   
       my @actions;
     my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args);      my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args);
     my $uname = &Apache::loncommon::cleanup_html($form->{'uname'});      my $uname = &Apache::loncommon::cleanup_html($form->{'uname'});
     my $udom = &Apache::loncommon::cleanup_html($form->{'udom'});      my $udom = &Apache::loncommon::cleanup_html($form->{'udom'});
     if (&Apache::lonnet::domain($udom,'description') eq '') {      if (&Apache::lonnet::domain($udom,'description') eq '') {
         undef($udom);          undef($udom);
     }      }
       my $authtype;
       if (($udom ne '') && ($uname ne '') && ($authhost eq 'no_host')) {
           $authtype = &Apache::lonnet::queryauthenticate($uname,$udom);
       }
     my $retry = '/adm/login';      my $retry = '/adm/login';
     if ($uname eq $form->{'uname'}) {      if (($uname eq $form->{'uname'}) && ($authtype !~ /^lti:/)) {
         $retry .= '?username='.$uname;          $retry .= '?username='.$uname;
     }      }
     if ($udom) {      if ($udom) {
Line 328  sub failed { Line 368  sub failed {
             }              }
         }          }
         if (exists($form->{linkprot})) {          if (exists($form->{linkprot})) {
             my $ltoken = &Apache::lonnet::tmpput({linkprot => $form->{'linkprot'}},              my %info = (
                                                   $r->dir_config('lonHostID'));                           'linkprot' => $form->{'linkprot'},
                          );
               if ($form->{linkprotuser} ne '') {
                   $info{'linkprotuser'} = $form->{linkprotuser};
               }
               my $ltoken = &Apache::lonnet::tmpput(\%info,
                                                    $r->dir_config('lonHostID'),'retry');
             if ($ltoken) {              if ($ltoken) {
                 $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;                  $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
             }              }
Line 340  sub failed { Line 386  sub failed {
     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');
     $r->send_http_header;      $r->send_http_header;
     my @actions =      if ($authtype =~ /^lti:/) {
          (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));          $message = &mt('Direct login is not supported with the username you entered.').
                      '<br /><br />'.
                      &mt('You likely need to launch LON-CAPA from within a course in a different Learning Management System.').
                      '<br />'.
                      &mt('You can also try to log in with a different username.');
           @actions =
               (&mt('Try your [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
       } else {
           $message = &mt($message);
           @actions =
               (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
       }
     my $loginhelp = &loginhelpdisplay($udom);      my $loginhelp = &loginhelpdisplay($udom);
     if ($loginhelp) {      if ($loginhelp) {
         push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>');          push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>');
     }      }
     #FIXME: link to helpdesk might be added here      #FIXME: link to helpdesk might be added here
   
     $r->print(      $r->print(
        $start_page         $start_page
       .'<h2>'.&mt('Sorry ...').'</h2>'        .'<h2>'.&mt('Sorry ...').'</h2>'
       .&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'<br /><br />'        .&Apache::lonhtmlcommon::confirm_success($message,1).'<br /><br />'
       .&Apache::lonhtmlcommon::actionbox(\@actions)        .&Apache::lonhtmlcommon::actionbox(\@actions)
       .$end_page        .$end_page
     );      );
Line 398  sub handler { Line 454  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'}) {
                 if (($dest =~ m{^/tiny/$match_domain/\w+$}) && ($env{'request.course.id'})) {                  my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};                                                       $form{'serverid'});
                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};                  unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
                     my $symb = &Apache::loncommon::symb_from_tinyurl($dest,$cnum,$cdom);                          ($tmpinfo eq 'no_such_host')) {
                     if ($symb) {                      my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
                         my $buffer;                      $firsturl = &unescape($firsturl);
                         if ($r->header_in('Content-length') > 0) {                      my %info;
                             $r->read($buffer,$r->header_in('Content-length'),0);                      foreach my $item (@rest) {
                         }                          my ($key,$value) = split(/=/,$item);
                         my %form;                          $info{$key} = &unescape($value);
                         foreach my $pair (split(/&/,$buffer)) {                      }
                             my ($name,$value) = split(/=/,$pair);                      if ($firsturl ne '') {
                             $value =~ tr/+/ /;                          $info{'firsturl'} = $firsturl;
                             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;                          $dest = $firsturl;
                             $form{$name}=$value;                          my $relogin;
                           if ($dest =~ m{^/tiny/$match_domain/\w+$}) {
                               if ($env{'request.course.id'}) {
                                   my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                                   my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                                   my $symb = &Apache::loncommon::symb_from_tinyurl($dest,$cnum,$cdom);
                                   if ($symb) {
                                       unless (&set_deeplink_login(%info) eq 'ok') {
                                           $relogin = 1;
                                       }
                                   }
                               }
                               if ($relogin) {
                                   $r->print(
                                         $start_page
                                        .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
                                        .'<p>'.&mt('Please [_1]log out[_2] first, and then try your access again',
                                                   '<a href="/adm/logout">','</a>')
                                        .'</p>'
                                        .$end_page);
                               } else {
                                   if (($info{'linkprot'}) || ($info{'linkkey'} ne '')) {
                                       if (($info{'linkprot'}) && ($info{'linkprotuser'} ne '')) {
                                           unless ($info{'linkprotuser'} eq $env{'user.name'}.':'.$env{'user.domain'}) {
                                               $r->print(
                                                         $start_page
                                                         .'<p class="LC_warning">'.&mt('You are already logged in, but as a different user from the one expected for the link you followed from another system').'</p>'
                                                         .'<p>'.&mt('Please [_1]log out[_2] first, and then try following the link again from the other system',
                                                                    '<a href="/adm/logout">','</a>')
   
                                                         .'</p>'
                                                         .$end_page);
                                               return OK;
                                           }
                                       }
                                       my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link');
                                       unless (($token eq 'con_lost') || ($token eq 'refused') ||
                                               ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
                                           $dest .= (($dest =~ /\?/) ? '&' : '?') . 'ttoken='.$token;
                                       }
                                   }
                                   $r->print(
                                         $start_page
                                        .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
                                        .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4] first, and then try your access again',
                                                   '<a href="'.$dest.'">','</a>',
                                                   '<a href="/adm/logout">','</a>')
                                        .'</p>'
                                        .$end_page);
                               }
                               return OK;
                         }                          }
                         &set_deeplink_login(%form);  
                     } else {  
                         $r->print(  
                                   $start_page  
                                  .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'  
                                  .'<p>'.&mt('Please [_1]log out[_2] first, and then try your access again',  
                                             '<a href="/adm/logout">','</a>')  
                                  .'</p>'  
                                  .$end_page);  
                         return OK;  
                     }                      }
                 }                  }
             }              }
             $r->print(              $r->print(
                $start_page                    $start_page
               .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'                   .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
               .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'                   .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
                     ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')                            ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
               .'</p>'                   .'</p>'
               .$end_page                   .$end_page
             );              );
             return OK;              return OK;
         }          }
Line 443  sub handler { Line 539  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 499  sub handler { Line 583  sub handler {
         return OK;          return OK;
     }      }
   
     my ($key,$firsturl,@rest)=split(/&/,$tmpinfo);      my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
       $firsturl = &unescape($firsturl);
     foreach my $item (@rest) {      foreach my $item (@rest) {
         my ($key,$value) = split(/=/,$item);          my ($key,$value) = split(/=/,$item);
         $form{$key} = &unescape($value);          $form{$key} = &unescape($value);
Line 508  sub handler { Line 593  sub handler {
         $form{'firsturl'} = $firsturl;          $form{'firsturl'} = $firsturl;
     }      }
     my $upass = $ENV{HTTPS} ? $form{'upass0'}      my $upass = $ENV{HTTPS} ? $form{'upass0'}
         : &Apache::loncommon::des_decrypt($key,$form{'upass0'});          : &Apache::loncommon::des_decrypt($des_key,$form{'upass0'});
   
 # ---------------------------------------------------------------- Authenticate  # ---------------------------------------------------------------- Authenticate
   
Line 529  sub handler { Line 614  sub handler {
 # --------------------------------------------------------------------- Failed?  # --------------------------------------------------------------------- Failed?
   
     if ($authhost eq 'no_host') {      if ($authhost eq 'no_host') {
  &failed($r,'Username and/or password could not be authenticated.',          my $pwdverify;
  \%form);          if (&Apache::lonnet::homeserver($form{'uname'},$form{'udom'}) eq 'no_host') {
         return OK;              my %possunames = &alternate_unames_check($form{'uname'},$form{'udom'});
               if (keys(%possunames) > 0) {
                   foreach my $rulematch (keys(%possunames)) {
                       my $possuname = $possunames{$rulematch};
                       if (($possuname ne '') && ($possuname =~ /^$match_username$/)) {
                           $authhost=Apache::lonnet::authenticate($possuname,$upass,
                                                                  $form{'udom'},undef,
                                                                  $clientcancheckhost);
                           if (($authhost eq 'no_host') || ($authhost eq 'no_account_on_host')) {
                               next;
                           } elsif (($authhost ne '') && (&Apache::lonnet::hostname($authhost) ne '')) {
                               $pwdverify = 1;
                               &Apache::lonnet::logthis("Authenticated user: $possuname was submitted as: $form{'uname'}");
                               $form{'uname'} = $possuname;
                               last;
                           }
                       }
                   }
               }
           }
           unless ($pwdverify) {
               &failed($r,'Username and/or password could not be authenticated.',
                       \%form,$authhost);
               return OK;
           }
     } elsif ($authhost eq 'no_account_on_host') {      } elsif ($authhost eq 'no_account_on_host') {
         if ($defaultauth) {          if ($defaultauth) {
             my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');              my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
Line 570  sub handler { Line 679  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 616  sub handler { Line 725  sub handler {
                         unless ($suprim eq $uprim) {                          unless ($suprim eq $uprim) {
                             unless ($suintdom eq $uintdom) {                              unless ($suintdom eq $uintdom) {
                                 &Apache::lonnet::logthis('Attempted switch user '                                  &Apache::lonnet::logthis('Attempted switch user '
                                    .'to user with different "internet domain".');                                                             .'to user with different "internet domain".');
                                 $noprivswitch = 1;                                  $noprivswitch = 1;
                             }                              }
                         }                          }
Line 651  sub handler { Line 760  sub handler {
  }   }
     }      }
   
       if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
           if (($form{'linkprot'}) && ($form{'linkprotuser'} ne '')) {
               unless($form{'linkprotuser'} eq $form{'uname'}.':'.$form{'udom'}) {
                   delete($form{'udom'});
                   delete($form{'uname'});
                   &failed($r,'Username and/or domain are different to that expected for the link you followed from another system',
                           \%form,$authhost);
                   return OK;
               }
           }
       }
   
     my ($is_balancer,$otherserver);      my ($is_balancer,$otherserver);
   
     unless ($hosthere) {      unless ($hosthere) {
Line 694  sub handler { Line 815  sub handler {
             }              }
             if ($form{'linkprot'}) {              if ($form{'linkprot'}) {
                 $env{'request.linkprot'} = $form{'linkprot'};                  $env{'request.linkprot'} = $form{'linkprot'};
                   if ($form{'linkprotuser'}) {
                       $env{'request.linkprotuser'} = $form{'linkprotuser'};
                   }
             } elsif ($form{'linkkey'} ne '') {              } elsif ($form{'linkkey'} ne '') {
                 $env{'request.linkkey'} = $form{'linkkey'};                  $env{'request.linkkey'} = $form{'linkkey'};
             }              }
Line 725  sub handler { Line 849  sub handler {
                 }                  }
                 if ($form{'linkprot'}) {                  if ($form{'linkprot'}) {
                     $env{'request.linkprot'} = $form{'linkprot'};                      $env{'request.linkprot'} = $form{'linkprot'};
                       if ($form{'linkprotuser'}) {
                           $env{'request.linkprotuser'} = $form{'linkprotuser'};
                       }
                 } elsif ($form{'linkkey'} ne '') {                  } elsif ($form{'linkkey'} ne '') {
                     $env{'request.linkkey'} = $form{'linkkey'};                      $env{'request.linkkey'} = $form{'linkkey'};
                 }                  }
Line 778  sub handler { Line 905  sub handler {
             $form{'noloadbalance'} = $hosthere;              $form{'noloadbalance'} = $hosthere;
         }          }
         my $extra_env;          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};
                       }
                   }
               }
           }
         if ($form{'linkprot'}) {          if ($form{'linkprot'}) {
             my ($linkprotector,$uri) = split(/:/,$form{'linkprot'},2);              my ($linkprotector,$uri) = split(/:/,$form{'linkprot'},2);
             if ($linkprotector) {              if ($linkprotector) {
Line 817  sub handler { Line 956  sub handler {
     }      }
 }  }
   
   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_deeplink_login {  sub set_deeplink_login {
     my (%form) = @_;      my (%form) = @_;
       my $disallow;
     if ($form{'firsturl'} =~ m{^/tiny/($match_domain)/\w+$}) {      if ($form{'firsturl'} =~ m{^/tiny/($match_domain)/\w+$}) {
         my $cdom = $1;          my $cdom = $1;
         my ($cnum,$symb) = &Apache::loncommon::symb_from_tinyurl($form{'firsturl'},'',$cdom);          my ($cnum,$symb) = &Apache::loncommon::symb_from_tinyurl($form{'firsturl'},'',$cdom);
         if ($symb) {          if ($symb) {
             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {              if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                 my ($disallow,$deeplink);                  my $deeplink;
                 if ($symb =~ /\.(page|sequence)$/) {                  if ($symb =~ /\.(page|sequence)$/) {
                     my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);                      my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
                     my $navmap = Apache::lonnavmaps::navmap->new();                      my $navmap = Apache::lonnavmaps::navmap->new();
Line 857  sub set_deeplink_login { Line 1013  sub set_deeplink_login {
             }              }
         }          }
     }      }
     return;      if ($disallow) {
           return;
       }
       return 'ok';
 }  }
   
 sub set_retry_token {  sub set_retry_token {
     my ($form,$lonhost,$querystr) = @_;      my ($form,$lonhost,$querystr) = @_;
     if (ref($form) eq 'HASH') {      if (ref($form) eq 'HASH') {
         my ($firsturl,$token,$extras,@names);          my ($firsturl,$token,$extras,@names);
         @names = ('role','symb','linkprot','linkkey');          @names = ('role','symb','linkprotuser','linkprot','linkkey','iptoken');
         foreach my $name (@names) {          foreach my $name (@names) {
             if ($form->{$name} ne '') {              if ($form->{$name} ne '') {
                 $extras .= '&'.$name.'='.&escape($form->{$name});                  $extras .= '&'.$name.'='.&escape($form->{$name});
Line 1000  sub loginhelpdisplay { Line 1159  sub loginhelpdisplay {
     return;      return;
 }  }
   
   sub alternate_unames_check {
       my ($uname,$udom) = @_;
       my %possunames;
       my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
       if (ref($domdefs{'unamemap_rule'}) eq 'ARRAY') {
           if (@{$domdefs{'unamemap_rule'}} > 0) {
               %possunames =
                   &Apache::lonnet::inst_rulecheck($udom,$uname,undef,
                                                   'unamemap',$domdefs{'unamemap_rule'});
           }
       }
       return %possunames;
   }
   
 1;  1;
 __END__  __END__
   

Removed from v.1.168  
changed lines
  Added in v.1.175


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