--- loncom/lonnet/perl/lonnet.pm 2021/01/05 04:23:46 1.1437 +++ loncom/lonnet/perl/lonnet.pm 2021/04/09 00:57:31 1.1445 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1437 2021/01/05 04:23:46 raeburn Exp $ +# $Id: lonnet.pm,v 1.1445 2021/04/09 00:57:31 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1445,6 +1445,15 @@ sub spare_can_host { $canhost = 0; } } + if ($canhost) { + if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') { + if ($defdomdefaults{'offloadoth'}{$try_server}) { + unless (&shared_institution($udom,$try_server)) { + $canhost = 0; + } + } + } + } if (($canhost) && ($uint_dom)) { my @intdoms; my $internet_names = &get_internet_names($try_server); @@ -2155,10 +2164,19 @@ sub get_dom { } if ($udom && $uhome && ($uhome ne 'no_host')) { my $rep; - if ($namespace =~ /^enc/) { - $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); + if (grep { $_ eq $uhome } ¤t_machine_ids()) { + # domain information is hosted on this machine + my $cmd = 'getdom'; + if ($namespace =~ /^enc/) { + $cmd = 'egetdom'; + } + $rep = &LONCAPA::Lond::get_dom("$cmd:$udom:$namespace:$items"); } else { - $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + if ($namespace =~ /^enc/) { + $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); + } else { + $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + } } my %returnhash; if ($rep eq '' || $rep =~ /^error: 2 /) { @@ -2689,6 +2707,9 @@ sub get_domain_defaults { if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') { $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'}; } + if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') { + $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'}; + } } if (ref($domconfig{'selfenrollment'}) eq 'HASH') { if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') { @@ -4053,6 +4074,10 @@ sub clean_filename { # Replace all .\d. sequences with _\d. so they no longer look like version # numbers $fname=~s/\.(\d+)(?=\.)/_$1/g; +# Replace three or more adjacent underscores with one for consistency +# with loncfile::filename_check() so complete url can be extracted by +# lonnet::decode_symb() + $fname=~s/_{3,}/_/g; return $fname; } @@ -9402,6 +9427,25 @@ sub auto_validate_instcode { return ($outcome,$description,$defaultcredits); } +sub auto_validate_inst_crosslist { + my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_; + my ($homeserver,$response); + if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { + $homeserver = &homeserver($cnum,$cdom); + } + if (!defined($homeserver)) { + if ($cdom =~ /^$match_domain$/) { + $homeserver = &domain($cdom,'primary'); + } + } + unless (($homeserver eq '') || ($homeserver eq 'no_host')) { + $response=&reply('autovalidateinstcrosslist:'.$cdom.':'. + &escape($instcode).':'.&escape($inst_xlist).':'. + &escape($coowner),$homeserver); + } + return $response; +} + sub auto_create_password { my ($cnum,$cdom,$authparam,$udom) = @_; my ($homeserver,$response); @@ -10223,11 +10267,24 @@ sub autoupdate_coowners { if ($domdesign{$cdom.'.autoassign.co-owners'}) { my %coursehash = &coursedescription($cdom.'_'.$cnum); my $instcode = $coursehash{'internal.coursecode'}; + my $xlists = $coursehash{'internal.crosslistings'}; if ($instcode ne '') { if (($start && $start <= $now) && ($end == 0) || ($end > $now)) { unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) { my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners); my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom); + unless ($result eq 'valid') { + if ($xlists ne '') { + foreach my $xlist (split(',',$xlists)) { + my ($inst_crosslist,$lcsec) = split(':',$xlist); + $result = + &Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$instcode, + $inst_crosslist,$uname.':'.$udom); + last if ($result eq 'valid'); + } + } + } + } if ($result eq 'valid') { if ($coursehash{'internal.co-owners'}) { foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { @@ -10240,18 +10297,16 @@ sub autoupdate_coowners { } else { push(@newcoowners,$uname.':'.$udom); } - } else { - if ($coursehash{'internal.co-owners'}) { - foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { - unless ($coowner eq $uname.':'.$udom) { - push(@newcoowners,$coowner); - } - } - unless (@newcoowners > 0) { - $delcoowners = 1; - $coowners = ''; + } elsif ($coursehash{'internal.co-owners'}) { + foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { + unless ($coowner eq $uname.':'.$udom) { + push(@newcoowners,$coowner); } } + unless (@newcoowners > 0) { + $delcoowners = 1; + $coowners = ''; + } } if (@newcoowners || $delcoowners) { &store_coowners($cdom,$cnum,$coursehash{'home'}, @@ -12407,7 +12462,7 @@ sub EXT { } } elsif ($realm eq 'client') { if ($space eq 'remote_addr') { - return $ENV{'REMOTE_ADDR'}; + return &get_requestor_ip(); } } return ''; @@ -14217,9 +14272,12 @@ sub default_login_domain { } sub shared_institution { - my ($dom) = @_; + my ($dom,$lonhost) = @_; + if ($lonhost eq '') { + $lonhost = $perlvar{'lonHostID'}; + } my $same_intdom; - my $hostintdom = &internet_dom($perlvar{'lonHostID'}); + my $hostintdom = &internet_dom($lonhost); if ($hostintdom ne '') { my %iphost = &get_iphost(); my $primary_id = &domain($dom,'primary'); @@ -14332,7 +14390,7 @@ sub get_proxy_settings { ipheader => $domdefaults{'waf_ipheader'}, trusted => $domdefaults{'waf_trusted'}, vpnint => $domdefaults{'waf_vpnint'}, - vpnext => $domdefaults{'waf_vpnext'}; + vpnext => $domdefaults{'waf_vpnext'}, }; return $proxyinfo; }