--- loncom/lond 2021/06/20 18:41:28 1.489.2.35.2.5 +++ loncom/lond 2022/02/25 09:46:25 1.489.2.44 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.35.2.5 2021/06/20 18:41:28 raeburn Exp $ +# $Id: lond,v 1.489.2.44 2022/02/25 09:46:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -63,7 +63,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.489.2.35.2.5 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.44 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1795,7 +1795,7 @@ sub read_lonnet_global { } if ($what eq 'perlvar') { if (!exists($packagevars{$what}{'lonBalancer'})) { - if ($dist =~ /^(centos|rhes|fedora|scientific|oracle)/) { + if ($dist =~ /^(centos|rhes|fedora|scientific|oracle|rocky|alma)/) { my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf'); if (ref($othervarref) eq 'HASH') { $items->{'lonBalancer'} = $othervarref->{'lonBalancer'}; @@ -4682,48 +4682,16 @@ sub get_domain_handler { my $userinput = "$cmd:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); - if ($namespace =~ /^enc/) { - &Failure( $client, "refused\n", $userinput); - } else { - my $res = LONCAPA::Lond::get_dom($userinput); - if ($res =~ /^error:/) { - &Failure($client, \$res, $userinput); - } else { - &Reply($client, \$res, $userinput); - } - } - - return 1; -} -®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); - -sub encrypted_get_domain_handler { - my ($cmd, $tail, $client) = @_; - - my $userinput = "$cmd:$tail"; - my $res = LONCAPA::Lond::get_dom($userinput); if ($res =~ /^error:/) { &Failure($client, \$res, $userinput); } else { - if ($cipher) { - my $cmdlength=length($res); - $res.=" "; - my $encres=''; - for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { - $encres.= unpack("H16", - $cipher->encrypt(substr($res, - $encidx, - 8))); - } - &Reply( $client,"enc:$cmdlength:$encres\n",$userinput); - } else { - &Failure( $client, "error:no_key\n",$userinput); - } + &Reply($client, \$res, $userinput); } + return 1; } -®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0); +®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); # # Puts an id to a domains id database. @@ -5150,15 +5118,23 @@ sub tmp_put_handler { } my ($id,$store); $tmpsnum++; - if (($context eq 'resetpw') || ($context eq 'createaccount')) { - $id = &md5_hex(&md5_hex(time.{}.rand().$$)); + my $numtries = 0; + my $execdir=$perlvar{'lonDaemons'}; + if (($context eq 'resetpw') || ($context eq 'createaccount') || + ($context eq 'sso') || ($context eq 'link') || ($context eq 'retry')) { + $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum)); + while ((-e "$execdir/tmp/$id.tmp") && ($numtries <10)) { + undef($id); + $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum)); + $numtries ++; + } } else { $id = $$.'_'.$clientip.'_'.$tmpsnum; } $id=~s/\W/\_/g; $record=~s/\n//g; - my $execdir=$perlvar{'lonDaemons'}; - if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { + if (($id ne '') && + ($store=IO::File->new(">$execdir/tmp/$id.tmp"))) { print $store $record; close $store; &Reply($client, \$id, $userinput); @@ -7224,7 +7200,7 @@ sub make_new_child { &Authen::Krb5::init_context(); my $no_ets; - if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) { + if ($dist =~ /^(?:centos|rhes|scientific|oracle|rocky|alma)(\d+)/) { if ($1 >= 7) { $no_ets = 1; } @@ -7390,7 +7366,7 @@ sub make_new_child { Debug("Main: Got $user_input\n"); $keep_going = &process_request($user_input); alarm(0); - &status('Listening to '.$clientname." ($keymode)"); + &status('Listening to '.$clientname." ($keymode)"); } # --------------------------------------------- client unknown or fishy, refuse @@ -7406,8 +7382,8 @@ sub make_new_child { &logthis("CRITICAL: " ."Disconnect from $clientip ($clientname)"); - - + + # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death. @@ -7627,8 +7603,15 @@ sub validate_user { } elsif ((($domdefaults{'auth_def'} eq 'krb4') || ($domdefaults{'auth_def'} eq 'krb5')) && ($domdefaults{'auth_arg_def'} ne '')) { - $howpwd = $domdefaults{'auth_def'}; - $contentpwd = $domdefaults{'auth_arg_def'}; + # + # Don't attempt authentication for username and password supplied + # for user without an account if uername contains @ to avoid + # call to &Authen::Krb5::parse_name() which will result in con_lost + # + unless ($user =~ /\@/) { + $howpwd = $domdefaults{'auth_def'}; + $contentpwd = $domdefaults{'auth_arg_def'}; + } } } }