--- loncom/lond 2017/06/06 20:03:24 1.540 +++ loncom/lond 2020/03/30 11:04:03 1.561 @@ -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.561 2020/03/30 11:04:03 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.561 $'; #' 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") @@ -214,12 +220,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 +239,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 +304,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 +429,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 +797,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 +831,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 +858,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 +870,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 +1914,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 +1931,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 +2032,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 +2128,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 +2350,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 +2444,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 +2455,6 @@ sub change_password_handler { # &Failure( $client, "auth_mode_error\n", $userinput); } - } else { if ($failure eq '') { $failure = 'non_authorized'; @@ -2607,8 +2736,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 { @@ -2902,6 +3035,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 @@ -4693,6 +4874,45 @@ 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_user)_\d+_($LONCAPA::match_domain)_/) { + my ($uname,$udom) = ($1,$2); + next unless (-e "$perlvar{'lonDaemons'}/$uname$dbsuffix"); + my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9]; + my $since=$now-$mtime; + if ($lastactivity < 0) { + next if ($since <= $lastactivity); + } else { + next if ($since > $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 # @@ -5464,6 +5684,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 +6014,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 +6042,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 +7125,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 +7260,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 +7542,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'); } @@ -7308,7 +7631,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; } @@ -7353,7 +7676,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 +7777,6 @@ sub make_new_child { } } else { - $clientinfoset = &set_client_info(); my $ok = InsecureConnection($client); if($ok) { $clientok = 1; @@ -7492,34 +7814,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 +7847,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 +7882,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 +7902,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 +8624,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 +8656,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 +8733,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 +9165,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