--- loncom/lond 2021/03/31 02:19:58 1.566 +++ loncom/lond 2021/10/26 15:52:55 1.569 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.566 2021/03/31 02:19:58 raeburn Exp $ +# $Id: lond,v 1.569 2021/10/26 15:52:55 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.566 $'; #' stupid emacs +my $VERSION='$Revision: 1.569 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -214,6 +214,7 @@ my %trust = ( 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}, @@ -238,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}, @@ -3828,6 +3830,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: @@ -5566,15 +5609,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); @@ -6106,6 +6157,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. # @@ -7884,7 +7991,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 @@ -7900,8 +8007,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.