--- loncom/lond 2021/06/15 20:52:27 1.567
+++ loncom/lond 2023/05/22 21:10:56 1.577
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.567 2021/06/15 20:52:27 raeburn Exp $
+# $Id: lond,v 1.577 2023/05/22 21:10:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,7 +65,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.567 $'; #' stupid emacs
+my $VERSION='$Revision: 1.577 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -239,6 +239,7 @@ my %trust = (
du2 => {remote => 1, enroll => 1},
dump => {remote => 1, enroll => 1, domroles => 1},
edit => {institutiononly => 1}, #not used currently
+ edump => {remote => 1, enroll => 1, domroles => 1},
eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently
egetdom => {remote => 1, domroles => 1, enroll => 1, },
ekey => {anywhere => 1},
@@ -258,6 +259,7 @@ my %trust = (
instidrules => {remote => 1, domroles => 1,},
instrulecheck => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},
instselfcreatecheck => {institutiononly => 1},
+ instunamemapcheck => {remote => 1,},
instuserrules => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},
keys => {remote => 1,},
load => {anywhere => 1},
@@ -265,6 +267,7 @@ my %trust = (
ls => {remote => 1, enroll => 1, content => 1,},
ls2 => {remote => 1, enroll => 1, content => 1,},
ls3 => {remote => 1, enroll => 1, content => 1,},
+ lti => {institutiononly => 1},
makeuser => {remote => 1, enroll => 1, domroles => 1,},
mkdiruserfile => {remote => 1, enroll => 1,},
newput => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1,},
@@ -303,6 +306,7 @@ my %trust = (
servertimezone => {remote => 1, enroll => 1},
setannounce => {remote => 1, domroles => 1},
sethost => {anywhere => 1},
+ signlti => {remote => 1},
store => {remote => 1, enroll => 1, reqcrs => 1,},
studentphoto => {remote => 1, enroll => 1},
sub => {content => 1,},
@@ -310,6 +314,7 @@ my %trust = (
tmpget => {institutiononly => 1},
tmpput => {remote => 1, othcoau => 1},
tokenauthuserfile => {anywhere => 1},
+ unamemaprules => {remote => 1,},
unsub => {content => 1,},
update => {shared => 1},
updatebalcookie => {institutiononly => 1},
@@ -861,7 +866,7 @@ sub PushFile {
if($filename eq "host") {
$contents = AdjustHostContents($contents);
- } elsif (($filename eq 'dns_host') || ($filename eq 'dns_domain') ||
+ } elsif (($filename eq 'dns_hosts') || ($filename eq 'dns_domain') ||
($filename eq 'loncapaCAcrl')) {
if ($contents eq '') {
&logthis('<font color="red"> Pushfile: unable to install '
@@ -2035,7 +2040,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'};
@@ -2653,6 +2658,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
@@ -3829,6 +3864,47 @@ sub dump_with_regexp {
}
®ister_handler("dump", \&dump_with_regexp, 0, 1, 0);
+#
+# Process the encrypted dump request. Original call should
+# be from lonnet::dump() with seventh arg ($encrypt) set to
+# 1, to ensure that both request and response are encrypted.
+#
+# Parameters:
+# $cmd - Command keyword of request (edump).
+# $tail - Tail of the command.
+# See &dump_with_regexp for more
+# information about this.
+# $client - File open on the client.
+# Returns:
+# 1 - Continue processing
+# 0 - server should exit.
+#
+
+sub encrypted_dump_with_regexp {
+ my ($cmd, $tail, $client) = @_;
+ my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion);
+
+ if ($res =~ /^error:/) {
+ Failure($client, \$res, "$cmd:$tail");
+ } 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","$cmd:$tail");
+ } else {
+ &Failure( $client, "error:no_key\n","$cmd:$tail");
+ }
+ }
+}
+®ister_handler("edump", \&encrypted_dump_with_regexp, 0, 1, 0);
+
# Store a set of key=value pairs associated with a versioned name.
#
# Parameters:
@@ -5099,7 +5175,7 @@ sub get_domain_handler {
my $userinput = "$cmd:$tail";
my ($udom,$namespace,$what)=split(/:/,$tail,3);
- if ($namespace =~ /^enc/) {
+ if (($namespace =~ /^enc/) || ($namespace eq 'private')) {
&Failure( $client, "refused\n", $userinput);
} else {
my $res = LONCAPA::Lond::get_dom($userinput);
@@ -5114,12 +5190,101 @@ sub get_domain_handler {
}
®ister_handler("getdom", \&get_domain_handler, 0, 1, 0);
+#
+# Encrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+# $cmd - Command request keyword (egetdom).
+# $tail - Tail of the command. This is a colon separated list
+# consisting of the domain and the 'namespace'
+# which selects the gdbm file to do the lookup in,
+# & separated list of keys to lookup. Note that
+# the values are returned as an & separated list too.
+# $client - File descriptor open on the client.
+# Returns:
+# 1 - Continue processing.
+# 0 - Exit.
+# Side effects:
+# reply is encrypted before being written to $client.
+#
sub encrypted_get_domain_handler {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";
- my $res = LONCAPA::Lond::get_dom($userinput);
+ my ($udom,$namespace,$what) = split(/:/,$tail,3);
+ if ($namespace eq 'private') {
+ &Failure( $client, "refused\n", $userinput);
+ } else {
+ 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);
+ }
+ }
+ }
+ return 1;
+}
+®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);
+
+#
+# Encrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+# $cmd - Command request keyword (lti).
+# $tail - Tail of the command. This is a colon-separated list
+# consisting of the domain, coursenum, if for LTI-
+# enabled deep-linking to course content using
+# link protection configured within a course,
+# context (=deeplink) if for LTI-enabled deep-linking
+# to course content using LTI Provider settings
+# configured within a course's domain, the (escaped)
+# launch URL, the (escaped) method (typically POST),
+# and a frozen hash of the LTI launch parameters
+# from the LTI payload.
+# $client - File descriptor open on the client.
+# Returns:
+# 1 - Continue processing.
+# 0 - Exit.
+# Side effects:
+# The reply will contain an LTI itemID, if the signed LTI payload
+# could be verified using the consumer key and the shared secret
+# available for that key (for the itemID) for either the course or domain,
+# depending on values for cnum and context. The reply is encrypted before
+# being written to $client.
+#
+sub lti_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($cdom,$cnum,$context,$escurl,$escmethod,$items) = split(/:/,$tail);
+ my $url = &unescape($escurl);
+ my $method = &unescape($escmethod);
+ my $params = &Apache::lonnet::thaw_unescape($items);
+ my $res;
+ if ($cnum ne '') {
+ $res = &LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
+ } else {
+ $res = &LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
+ }
if ($res =~ /^error:/) {
&Failure($client, \$res, $userinput);
} else {
@@ -5140,7 +5305,77 @@ sub encrypted_get_domain_handler {
}
return 1;
}
-®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);
+®ister_handler("lti", \<i_handler, 1, 1, 0);
+
+#
+# LTI data for launch payload (received encrypted) are unencrypted and
+# then signed with the appropriate key and secret, before re-encrypting
+# for sending as the signed payload to the client (caller lonnet::sign_lti()).
+#
+# Parameters:
+# $cmd - Command request keyword (signlti).
+# $tail - Tail of the command. This is a colon-separated list
+# consisting of the domain, coursenum (if for an External
+# Tool defined in a course), crstool (true if defined in
+# a course), escaped launch URL, numeric ID of external tool
+# version number for encryption key (if tool's LTI secret was
+# encrypted before storing), post (true if signed data are
+# to be returned from Net::OAuth, as a post_body),
+# a frozen hash of LTI launch parameters, and a frozen hash
+# of LTI config data (i.e., method => signature method).
+# $client - File descriptor open on the client.
+# Returns:
+# 1 - Continue processing.
+# 0 - Exit.
+# Side effects:
+# The reply will contain the LTI payload, as & separated key=value pairs,
+# where value is itself a frozen hash, if the required key and secret
+# for the apecific tool ID are available. The payload data are retrived from
+# a call to Lond::sign_params(), and the reply is encrypted before being
+# written to $client.
+#
+sub sign_lti_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($cdom,$cnum,$crstool,$escurl,$idx,$keynum,$post,$paramsref,$inforef) = split(/:/,$tail);
+ my $url = &unescape($escurl);
+ my $params = &Apache::lonnet::thaw_unescape($paramsref);
+ my $info = &Apache::lonnet::thaw_unescape($inforef);
+ my $res =
+ &LONCAPA::Lond::sign_params($cdom,$cnum,$crstool,$url,$idx,$keynum,
+ $post,$perlvar{'lonVersion'},$params,$info);
+ my $result;
+ if (ref($res) eq 'HASH') {
+ foreach my $key (keys(%{$res})) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($res->{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ } else {
+ $result = $res;
+ }
+ if ($result =~ /^error:/) {
+ &Failure($client, \$result, $userinput);
+ } else {
+ if ($cipher) {
+ my $cmdlength=length($result);
+ $result.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($result,
+ $encidx,
+ 8)));
+ }
+ &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
+ } else {
+ &Failure( $client, "error:no_key\n",$userinput);
+ }
+ }
+ return 1;
+}
+®ister_handler("signlti", \&sign_lti_handler, 1, 1, 0);
#
# Puts an id to a domains id database.
@@ -5567,15 +5802,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);
@@ -6666,6 +6909,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) = @_;
@@ -7752,7 +8028,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;
}
@@ -7941,7 +8217,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
@@ -7957,8 +8233,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.
@@ -8247,8 +8523,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'};
+ }
}
}
}