--- loncom/lonnet/perl/lonnet.pm 2022/02/16 00:06:12 1.1482 +++ loncom/lonnet/perl/lonnet.pm 2022/09/13 12:22:15 1.1491 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1482 2022/02/16 00:06:12 raeburn Exp $ +# $Id: lonnet.pm,v 1.1491 2022/09/13 12:22:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1323,7 +1323,7 @@ sub changepass { sub queryauthenticate { my ($uname,$udom)=@_; my $uhome=&homeserver($uname,$udom); - if (!$uhome) { + if ((!$uhome) || ($uhome eq 'no_host')) { &logthis("User $uname at $udom is unknown when looking for authentication mechanism"); return 'no_host'; } @@ -1372,12 +1372,35 @@ sub authenticate { } if ($answer eq 'non_authorized') { &logthis("User $uname at $udom rejected by $uhome"); - return 'no_host'; + return 'no_host'; } &logthis("User $uname at $udom threw error $answer when checking authentication mechanism"); return 'no_host'; } +sub can_switchserver { + my ($udom,$home) = @_; + my ($canswitch,@intdoms); + my $internet_names = &get_internet_names($home); + if (ref($internet_names) eq 'ARRAY') { + @intdoms = @{$internet_names}; + } + my $uint_dom = &internet_dom(&domain($udom,'primary')); + if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) { + $canswitch = 1; + } else { + my $serverhomeID = &get_server_homeID(&hostname($home)); + my $serverhomedom = &host_domain($serverhomeID); + my %defdomdefaults = &get_domain_defaults($serverhomedom); + my %udomdefaults = &get_domain_defaults($udom); + my $remoterev = &get_server_loncaparev('',$home); + $canswitch = &can_host_session($udom,$home,$remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); + } + return $canswitch; +} + sub can_host_session { my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_; my $canhost = 1; @@ -2593,6 +2616,10 @@ sub inst_rulecheck { $response=&unescape(&reply('instselfcreatecheck:'. &escape($udom).':'.&escape($uname). ':'.$rulestr,$homeserver)); + } elsif ($item eq 'unamemap') { + $response=&unescape(&reply('instunamemapcheck:'. + &escape($udom).':'.&escape($uname). + ':'.$rulestr,$homeserver)); } if ($response ne 'refused') { my @pairs=split(/\&/,$response); @@ -2622,6 +2649,9 @@ sub inst_userrules { } elsif ($check eq 'email') { $response=&reply('instemailrules:'.&escape($udom), $homeserver); + } elsif ($check eq 'unamemap') { + $response=&reply('unamemaprules:'.&escape($udom), + $homeserver); } else { $response=&reply('instuserrules:'.&escape($udom), $homeserver); @@ -2680,6 +2710,7 @@ sub get_domain_defaults { $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'}; $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'}; $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'}; + $domdefaults{'unamemap_rule'} = $domconfig{'defaults'}{'unamemap_rule'}; } else { $domdefaults{'lang_def'} = &domain($domain,'lang_def'); $domdefaults{'auth_def'} = &domain($domain,'auth_def'); @@ -4910,6 +4941,7 @@ sub get_scantronformat_file { close($fh); } } + chomp(@lines); } return @lines; } @@ -6840,31 +6872,31 @@ sub course_adhocrole_privs { $full{$priv} = $restrict; } foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) { - next if ($item eq ''); - my ($rule,$rest) = split(/=/,$item); - next unless (($rule eq 'off') || ($rule eq 'on')); - foreach my $priv (split(/:/,$rest)) { - if ($priv ne '') { - if ($rule eq 'off') { - $possremove{$priv} = 1; - } else { - $possadd{$priv} = 1; - } - } - } - } - foreach my $priv (sort(keys(%full))) { - if (exists($currprivs{$priv})) { - unless (exists($possremove{$priv})) { - $storeprivs{$priv} = $currprivs{$priv}; - } - } elsif (exists($possadd{$priv})) { - $storeprivs{$priv} = $full{$priv}; - } - } - $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); - } - return $coursepriv; + next if ($item eq ''); + my ($rule,$rest) = split(/=/,$item); + next unless (($rule eq 'off') || ($rule eq 'on')); + foreach my $priv (split(/:/,$rest)) { + if ($priv ne '') { + if ($rule eq 'off') { + $possremove{$priv} = 1; + } else { + $possadd{$priv} = 1; + } + } + } + } + foreach my $priv (sort(keys(%full))) { + if (exists($currprivs{$priv})) { + unless (exists($possremove{$priv})) { + $storeprivs{$priv} = $currprivs{$priv}; + } + } elsif (exists($possadd{$priv})) { + $storeprivs{$priv} = $full{$priv}; + } + } + $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); + } + return $coursepriv; } sub group_roleprivs { @@ -7925,6 +7957,7 @@ sub usertools_access { blog => 1, webdav => 1, portfolio => 1, + timezone => 1, ); } return if (!defined($tools{$tool})); @@ -8120,6 +8153,7 @@ sub check_can_request { my @options = ('approval','validate','autolimit'); my $optregex = join('|',@options); if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) { + my %willtrust; foreach my $type (@{$types}) { if (&usertools_access($uname,$udom,$type,undef, 'requestcourses')) { @@ -8139,12 +8173,17 @@ sub check_can_request { if (ref($request_domains) eq 'HASH') { my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/); if ($otherdom ne '') { - if (ref($request_domains->{$type}) eq 'ARRAY') { - unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) { + unless (exists($willtrust{$otherdom})) { + $willtrust{$otherdom} = &will_trust('reqcrs',$env{'user.domain'},$otherdom); + } + if ($willtrust{$otherdom}) { + if (ref($request_domains->{$type}) eq 'ARRAY') { + unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) { + push(@{$request_domains->{$type}},$otherdom); + } + } else { push(@{$request_domains->{$type}},$otherdom); } - } else { - push(@{$request_domains->{$type}},$otherdom); } } } @@ -12281,15 +12320,24 @@ sub resdata { sub get_domain_lti { my ($cdom,$context) = @_; - my ($name,%lti); + my ($name,$cachename,%lti); if ($context eq 'consumer') { $name = 'ltitools'; } elsif ($context eq 'provider') { $name = 'lti'; + } elsif ($context eq 'linkprot') { + $name = 'ltisec'; } else { return %lti; } - my ($result,$cached)=&is_cached_new($name,$cdom); + + if ($context eq 'linkprot') { + $cachename = $context; + } else { + $cachename = $name; + } + + my ($result,$cached)=&is_cached_new($cachename,$cdom); if (defined($cached)) { if (ref($result) eq 'HASH') { %lti = %{$result}; @@ -12297,20 +12345,28 @@ sub get_domain_lti { } else { my %domconfig = &get_dom('configuration',[$name],$cdom); if (ref($domconfig{$name}) eq 'HASH') { - %lti = %{$domconfig{$name}}; - my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1); - if (ref($encdomconfig{$name}) eq 'HASH') { - foreach my $id (keys(%lti)) { - if (ref($encdomconfig{$name}{$id}) eq 'HASH') { - foreach my $item ('key','secret') { - $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item}; + if ($context eq 'linkprot') { + if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') { + %lti = %{$domconfig{$name}{'linkprot'}}; + } + } else { + %lti = %{$domconfig{$name}}; + } + if (($context eq 'consumer') && (keys(%lti))) { + my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1); + if (ref($encdomconfig{$name}) eq 'HASH') { + foreach my $id (keys(%lti)) { + if (ref($encdomconfig{$name}{$id}) eq 'HASH') { + foreach my $item ('key','secret') { + $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item}; + } } } } } } my $cachetime = 24*60*60; - &do_cache_new($name,$cdom,\%lti,$cachetime); + &do_cache_new($cachename,$cdom,\%lti,$cachetime); } return %lti; } @@ -13718,17 +13774,10 @@ sub symbread { my %bighash; my $syval=''; if (($env{'request.course.fn'}) && ($thisfn)) { - my $targetfn = $thisfn; - if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { - $targetfn = 'adm/wrapper/'.$thisfn; - } - if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) { - $targetfn=$1; - } unless ($ignoresymbdb) { if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', &GDBM_READER(),0640)) { - $syval=$hash{$targetfn}; + $syval=$hash{$thisfn}; untie(%hash); } if ($syval && $checkforblock) {