--- loncom/lond 2018/03/23 01:02:22 1.543 +++ loncom/lond 2021/06/15 20:52:27 1.567 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.543 2018/03/23 01:02:22 raeburn Exp $ +# $Id: lond,v 1.567 2021/06/15 20:52:27 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.543 $'; #' stupid emacs +my $VERSION='$Revision: 1.567 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -80,11 +80,12 @@ my $clientsamedom; # LonCAP # and client. my $clientsameinst; # LonCAPA "internet domain" same for # this host and client. -my $clientremoteok; # Client allowed to host domain's users. - # (version constraints ignored), not set - # if this host and client share "internet domain". -my %clientprohibited; # Actions prohibited on client; - +my $clientremoteok; # Current domain permits hosting on client + # (not set if host and client share "internet domain"). + # Values are 0 or 1; 1 if allowed. +my %clientprohibited; # Commands from client prohibited for domain's + # users. + my $server; my $keymode; @@ -108,6 +109,10 @@ my %perlvar; # Will have the apache co my %secureconf; # Will have requirements for security # of lond connections +my %crlchecked; # Will contain clients for which the client's SSL + # has been checked against the cluster's Certificate + # Revocation List. + my $dist; # @@ -172,6 +177,7 @@ my @installerrors = ("ok", # shared ("Access to other domain's content by this domain") # enroll ("Enrollment in this domain's courses by others") # coaurem ("Co-author roles for this domain's users elsewhere") +# othcoau ("Co-author roles in this domain for others") # domroles ("Domain roles in this domain assignable to others") # catalog ("Course Catalog for this domain displayed elsewhere") # reqcrs ("Requests for creation of courses in this domain by others") @@ -207,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}, @@ -214,12 +222,15 @@ my %trust = ( courseidput => {remote => 1, domroles => 1, enroll => 1}, courseidputhash => {remote => 1, domroles => 1, enroll => 1}, courselastaccess => {remote => 1, domroles => 1, enroll => 1}, + coursesessions => {institutiononly => 1}, currentauth => {remote => 1, domroles => 1, enroll => 1}, currentdump => {remote => 1, enroll => 1}, currentversion => {remote=> 1, content => 1}, dcmaildump => {remote => 1, domroles => 1}, dcmailput => {remote => 1, domroles => 1}, del => {remote => 1, domroles => 1, enroll => 1, content => 1}, + delbalcookie => {institutiononly => 1}, + delusersession => {institutiononly => 1}, deldom => {remote => 1, domroles => 1}, # not currently used devalidatecache => {institutiononly => 1}, domroleput => {remote => 1, enroll => 1}, @@ -230,7 +241,7 @@ my %trust = ( edit => {institutiononly => 1}, #not used currently eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently egetdom => {remote => 1, domroles => 1, enroll => 1, }, - ekey => {}, #not used currently + ekey => {anywhere => 1}, exit => {anywhere => 1}, fetchuserfile => {remote => 1, enroll => 1}, get => {remote => 1, domroles => 1, enroll => 1}, @@ -295,12 +306,13 @@ my %trust = ( store => {remote => 1, enroll => 1, reqcrs => 1,}, studentphoto => {remote => 1, enroll => 1}, sub => {content => 1,}, - tmpdel => {anywhere => 1}, - tmpget => {anywhere => 1}, - tmpput => {anywhere => 1}, + tmpdel => {institutiononly => 1}, + tmpget => {institutiononly => 1}, + tmpput => {remote => 1, othcoau => 1}, tokenauthuserfile => {anywhere => 1}, unsub => {content => 1,}, update => {shared => 1}, + updatebalcookie => {institutiononly => 1}, updateclickers => {remote => 1}, userhassession => {anywhere => 1}, userload => {anywhere => 1}, @@ -420,10 +432,19 @@ sub SSLConnection { Debug("Approving promotion -> ssl"); # And do so: + my $CRLFile; + unless ($crlchecked{$clientname}) { + $CRLFile = lonssl::CRLFile(); + $crlchecked{$clientname} = 1; + } + my $SSLSocket = lonssl::PromoteServerSocket($Socket, $CACertificate, $Certificate, - $KeyFile); + $KeyFile, + $clientname, + $CRLFile, + $clientversion); if(! ($SSLSocket) ) { # SSL socket promotion failed. my $err = lonssl::LastError(); &logthis(" CRITICAL " @@ -779,10 +800,17 @@ sub ConfigFileFromSelector { my $selector = shift; my $tablefile; - my $tabledir = $perlvar{'lonTabDir'}.'/'; - if (($selector eq "hosts") || ($selector eq "domain") || - ($selector eq "dns_hosts") || ($selector eq "dns_domain")) { - $tablefile = $tabledir.$selector.'.tab'; + if ($selector eq 'loncapaCAcrl') { + my $tabledir = $perlvar{'lonCertificateDirectory'}; + if (-d $tabledir) { + $tablefile = $tabledir.'/'.$selector.'.pem'; + } + } else { + my $tabledir = $perlvar{'lonTabDir'}.'/'; + if (($selector eq "hosts") || ($selector eq "domain") || + ($selector eq "dns_hosts") || ($selector eq "dns_domain")) { + $tablefile = $tabledir.$selector.'.tab'; + } } return $tablefile; } @@ -806,12 +834,13 @@ sub PushFile { my ($command, $filename, $contents) = split(":", $request, 3); &Debug("PushFile"); - # At this point in time, pushes for only the following tables are - # supported: + # At this point in time, pushes for only the following tables and + # CRL file are supported: # hosts.tab ($filename eq host). # domain.tab ($filename eq domain). # dns_hosts.tab ($filename eq dns_host). - # dns_domain.tab ($filename eq dns_domain). + # dns_domain.tab ($filename eq dns_domain). + # loncapaCAcrl.pem ($filename eq loncapaCAcrl). # Construct the destination filename or reject the request. # # lonManage is supposed to ensure this, however this session could be @@ -832,7 +861,8 @@ sub PushFile { if($filename eq "host") { $contents = AdjustHostContents($contents); - } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { + } elsif (($filename eq 'dns_host') || ($filename eq 'dns_domain') || + ($filename eq 'loncapaCAcrl')) { if ($contents eq '') { &logthis(' Pushfile: unable to install ' .$tablefile." - no data received from push. "); @@ -843,8 +873,13 @@ sub PushFile { if ($managers{$clientip} eq $clientname) { my $clientprotocol = $Apache::lonnet::protocol{$clientname}; $clientprotocol = 'http' if ($clientprotocol ne 'https'); - my $url = '/adm/'.$filename; - $url =~ s{_}{/}; + my $url; + if ($filename eq 'loncapaCAcrl') { + $url = '/adm/dns/loncapaCRL'; + } else { + $url = '/adm/'.$filename; + $url =~ s{_}{/}; + } my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0); if ($response->is_error()) { @@ -1882,6 +1917,14 @@ sub ls3_handler { my $rights; my $ulsout=''; my $ulsfn; + + my ($crscheck,$toplevel,$currdom,$currnum,$skip); + unless ($islocal) { + my ($major,$minor) = split(/\./,$clientversion); + if (($major < 2) || ($major == 2 && $minor < 12)) { + $crscheck = 1; + } + } if (-e $ulsdir) { if(-d $ulsdir) { unless (($getpropath) || ($getuserdir) || @@ -1891,8 +1934,26 @@ sub ls3_handler { &Failure($client,"refused\n",$userinput); return 1; } - if (opendir(LSDIR,$ulsdir)) { + if (($crscheck) && + ($ulsdir =~ m{^/home/httpd/html/res/($LONCAPA::match_domain)(/?$|/$LONCAPA::match_courseid)})) { + ($currdom,my $posscnum) = ($1,$2); + if (($posscnum eq '') || ($posscnum eq '/')) { + $toplevel = 1; + } else { + $posscnum =~ s{^/+}{}; + if (&LONCAPA::Lond::is_course($currdom,$posscnum)) { + $skip = 1; + } + } + } + if ((!$skip) && (opendir(LSDIR,$ulsdir))) { while ($ulsfn=readdir(LSDIR)) { + if (($crscheck) && ($toplevel) && ($currdom ne '') && + ($ulsfn =~ /^$LONCAPA::match_courseid$/) && (-d "$ulsdir/$ulsfn")) { + if (&LONCAPA::Lond::is_course($currdom,$ulsfn)) { + next; + } + } undef($obs); undef($rights); my @ulsstats=stat($ulsdir.'/'.$ulsfn); @@ -1974,7 +2035,7 @@ sub read_lonnet_global { } if ($what eq 'perlvar') { if (!exists($packagevars{$what}{'lonBalancer'})) { - if ($dist =~ /^(centos|rhes|fedora|scientific)/) { + if ($dist =~ /^(centos|rhes|fedora|scientific|oracle)/) { my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf'); if (ref($othervarref) eq 'HASH') { $items->{'lonBalancer'} = $othervarref->{'lonBalancer'}; @@ -2070,8 +2131,8 @@ sub server_distarch_handler { sub server_certs_handler { my ($cmd,$tail,$client) = @_; my $userinput = "$cmd:$tail"; - my $result; - my $result = &LONCAPA::Lond::server_certs(\%perlvar); + my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'}); + my $result = &LONCAPA::Lond::server_certs(\%perlvar,$perlvar{'lonHostID'},$hostname); &Reply($client,\$result,$userinput); return; } @@ -2292,12 +2353,84 @@ sub change_password_handler { } if($validated) { my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd. - my ($howpwd,$contentpwd)=split(/:/,$realpasswd); + my $notunique; if ($howpwd eq 'internal') { &Debug("internal auth"); my $ncpass = &hash_passwd($udom,$npass); - if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { + my (undef,$method,@rest) = split(/!/,$contentpwd); + if ($method eq 'bcrypt') { + my %passwdconf = &Apache::lonnet::get_passwdconf($udom); + if (($passwdconf{'numsaved'}) && ($passwdconf{'numsaved'} =~ /^\d+$/)) { + my @oldpasswds; + my $userpath = &propath($udom,$uname); + my $fullpath = $userpath.'/oldpasswds'; + if (-d $userpath) { + my @oldfiles; + if (-e $fullpath) { + if (opendir(my $dir,$fullpath)) { + (@oldfiles) = grep(/^\d+$/,readdir($dir)); + closedir($dir); + } + if (@oldfiles) { + @oldfiles = sort { $b <=> $a } (@oldfiles); + my $numremoved = 0; + for (my $i=0; $i<@oldfiles; $i++) { + if ($i>=$passwdconf{'numsaved'}) { + if (-f "$fullpath/$oldfiles[$i]") { + if (unlink("$fullpath/$oldfiles[$i]")) { + $numremoved ++; + } + } + } elsif (open(my $fh,'<',"$fullpath/$oldfiles[$i]")) { + while (my $line = <$fh>) { + push(@oldpasswds,$line); + } + close($fh); + } + } + if ($numremoved) { + &logthis("unlinked $numremoved old password files for $uname:$udom"); + } + } + } + push(@oldpasswds,$contentpwd); + foreach my $item (@oldpasswds) { + my (undef,$method,@rest) = split(/!/,$item); + if ($method eq 'bcrypt') { + my $result = &hash_passwd($udom,$npass,@rest); + if ($result eq $item) { + $notunique = 1; + last; + } + } + } + unless ($notunique) { + unless (-e $fullpath) { + if (&mkpath("$fullpath/")) { + chmod(0700,$fullpath); + } + } + if (-d $fullpath) { + my $now = time; + if (open(my $fh,'>',"$fullpath/$now")) { + print $fh $contentpwd; + close($fh); + chmod(0400,"$fullpath/$now"); + } + } + } + } + } + } + if ($notunique) { + my $msg="Result of password change for $uname:$udom - password matches one used before"; + if ($lonhost) { + $msg .= " - request originated from: $lonhost"; + } + &logthis($msg); + &Reply($client, "prioruse\n", $userinput); + } elsif (&rewrite_password_file($udom, $uname, "internal:$ncpass")) { my $msg="Result of password change for $uname: pwchange_success"; if ($lonhost) { $msg .= " - request originated from: $lonhost"; @@ -2314,7 +2447,7 @@ sub change_password_handler { my $result = &change_unix_password($uname, $npass); if ($result eq 'ok') { &update_passwd_history($uname,$udom,$howpwd,$context); - } + } &logthis("Result of password change for $uname: ". $result); &Reply($client, \$result, $userinput); @@ -2325,7 +2458,6 @@ sub change_password_handler { # &Failure( $client, "auth_mode_error\n", $userinput); } - } else { if ($failure eq '') { $failure = 'non_authorized'; @@ -2906,6 +3038,54 @@ sub user_has_session_handler { } ®ister_handler("userhassession", \&user_has_session_handler, 0,1,0); +sub del_usersession_handler { + my ($cmd, $tail, $client) = @_; + + my $result; + my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); + if (($udom =~ /^$LONCAPA::match_domain$/) && ($uname =~ /^$LONCAPA::match_username$/)) { + my $lonidsdir = $perlvar{'lonIDsDir'}; + if (-d $lonidsdir) { + if (opendir(DIR,$lonidsdir)) { + my $filename; + while ($filename=readdir(DIR)) { + if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/) { + if (tie(my %oldenv,'GDBM_File',"$lonidsdir/$filename", + &GDBM_READER(),0640)) { + my $linkedfile; + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); + $result = unlink("$lonidsdir/$filename"); + if ($result) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonidsdir/$linkedfile.id") { + unlink("$lonidsdir/$linkedfile.id"); + } + } + } + } else { + $result = unlink("$lonidsdir/$filename"); + } + last; + } + } + } + } + if ($result == 1) { + &Reply($client, "$result\n", "$cmd:$tail"); + } else { + &Reply($client, "not_found\n", "$cmd:$tail"); + } + } else { + &Failure($client, "invalid_user\n", "$cmd:$tail"); + } + return 1; +} + +®ister_handler("delusersession", \&del_usersession_handler, 0,1,0); + # # Authenticate access to a user file by checking that the token the user's # passed also exists in their session file @@ -4697,6 +4877,44 @@ sub course_lastaccess_handler { } ®ister_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0); +sub course_sessions_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($cdom,$cnum,$lastactivity) = split(':',$tail); + my $dbsuffix = '_'.$cdom.'_'.$cnum.'.db'; + my (%sessions,$qresult); + my $now=time; + if (opendir(DIR,$perlvar{'lonIDsDir'})) { + my $filename; + while ($filename=readdir(DIR)) { + next if ($filename=~/^\./); + next if ($filename=~/^publicuser_/); + next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/); + if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) { + my ($uname,$udom) = ($1,$2); + next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix"); + my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9]; + if ($lastactivity < 0) { + next if ($mtime-$now > $lastactivity); + } else { + next if ($now-$mtime > $lastactivity); + } + $sessions{$uname.':'.$udom} = $mtime; + } + } + closedir(DIR); + } + foreach my $user (keys(%sessions)) { + $qresult.=&escape($user).'='.$sessions{$user}.'&'; + } + if ($qresult) { + chop($qresult); + } + &Reply($client, \$qresult, $userinput); + return 1; +} +®ister_handler("coursesessions",\&course_sessions_handler, 0, 1, 0); + # # Puts an unencrypted entry in a namespace db file at the domain level # @@ -4861,7 +5079,7 @@ sub del_domain_handler { # domain directory. # # Parameters: -# $cmd - Command request keyword (get). +# $cmd - Command request keyword (getdom). # $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, @@ -4878,31 +5096,17 @@ sub del_domain_handler { sub get_domain_handler { my ($cmd, $tail, $client) = @_; - my $userinput = "$cmd:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); - chomp($what); if ($namespace =~ /^enc/) { &Failure( $client, "refused\n", $userinput); } else { - my @queries=split(/\&/,$what); - my $qresult=''; - my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); - if ($hashref) { - for (my $i=0;$i<=$#queries;$i++) { - $qresult.="$hashref->{$queries[$i]}&"; - } - if (&untie_domain_hash($hashref)) { - $qresult=~s/\&$//; - &Reply($client, \$qresult, $userinput); - } else { - &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting getdom\n",$userinput); - } + my $res = LONCAPA::Lond::get_dom($userinput); + if ($res =~ /^error:/) { + &Failure($client, \$res, $userinput); } else { - &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting getdom\n",$userinput); + &Reply($client, \$res, $userinput); } } @@ -4915,38 +5119,24 @@ sub encrypted_get_domain_handler { my $userinput = "$cmd:$tail"; - my ($udom,$namespace,$what)=split(/:/,$tail,3); - chomp($what); - my @queries=split(/\&/,$what); - my $qresult=''; - my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); - if ($hashref) { - for (my $i=0;$i<=$#queries;$i++) { - $qresult.="$hashref->{$queries[$i]}&"; - } - if (&untie_domain_hash($hashref)) { - $qresult=~s/\&$//; - if ($cipher) { - my $cmdlength=length($qresult); - $qresult.=" "; - my $encqresult=''; - for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { - $encqresult.= unpack("H16", - $cipher->encrypt(substr($qresult, - $encidx, - 8))); - } - &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); - } else { - &Failure( $client, "error:no_key\n", $userinput); + 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: ".($!+0)." untie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); + &Failure( $client, "error:no_key\n",$userinput); } - } else { - &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting egetdom\n",$userinput); } return 1; } @@ -5468,6 +5658,116 @@ sub tmp_del_handler { ®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0); # +# Process the updatebalcookie command. This command updates a +# cookie in the lonBalancedir directory on a load balancer node. +# +# Parameters: +# $cmd - Command that got us here. +# $tail - Tail of the request (escaped cookie: escaped current entry) +# +# $client - socket open on the client process. +# +# Returns: +# 1 - Indicating processing should continue. +# Side Effects: +# A cookie file is updated from the lonBalancedir directory +# A reply is sent to the client. +# +sub update_balcookie_handler { + my ($cmd, $tail, $client) = @_; + + my $userinput= "$cmd:$tail"; + chomp($tail); + my ($cookie,$lastentry) = map { &unescape($_) } (split(/:/,$tail)); + + my $updatedone; + if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) { + my $execdir=$perlvar{'lonBalanceDir'}; + if (-e "$execdir/$cookie.id") { + my $doupdate; + if (open(my $fh,'<',"$execdir/$cookie.id")) { + while (my $line = <$fh>) { + chomp($line); + if ($line eq $lastentry) { + $doupdate = 1; + last; + } + } + close($fh); + } + if ($doupdate) { + if (open(my $fh,'>',"$execdir/$cookie.id")) { + print $fh $clientname; + close($fh); + $updatedone = 1; + } + } + } + } + if ($updatedone) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure( $client, "error: ".($!+0)."file update failed ". + "while attempting updatebalcookie\n", $userinput); + } + return 1; +} +®ister_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0); + +# +# Process the delbalcookie command. This command deletes a balancer +# cookie in the lonBalancedir directory on a load balancer node. +# +# Parameters: +# $cmd - Command that got us here. +# $cookie - Cookie to be deleted. +# $client - socket open on the client process. +# +# Returns: +# 1 - Indicating processing should continue. +# Side Effects: +# A cookie file is deleted from the lonBalancedir directory +# A reply is sent to the client. +sub del_balcookie_handler { + my ($cmd, $cookie, $client) = @_; + + my $userinput= "$cmd:$cookie"; + + chomp($cookie); + $cookie = &unescape($cookie); + my $deleted = ''; + if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) { + my $execdir=$perlvar{'lonBalanceDir'}; + if (-e "$execdir/$cookie.id") { + if (open(my $fh,'<',"$execdir/$cookie.id")) { + my $dodelete; + while (my $line = <$fh>) { + chomp($line); + if ($line eq $clientname) { + $dodelete = 1; + last; + } + } + close($fh); + if ($dodelete) { + if (unlink("$execdir/$cookie.id")) { + $deleted = 1; + } + } + } + } + } + if ($deleted) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure( $client, "error: ".($!+0)."Unlinking cookie file Failed ". + "while attempting delbalcookie\n", $userinput); + } + return 1; +} +®ister_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0); + +# # Processes the setannounce command. This command # creates a file named announce.txt in the top directory of # the documentn root and sets its contents. The announce.txt file is @@ -5650,6 +5950,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. @@ -5774,6 +6107,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. # @@ -6857,8 +7246,8 @@ my $wwwid=getpwnam('www'); if ($wwwid!=$<) { 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.' |\ - mailto $emailto -s '$subj' > /dev/null"); + system("echo 'User ID mismatch. lond must be run as user www.' |". + " mail -s '$subj' $emailto > /dev/null"); exit 1; } @@ -6992,10 +7381,10 @@ sub UpdateHosts { my %oldconf = %secureconf; my %connchange; - if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { - logthis(' Reloaded SSL connection rules '); + if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') { + logthis(' Reloaded SSL connection rules and cleared CRL checking history '); } else { - logthis(' Failed to reload SSL connection rules '); + logthis(' Failed to reload SSL connection rules and clear CRL checking history '); } if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) { foreach my $type ('dom','intdom','other') { @@ -7274,7 +7663,7 @@ if ($arch eq 'unknown') { chomp($arch); } -unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { +unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') { &logthis('No connectionrules table. Will fallback to loncapa.conf'); } @@ -7363,7 +7752,7 @@ sub make_new_child { &Authen::Krb5::init_context(); my $no_ets; - if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) { + if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) { if ($1 >= 7) { $no_ets = 1; } @@ -7408,7 +7797,7 @@ sub make_new_child { $ConnectionType = "manager"; $clientname = $managers{$outsideip}; } - my ($clientok,$clientinfoset); + my $clientok; if ($clientrec || $ismanager) { &status("Waiting for init from $clientip $clientname"); @@ -7509,7 +7898,6 @@ sub make_new_child { } } else { - $clientinfoset = &set_client_info(); my $ok = InsecureConnection($client); if($ok) { $clientok = 1; @@ -7547,34 +7935,7 @@ sub make_new_child { # ------------------------------------------------------------ Process requests my $keep_going = 1; my $user_input; - unless ($clientinfoset) { - $clientinfoset = &set_client_info(); - } - $clientremoteok = 0; - unless ($clientsameinst) { - $clientremoteok = 1; - my $defdom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); - %clientprohibited = &get_prohibited($defdom); - if ($clientintdom) { - my $remsessconf = &get_usersession_config($defdom,'remotesession'); - if (ref($remsessconf) eq 'HASH') { - if (ref($remsessconf->{'remote'}) eq 'HASH') { - if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') { - if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) { - $clientremoteok = 0; - } - } - if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') { - if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) { - $clientremoteok = 1; - } else { - $clientremoteok = 0; - } - } - } - } - } - } + while(($user_input = get_request) && $keep_going) { alarm(120); Debug("Main: Got $user_input\n"); @@ -7607,22 +7968,30 @@ sub make_new_child { # # Used to determine if a particular client is from the same domain -# as the current server, or from the same internet domain. +# as the current server, or from the same internet domain, and +# also if the client can host sessions for the domain's users. +# A hash is populated with keys set to commands sent by the client +# which may not be executed for this domain. # # Optional input -- the client to check for domain and internet domain. # If not specified, defaults to the package variable: $clientname # # If called in array context will not set package variables, but will # instead return an array of two values - (a) true if client is in the -# same domain as the server, and (b) true if client is in the same internet -# domain. +# same domain as the server, and (b) true if client is in the same +# internet domain. # # If called in scalar context, sets package variables for current client: # -# $clienthomedom - LonCAPA domain of homeID for client. -# $clientsamedom - LonCAPA domain same for this host and client. -# $clientintdom - LonCAPA "internet domain" for client. -# $clientsameinst - LonCAPA "internet domain" same for this host & client. +# $clienthomedom - LonCAPA domain of homeID for client. +# $clientsamedom - LonCAPA domain same for this host and client. +# $clientintdom - LonCAPA "internet domain" for client. +# $clientsameinst - LonCAPA "internet domain" same for this host & client. +# $clientremoteok - If current domain permits hosting on this client: 1 +# %clientprohibited - Commands prohibited for domain's users for this client. +# +# if the host and client have the same "internet domain", then the value +# of $clientremoteok is not used, and no commands are prohibited. # # returns 1 to indicate package variables have been set for current client. # @@ -7634,7 +8003,7 @@ sub set_client_info { my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost); my $homedom = &Apache::lonnet::host_domain($clientserverhomeID); my $samedom = 0; - if ($perlvar{'lonDefDom'} eq $homedom) { + if ($perlvar{'lonDefDomain'} eq $homedom) { $samedom = 1; } my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID); @@ -7654,6 +8023,13 @@ sub set_client_info { $clientsamedom = $samedom; $clientintdom = $intdom; $clientsameinst = $sameinst; + if ($clientsameinst) { + undef($clientremoteok); + undef(%clientprohibited); + } else { + $clientremoteok = &get_remote_hostable($currentdomainid); + %clientprohibited = &get_prohibited($currentdomainid); + } return 1; } } @@ -8401,6 +8777,7 @@ sub sethost { eq &Apache::lonnet::get_host_ip($hostid)) { $currenthostid =$hostid; $currentdomainid=&Apache::lonnet::host_domain($hostid); + &set_client_info(); # &logthis("Setting hostid to $hostid, and domain to $currentdomainid"); } else { &logthis("Requested host id $hostid not an alias of ". @@ -8477,6 +8854,32 @@ sub get_prohibited { return %prohibited; } +sub get_remote_hostable { + my ($dom) = @_; + my $result; + if ($clientintdom) { + $result = 1; + my $remsessconf = &get_usersession_config($dom,'remotesession'); + if (ref($remsessconf) eq 'HASH') { + if (ref($remsessconf->{'remote'}) eq 'HASH') { + if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') { + if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) { + $result = 0; + } + } + if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') { + if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) { + $result = 1; + } else { + $result = 0; + } + } + } + } + } + return $result; +} + sub distro_and_arch { return $dist.':'.$arch; } @@ -8883,7 +9286,7 @@ is closed and the child exits. =item Red CRITICAL Can't get key file SSL key negotiation is being attempted but the call to -lonssl::KeyFile failed. This usually means that the +lonssl::KeyFile failed. This usually means that the configuration file is not correctly defining or protecting the directories/files lonCertificateDirectory or lonnetPrivateKey 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.