--- loncom/auth/lonauth.pm	2019/08/01 00:42:34	1.121.2.17
+++ loncom/auth/lonauth.pm	2022/02/27 02:06:20	1.121.2.25
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.121.2.17 2019/08/01 00:42:34 raeburn Exp $
+# $Id: lonauth.pm,v 1.121.2.25 2022/02/27 02:06:20 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,11 +40,13 @@ use Fcntl qw(:flock);
 use Apache::lonlocal;
 use Apache::File();
 use HTML::Entities;
+use Digest::MD5;
+use CGI::Cookie();
  
 # ------------------------------------------------------------ Successful login
 sub success {
     my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
-	$form) = @_;
+	$form,$cid,$expirepub) = @_;
 
 # ------------------------------------------------------------ Get cookie ready
     my $cookie =
@@ -58,8 +60,9 @@ sub success {
 
 # -------------------------------------------------------------------- Log this
 
+    my $ip = &Apache::lonnet::get_requestor_ip();
     &Apache::lonnet::log($domain,$username,$authhost,
-                         "Login $ENV{'REMOTE_ADDR'}");
+                         "Login $ip");
 
 # ------------------------------------------------- Check for critical messages
 
@@ -70,8 +73,27 @@ sub success {
         }
     }
 
-# ------------------------------------------------------------ Get cookie ready
-    $cookie="lonID=$cookie; path=/; HttpOnly";
+# ------------------------------------------------------------ Get cookies ready
+    my ($securecookie,$defaultcookie);
+    my $ssl = $r->subprocess_env('https');
+    if ($ssl) {
+        $securecookie="lonSID=$cookie; path=/; HttpOnly; secure";
+        my $lonidsdir=$r->dir_config('lonIDsDir');
+        if (($lonidsdir) && (-e "$lonidsdir/$cookie.id")) {
+            my $linkname=substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex(time(). {}. rand(). $$)), 0, 32).'_linked';
+            if (-e "$lonidsdir/$linkname.id") {
+                unlink("$lonidsdir/$linkname.id");
+            }
+            my $made_symlink = eval { symlink("$lonidsdir/$cookie.id",
+                                              "$lonidsdir/$linkname.id"); 1 };
+            if ($made_symlink) {
+                $defaultcookie = "lonLinkID=$linkname; path=/; HttpOnly;";
+                &Apache::lonnet::appenv({'user.linkedenv' => $linkname});
+            }
+        }
+    } else {
+        $defaultcookie = "lonID=$cookie; path=/; HttpOnly;";
+    }
 # -------------------------------------------------------- Menu script and info
     my $destination = $lowerurl;
 
