--- loncom/lond 2021/06/20 18:41:28 1.489.2.35.2.5
+++ loncom/lond 2024/07/01 14:58:42 1.489.2.46
@@ -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.46 2024/07/01 14:58:42 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.46 $'; #' 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'};
@@ -2407,6 +2407,36 @@ sub update_passwd_history {
return;
}
+sub inst_unamemap_check {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my %rulecheck;
+ my $outcome;
+ my ($udom,$uname,@rules) = split(/:/,$tail);
+ $udom = &unescape($udom);
+ $uname = &unescape($uname);
+ @rules = map {&unescape($_);} (@rules);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome = &localenroll::unamemap_check($udom,$uname,\@rules,\%rulecheck);
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ my $result='';
+ foreach my $key (keys(%rulecheck)) {
+ $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+ }
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("instunamemapcheck",\&inst_unamemap_check,0,1,0);
+
+
#
# Determines if this is the home server for a user. The home server
# for a user will have his/her lon-capa passwd file. Therefore all we need
@@ -4682,48 +4712,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 +5148,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);
@@ -6249,6 +6255,39 @@ sub get_institutional_selfcreate_rules {
}
®ister_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0);
+sub get_unamemap_rules {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my $dom = &unescape($tail);
+ my (%rules_hash,@rules_order);
+ my $outcome;
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome = &localenroll::unamemap_rules($dom,\%rules_hash,\@rules_order);
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ my $result;
+ foreach my $key (keys(%rules_hash)) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ $result .= ':';
+ if (@rules_order > 0) {
+ foreach my $item (@rules_order) {
+ $result .= &escape($item).'&';
+ }
+ }
+ $result =~ s/\&$//;
+ &Reply($client,\$result,$userinput);
+ } else {
+ &Reply($client,"error\n", $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+}
+®ister_handler("unamemaprules",\&get_unamemap_rules,0,1,0);
sub institutional_username_check {
my ($cmd, $tail, $client) = @_;
@@ -6771,7 +6810,7 @@ undef $perlvarref;
# ----------------------------- Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
- my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+ my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}";
my $subj="LON: $currenthostid User ID mismatch";
system("echo 'User ID mismatch. lond must be run as user www.' |".
" mail -s '$subj' $emailto > /dev/null");
@@ -7224,7 +7263,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 +7429,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 +7445,8 @@ sub make_new_child {
&logthis("<font color='red'>CRITICAL: "
."Disconnect from $clientip ($clientname)</font>");
-
-
+
+
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
@@ -7627,8 +7666,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'};
+ }
}
}
}
@@ -7972,6 +8018,9 @@ sub currentversion {
if (-e $ulsdir) {
if(-d $ulsdir) {
if (opendir(LSDIR,$ulsdir)) {
+ if (-e $fname) {
+ $version=0;
+ }
my $ulsfn;
while ($ulsfn=readdir(LSDIR)) {
# see if this is a regular file (ignore links produced earlier)