--- loncom/lond 2021/02/08 14:50:53 1.565
+++ loncom/lond 2023/06/07 14:21:52 1.579
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.565 2021/02/08 14:50:53 raeburn Exp $
+# $Id: lond,v 1.579 2023/06/07 14:21:52 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.565 $'; #' stupid emacs
+my $VERSION='$Revision: 1.579 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -213,6 +213,8 @@ my %trust = (
autovalidateclass_sec => {catalog => 1},
autovalidatecourse => {remote => 1, enroll => 1},
autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1},
+ autovalidateinstcrosslist => {remote => 1, enroll => 1},
+ autoinstsecreformat => {remote => 1, enroll => 1},
changeuserauth => {remote => 1, domroles => 1},
chatretr => {remote => 1, enroll => 1},
chatsend => {remote => 1, enroll => 1},
@@ -237,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},
@@ -256,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},
@@ -263,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,},
@@ -301,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,},
@@ -308,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},
@@ -859,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 '
@@ -2033,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'};
@@ -2651,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
@@ -3827,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:
@@ -5097,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);
@@ -5112,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 {
@@ -5138,7 +5305,82 @@ 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);
+
+#
+# Data for LTI payload (received encrypted) are unencrypted and
+# then signed with the appropriate key and secret, before re-encrypting
+# the signed payload which is sent to the client for unencryption by
+# the caller: lonnet::sign_lti()) before dispatch either to a web browser
+# (launch) or to a remote web service (roster, logout, or grade).
+#
+# 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), crsdef (true if defined in
+# a course), type (linkprot or lti)
+# context (launch, roster, logout, or grade),
+# escaped launch URL, numeric ID of external tool,
+# version number for encryption key (if tool's LTI secret was
+# encrypted before storing), a frozen hash of LTI launch
+# parameters, and a frozen hash of LTI information,
+# (e.g., method => 'HMAC-SHA1',
+# respfmt => 'to_authorization_header').
+# $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 specific tool ID are available. The payload data are retrieved from
+# a call to Lond::sign_lti_payload(), 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,$crsdef,$type,$context,$escurl,
+ $ltinum,$keynum,$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_lti_payload($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,
+ $keynum,$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.
@@ -5565,15 +5807,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);
@@ -5948,6 +6198,39 @@ sub validate_instcode_handler {
}
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
+#
+# Validate co-owner for cross-listed institutional code and
+# institutional course code itself used for a LON-CAPA course.
+#
+# Formal Parameters:
+# $cmd - The command request that got us dispatched.
+# $tail - The tail of the command. In this case,
+# this is a colon separated string containing:
+# $dom - Course's LON-CAPA domain
+# $instcode - Institutional course code for the course
+# $inst_xlist - Institutional course Id for the crosslisting
+# $coowner - Username of co-owner
+# (values for all but $dom have been escaped).
+#
+# $client - Socket open on the client.
+# Returns:
+# 1 - Indicating processing should continue.
+#
+sub validate_instcrosslist_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($dom,$instcode,$inst_xlist,$coowner) = split(/:/,$tail);
+ $instcode = &unescape($instcode);
+ $inst_xlist = &unescape($inst_xlist);
+ $coowner = &unescape($coowner);
+ my $outcome = &localenroll::validate_crosslist_access($dom,$instcode,
+ $inst_xlist,$coowner);
+ &Reply($client, \$outcome, $userinput);
+
+ return 1;
+}
+®ister_handler("autovalidateinstcrosslist", \&validate_instcrosslist_handler, 0, 1, 0);
+
# Get the official sections for which auto-enrollment is possible.
# Since the admin people won't know about 'unofficial sections'
# we cannot auto-enroll on them.
@@ -6072,6 +6355,62 @@ sub validate_class_access_handler {
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
#
+# Modify institutional sections (using customized &instsec_reformat()
+# routine in localenroll.pm), to either clutter or declutter, for
+# purposes of ensuring an institutional course section (string) can
+# be unambiguously separated into institutional course and section.
+#
+# Formal Parameters:
+# $cmd - The command request that got us dispatched.
+# $tail - The tail of the command. In this case this is a colon separated
+# set of values that will be split into:
+# $cdom - The LON-CAPA domain of the course.
+# $action - Either: clutter or declutter
+# clutter adds character(s) to eliminate ambiguity
+# declutter removes the added characters (e.g., for
+# display of the institutional course section string.
+# $info - A frozen hash in which keys are:
+# LON-CAPA course number:Institutional course code
+# and values are a reference to an array of the
+# items to modify -- either institutional sections,
+# or institutional course sections (for crosslistings).
+# $client - The socket open on the client.
+# Returns:
+# 1 - continue processing.
+#
+
+sub instsec_reformat_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($cdom,$action,$info) = split(/:/,$tail);
+ my $instsecref = &Apache::lonnet::thaw_unescape($info);
+ my ($outcome,$result);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome=&localenroll::instsec_reformat($cdom,$action,$instsecref);
+ if ($outcome eq 'ok') {
+ if (ref($instsecref) eq 'HASH') {
+ foreach my $key (keys(%{$instsecref})) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($instsecref->{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ }
+ }
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ &Reply( $client, \$result, $userinput);
+ } else {
+ &Reply($client,\$outcome, $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+ return 1;
+}
+®ister_handler("autoinstsecreformat",\&instsec_reformat_handler, 0, 1, 0);
+
+#
# Validate course owner or co-owners(s) access to enrollment data for all sections
# and crosslistings for a particular course.
#
@@ -6575,6 +6914,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) = @_;
@@ -7661,7 +8033,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;
}
@@ -7850,7 +8222,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
@@ -7866,8 +8238,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.
@@ -8156,8 +8528,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'};
+ }
}
}
}