@@ -97,16 +119,26 @@ sub success {
     }
     if (defined($form->{symb})) {
         my $destsymb = $form->{symb};
+        my $encrypted;
+        if ($destsymb =~ m{^/enc/}) {
+            $encrypted = 1;
+            if ($cid) {
+                $destsymb = &Apache::lonenc::unencrypted($destsymb,$cid);
+            }
+        }
         $destination  .= ($destination =~ /\?/) ? '&' : '?';
         if ($destsymb =~ /___/) {
-            # FIXME Need to deal with encrypted symbs and urls as needed.
             my ($map,$resid,$desturl)=split(/___/,$destsymb);
             $desturl = &Apache::lonnet::clutter($desturl);
+            if ($encrypted) {
+                $desturl = &Apache::lonenc::encrypted($desturl,1,$cid);
+                $destsymb = $form->{symb};
+            }
             $desturl = &HTML::Entities::encode($desturl,'"<>&');
             $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
             $destination .= 'destinationurl='.$desturl.
                             '&destsymb='.$destsymb;
-        } else {
+        } elsif (!$encrypted) {
             $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
             $destination .= 'destinationurl='.$destsymb;
         }
@@ -136,7 +168,18 @@ sub success {
 # ------------------------------------------------- Output for successful login
 
     &Apache::loncommon::content_type($r,'text/html');
-    $r->header_out('Set-cookie' => $cookie);
+    if ($securecookie) {
+        $r->headers_out->add('Set-cookie' => $securecookie);
+    }
+    if ($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;
 
     my %lt=&Apache::lonlocal::texthash(
@@ -167,7 +210,7 @@ ENDSUCCESS
 # --------------------------------------------------------------- Failed login!
 
 sub failed {
-    my ($r,$message,$form) = @_;
+    my ($r,$message,$form,$authhost) = @_;
     (undef,undef,undef,my $clientmathml,my $clientunicode) =
         &Apache::loncommon::decode_user_agent();
     my $args = {};
@@ -188,17 +231,30 @@ sub failed {
     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;
+    my $lonhost = $r->dir_config('lonHostID');
+    my $querystr;
+    my $result = &set_retry_token($form,$lonhost,\$querystr);
+    if ($result eq 'fail') {
+        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;
+        if (exists($form->{symb})) {
+            my $symb = &Apache::loncommon::cleanup_html($form->{symb});
+            if ($symb ne '') {
+                $retry .= (($retry=~/\?/)?'&amp;':'?').'symb='.$symb;
+            }
+        }
+        if (exists($form->{firsturl})) {
+            my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
+            if ($firsturl ne '') {
+                $retry .= (($retry=~/\?/)?'&amp;':'?').'firsturl='.$firsturl;
+            }
         }
+    } elsif ($querystr ne '') {
+        $retry .= (($retry=~/\?/)?'&amp;':'?').$querystr;
     }
     my $end_page = &Apache::loncommon::end_page();
     &Apache::loncommon::content_type($r,'text/html');
@@ -261,8 +317,24 @@ sub handler {
 	    my $end_page = 
 	        &Apache::loncommon::end_page();
             my $dest = '/adm/roles';
-            if ($env{'form.firsturl'} ne '') {
-                $dest = $env{'form.firsturl'};
+            my %form = &get_form_items($r);
+            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(
                $start_page
@@ -278,19 +350,7 @@ sub handler {
 
 # ---------------------------------------------------- No valid token, continue
 
-
-    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;
-    }
-
+    my %form = &get_form_items($r);
     if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
 	&failed($r,'Username, password and domain need to be specified.',
 		\%form);
@@ -334,27 +394,13 @@ sub handler {
         return OK;
     }
 
-    my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr)=split(/&/,$tmpinfo);
-    if ($rolestr) {
-        $rolestr = &unescape($rolestr);
-    }
-    if ($symbstr) {
-        $symbstr= &unescape($symbstr);
-    }
-    if ($iptokenstr) {
-        $iptokenstr = &unescape($iptokenstr);
-    }
-    if ($rolestr =~ /^role=/) {
-        (undef,$form{'role'}) = split('=',$rolestr);
-    }
-    if ($symbstr =~ /^symb=/) { 
-        (undef,$form{'symb'}) = split('=',$symbstr);
-    }
-    if ($iptokenstr =~ /^iptoken=/) {
-        (undef,$form{'iptoken'}) = split('=',$iptokenstr);
+    my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
+    $firsturl = &unescape($firsturl);
+    foreach my $item (@rest) {
+        my ($key,$value) = split(/=/,$item);
+        $form{$key} = &unescape($value);
     }
-
-    my $upass = &Apache::loncommon::des_decrypt($key,$form{'upass0'});
+    my $upass = &Apache::loncommon::des_decrypt($des_key,$form{'upass0'});
 
 # ---------------------------------------------------------------- Authenticate
 
@@ -375,9 +421,33 @@ sub handler {
 # --------------------------------------------------------------------- Failed?
 
     if ($authhost eq 'no_host') {
-	&failed($r,'Username and/or password could not be authenticated.',
-		\%form);
-        return OK;
+        my $pwdverify;
+        if (&Apache::lonnet::homeserver($form{'uname'},$form{'udom'}) eq 'no_host') {
+            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);
+            return OK;
+        }
     } elsif ($authhost eq 'no_account_on_host') {
         if ($defaultauth) {
             my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
@@ -416,9 +486,9 @@ sub handler {
 	$firsturl='/adm/roles';
     }
 
-    my $hosthere;
+    my ($hosthere,%sessiondata);
     if ($form{'iptoken'}) {
-        my %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
+        %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
         my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
         if (($sessiondata{'domain'} eq $form{'udom'}) &&
             ($sessiondata{'username'} eq $form{'uname'})) {
@@ -503,11 +573,16 @@ sub handler {
         ($is_balancer,$otherserver) =
             &Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'},'login');
         if ($is_balancer) {
+            # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
+            my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r);
+            if (($found_server) && ($balancer_cookie =~ /^\Q$env{'user.domain'}\E_\Q$env{'user.name'}\E_/)) {
+                $otherserver = $found_server;
+            }
             if ($otherserver eq '') {
                 my $lowest_load;
                 ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});
                 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 '') {
@@ -535,6 +610,8 @@ sub handler {
             }
             $r->internal_redirect($switchto);
         } else {
+            &Apache::loncommon::content_type($r,'text/html');
+            $r->send_http_header;
             $r->print(&noswitch());
         }
         return OK;
@@ -556,6 +633,8 @@ sub handler {
                 }
                 $r->internal_redirect($switchto);
             } else {
+                &Apache::loncommon::content_type($r,'text/html');
+                $r->send_http_header;
                 $r->print(&noswitch());
             }
             return OK;
@@ -576,7 +655,7 @@ sub handler {
 
 # ---------------------------------------------------------- Are we overloaded?
         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) {
                 ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
             }
@@ -590,12 +669,70 @@ sub handler {
         if (($is_balancer) && ($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,
                  \%form);
         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 {
     my ($r,$form,$authhost,$domdesc) = @_;
     return unless (ref($form) eq 'HASH');
@@ -636,6 +773,8 @@ sub check_can_host {
             if ($login_host ne '') {
                 my $protocol = $Apache::lonnet::protocol{$login_host};
                 $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';
                 $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
                           '<h3>'.&mt('Account creation').'</h3>'.
@@ -696,6 +835,20 @@ sub loginhelpdisplay {
     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;
 __END__