--- loncom/lonnet/perl/lonnet.pm 2006/08/29 01:01:19 1.772 +++ loncom/lonnet/perl/lonnet.pm 2006/09/15 20:49:29 1.781 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.772 2006/08/29 01:01:19 raeburn Exp $ +# $Id: lonnet.pm,v 1.781 2006/09/15 20:49:29 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -293,8 +293,10 @@ sub error { } # ------------------------------------------- Transfer profile into environment - +my $env_loaded; sub transfer_profile_to_env { + if ($env_loaded) { return; } + my ($lonidsdir,$handle)=@_; if (!defined($lonidsdir)) { $lonidsdir = $perlvar{'lonIDsDir'}; @@ -325,6 +327,7 @@ sub transfer_profile_to_env { } } $env{'user.environment'} = "$lonidsdir/$handle.id"; + $env_loaded=1; foreach my $expired_key (keys(%Remove)) { &delenv($expired_key); } @@ -344,6 +347,11 @@ sub appenv { $env{$key}=$newenv{$key}; } } + foreach my $key (keys(%newenv)) { + my $value = &escape($newenv{$key}); + delete($newenv{$key}); + $newenv{&escape($key)}=$value; + } my $lockfh; unless (open($lockfh,"$env{'user.environment'}")) { @@ -369,8 +377,6 @@ sub appenv { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { my ($name,$value)=split(/=/,$oldenv[$i],2); - $name=&unescape($name); - $value=&unescape($value); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -383,7 +389,7 @@ sub appenv { } my $newname; foreach $newname (keys %newenv) { - print $fh &escape($newname).'='.&escape($newenv{$newname})."\n"; + print $fh $newname.'='.$newenv{$newname}."\n"; } close($fh); } @@ -891,6 +897,7 @@ sub save_cache { &purge_remembered(); #&Apache::loncommon::validate_page(); undef(%env); + undef($env_loaded); } my $to_remember=-1; @@ -1176,7 +1183,7 @@ sub ssi_body { } my $output=($filelink=~/^http\:/?&externalssi($filelink): &ssi($filelink,%form)); - $output=~s|//(\s*)?\s||gs; + $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; return $output; @@ -3474,7 +3481,7 @@ sub allowed { if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } # Free bre access to adm and meta resources - if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) + if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) && ($priv eq 'bre')) { return 'F'; @@ -4074,7 +4081,7 @@ sub auto_run { my $response = &reply('autorun:'.$cdom,$homeserver); return $response; } - + sub auto_get_sections { my ($cnum,$cdom,$inst_coursecode) = @_; my $homeserver = &homeserver($cnum,$cdom); @@ -4085,21 +4092,21 @@ sub auto_get_sections { } return @secs; } - + sub auto_new_course { my ($cnum,$cdom,$inst_course_id,$owner) = @_; my $homeserver = &homeserver($cnum,$cdom); my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver)); return $response; } - + sub auto_validate_courseID { my ($cnum,$cdom,$inst_course_id) = @_; my $homeserver = &homeserver($cnum,$cdom); my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver)); return $response; } - + sub auto_create_password { my ($cnum,$cdom,$authparam) = @_; my $homeserver = &homeserver($cnum,$cdom); @@ -4231,6 +4238,14 @@ sub auto_instcode_format { } } +sub auto_validate_class_sec { + my ($cdom,$cnum,$owner,$inst_class) = @_; + my $homeserver = &homeserver($cnum,$cdom); + my $response=&reply('autovalidateclass_sec:'.$inst_class.':'. + &escape($owner).':'.$cdom,$homeserver); + return $response; +} + # ------------------------------------------------------- Course Group routines sub get_coursegroups { @@ -7102,29 +7117,8 @@ BEGIN { # ----------------------------------- Read loncapa.conf and loncapa_apache.conf unless ($readit) { { - # FIXME: Use LONCAPA::Configuration::read_conf here and omit next block - open(my $config,") { - if ($configline=~/\S/ && $configline =~ /^[^\#]*PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } - } - close($config); -} -{ - open(my $config,") { - if ($configline =~ /^[^\#]*PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } - } - close($config); + my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf'); + %perlvar = (%perlvar,%{$configvars}); } # ------------------------------------------------------------ Read domain file