--- loncom/lonnet/perl/lonnet.pm 2023/09/04 18:59:17 1.1172.2.146.2.14 +++ loncom/lonnet/perl/lonnet.pm 2024/02/25 05:55:09 1.1172.2.146.2.17 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.146.2.14 2023/09/04 18:59:17 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.146.2.17 2024/02/25 05:55:09 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2696,6 +2696,17 @@ sub get_domain_defaults { $domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'}; } } + if (ref($domconfig{'ltisec'}{'suggested'}) eq 'HASH') { + my %suggestions = %{$domconfig{'ltisec'}{'suggested'}}; + foreach my $item (keys(%{$domconfig{'ltisec'}{'suggested'}})) { + unless (ref($domconfig{'ltisec'}{'suggested'}{$item}) eq 'HASH') { + delete($suggestions{$item}); + } + } + if (keys(%suggestions)) { + $domdefaults{'linkprotsuggested'} = \%suggestions; + } + } } if (ref($domconfig{'toolsec'}) eq 'HASH') { if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') { @@ -5178,6 +5189,36 @@ sub courserolelog { $storehash{'group'} = $sec; } else { $storehash{'section'} = $sec; + my ($curruserdomstr,$newuserdomstr); + if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) { + $curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'}; + } else { + my %courseinfo = &coursedescription($cdom.'/'.$cnum); + $curruserdomstr = $courseinfo{'internal.userdomains'}; + } + if ($curruserdomstr ne '') { + my @udoms = split(/,/,$curruserdomstr); + unless (grep(/^\Q$domain\E/,@udoms)) { + push(@udoms,$domain); + $newuserdomstr = join(',',sort(@udoms)); + } + } else { + $newuserdomstr = $domain; + } + if ($newuserdomstr ne '') { + my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr }, + $cdom,$cnum); + if ($putresult eq 'ok') { + unless (($selfenroll) || ($context eq 'selfenroll')) { + if (($context eq 'createcourse') || ($context eq 'requestcourses') || + ($context eq 'automated') || ($context eq 'domain')) { + $env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr; + } elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) { + &appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr}); + } + } + } + } } &write_log('course',$namespace,\%storehash,$delflag,$username, $domain,$cnum,$cdom); @@ -12095,6 +12136,73 @@ sub domainlti_itemid { return $itemid; } +sub get_ltitools_id { + my ($context,$cdom,$cnum,$title) = @_; + my ($lockhash,$tries,$gotlock,$id,$error); + + # get lock on ltitools db + $lockhash = { + lock => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + $tries = 0; + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + while (($gotlock ne 'ok') && ($tries<10)) { + $tries ++; + sleep (0.1); + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + } + if ($gotlock eq 'ok') { + my %currids; + if ($context eq 'domain') { + %currids = &dump_dom('ltitools',$cdom); + } else { + %currids = &dump('ltitools',$cdom,$cnum); + } + if ($currids{'lock'}) { + delete($currids{'lock'}); + if (keys(%currids)) { + my @curr = sort { $a <=> $b } keys(%currids); + if ($curr[-1] =~ /^\d+$/) { + $id = 1 + $curr[-1]; + } + } else { + $id = 1; + } + if ($id) { + if ($context eq 'domain') { + unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') { + $error = 'nostore'; + } + } else { + unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') { + $error = 'nostore'; + } + } + } else { + $error = 'nonumber'; + } + } + my $dellockoutcome; + if ($context eq 'domain') { + $dellockoutcome = &del_dom('ltitools',['lock'],$cdom); + } else { + $dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum); + } + } else { + $error = 'nolock'; + } + return ($id,$error); +} + sub count_supptools { my ($cnum,$cdom,$ignorecache,$reload)=@_; my $hashid=$cnum.':'.$cdom;