--- loncom/lond 2017/06/06 20:03:24 1.540 +++ loncom/lond 2019/04/26 20:22:10 1.558 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.540 2017/06/06 20:03:24 raeburn Exp $ +# $Id: lond,v 1.558 2019/04/26 20:22:10 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.540 $'; #' stupid emacs +my $VERSION='$Revision: 1.558 $'; #' 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") @@ -220,6 +226,7 @@ my %trust = ( dcmaildump => {remote => 1, domroles => 1}, dcmailput => {remote => 1, domroles => 1}, del => {remote => 1, domroles => 1, enroll => 1, content => 1}, + delbalcookie => {institutiononly => 1}, deldom => {remote => 1, domroles => 1}, # not currently used devalidatecache => {institutiononly => 1}, domroleput => {remote => 1, enroll => 1}, @@ -230,7 +237,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,9 +302,9 @@ 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}, @@ -420,10 +427,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 +795,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 +829,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 +856,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 +868,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 +1912,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 +1929,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); @@ -2070,8 +2126,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 +2348,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"; @@ -2325,7 +2453,6 @@ sub change_password_handler { # &Failure( $client, "auth_mode_error\n", $userinput); } - } else { if ($failure eq '') { $failure = 'non_authorized'; @@ -2607,8 +2734,12 @@ sub update_resource_handler { my $request=new HTTP::Request('GET',"$remoteurl"); $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1); if ($response->is_error()) { -# FIXME: we should probably clean up here instead of just whine - unlink($transname); + my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname"); + &devalidate_meta_cache($fname); + if (-e $transname) { + unlink($transname); + } + unlink($fname); my $message=$response->status_line; &logthis("LWP GET: $message for $fname ($remoteurl)"); } else { @@ -5464,6 +5595,58 @@ sub tmp_del_handler { ®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0); # +# Process the delbalcookie command. This command deletes a balancer +# cookie in the lonBalancedir directory created by switchserver +# +# 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); + 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 @@ -5742,9 +5925,10 @@ sub validate_course_section_handler { # 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 words that will be split into: +# set of values that will be split into: # $inst_class - Institutional code for the specific class section -# $courseowner - The escaped username:domain of the course owner +# $ownerlist - An escaped comma-separated list of username:domain +# of the course owner, and co-owner(s). # $cdom - The domain of the course from the institution's # point of view. # $client - The socket open on the client. @@ -5769,6 +5953,56 @@ sub validate_class_access_handler { ®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); # +# Validate course owner or co-owners(s) access to enrollment data for all sections +# and crosslistings for a particular 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 +# set of values that will be split into: +# $ownerlist - An escaped comma-separated list of username:domain +# of the course owner, and co-owner(s). +# $cdom - The domain of the course from the institution's +# point of view. +# $classes - Frozen hash of institutional course sections and +# crosslistings. +# $client - The socket open on the client. +# Returns: +# 1 - continue processing. +# + +sub validate_classes_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($ownerlist,$cdom,$classes) = split(/:/, $tail); + my $classesref = &Apache::lonnet::thaw_unescape($classes); + my $owners = &unescape($ownerlist); + my $result; + eval { + local($SIG{__DIE__})='DEFAULT'; + my %validations; + my $response = &localenroll::check_instclasses($owners,$cdom,$classesref, + \%validations); + if ($response eq 'ok') { + foreach my $key (keys(%validations)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&'; + } + $result =~ s/\&$//; + } else { + $result = 'error'; + } + }; + if (!$@) { + &Reply($client, \$result, $userinput); + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } + return 1; +} +®ister_handler("autovalidateinstclasses", \&validate_classes_handler, 0, 1, 0); + +# # Create a password for a new LON-CAPA user added by auto-enrollment. # Only used for case where authentication method for new user is localauth # @@ -6802,8 +7036,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; } @@ -6937,10 +7171,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') { @@ -7219,7 +7453,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'); } @@ -7353,7 +7587,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"); @@ -7454,7 +7688,6 @@ sub make_new_child { } } else { - $clientinfoset = &set_client_info(); my $ok = InsecureConnection($client); if($ok) { $clientok = 1; @@ -7492,34 +7725,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"); @@ -7552,22 +7758,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. # @@ -7579,7 +7793,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); @@ -7599,6 +7813,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; } } @@ -8314,6 +8535,14 @@ sub make_passwd_file { $result = "pass_file_failed_error"; } } + } elsif ($umode eq 'lti') { + my $pf = IO::File->new(">$passfilename"); + if($pf) { + print $pf "lti:\n"; + &update_passwd_history($uname,$udom,$umode,$action); + } else { + $result = "pass_file_failed_error"; + } } else { $result="auth_mode_error"; } @@ -8338,6 +8567,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 ". @@ -8414,6 +8644,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; } @@ -8820,7 +9076,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