--- loncom/lonnet/perl/lonnet.pm 2018/03/28 10:22:10 1.1172.2.93.4.8 +++ loncom/lonnet/perl/lonnet.pm 2018/05/02 20:33:18 1.1172.2.93.4.11 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.93.4.8 2018/03/28 10:22:10 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.93.4.11 2018/05/02 20:33:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -695,16 +695,19 @@ sub appenv { $env{$key}=$newenv->{$key}; } } - my $opened = open(my $env_file,'+<',$env{'user.environment'}); - if ($opened - && &timed_flock($env_file,LOCK_EX) - && - tie(my %disk_env,'GDBM_File',$env{'user.environment'}, - (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { - while (my ($key,$value) = each(%{$newenv})) { - $disk_env{$key} = $value; - } - untie(%disk_env); + my $lonids = $perlvar{'lonIDsDir'}; + if ($env{'user.environment'} =~ m{^\Q$lonids/\E$match_username\_\d+\_$match_domain\_[\w\-.]+\.id$}) { + my $opened = open(my $env_file,'+<',$env{'user.environment'}); + if ($opened + && &timed_flock($env_file,LOCK_EX) + && + tie(my %disk_env,'GDBM_File',$env{'user.environment'}, + (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { + while (my ($key,$value) = each(%{$newenv})) { + $disk_env{$key} = $value; + } + untie(%disk_env); + } } } return 'ok'; @@ -8612,6 +8615,33 @@ sub auto_validate_class_sec { return $response; } +sub auto_validate_instclasses { + my ($cdom,$cnum,$owners,$classesref) = @_; + my ($homeserver,%validations); + $homeserver = &homeserver($cnum,$cdom); + unless ($homeserver eq 'no_host') { + my $ownerlist; + if (ref($owners) eq 'ARRAY') { + $ownerlist = join(',',@{$owners}); + } else { + $ownerlist = $owners; + } + if (ref($classesref) eq 'HASH') { + my $classes = &freeze_escape($classesref); + my $response=&reply('autovalidateinstclasses:'.&escape($ownerlist). + ':'.$cdom.':'.$classes,$homeserver); + unless ($response =~ /(con_lost|error|no_such_host|refused)/) { + my @items = split(/&/,$response); + foreach my $item (@items) { + my ($key,$value) = split('=',$item); + $validations{&unescape($key)} = &thaw_unescape($value); + } + } + } + } + return %validations; +} + sub auto_crsreq_update { my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title, $code,$accessstart,$accessend,$inbound) = @_; @@ -11190,6 +11220,7 @@ sub metadata { # Check metadata for imported file to # see if it contained response items # + my %currmetaentry = %metaentry; my $libresponseorder = &metadata($location,'responseorder'); my $origfile; if ($libresponseorder ne '') { @@ -11209,6 +11240,10 @@ sub metadata { } } } +# Do not overwrite contents of %metaentry hash for resource itself with +# hash populated for imported library file + %metaentry = %currmetaentry; + undef(%currmetaentry); if ($importmode eq 'problem') { # Import as problem/response $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'}); @@ -11218,7 +11253,7 @@ sub metadata { # We need to get the original file and the imported file to get the part order correct # Good news: we do not need to worry about nested libraries, since parts cannot be nested # Load and inspect original file if we didn't do that already - if ($#origfileimportpartids<0) { + if ($#origfiletagids<0) { undef(%importedrespids); undef(%importedpartids); if ($origfile eq '') {