--- loncom/xml/lonxml.pm 2004/06/03 14:28:39 1.320 +++ loncom/xml/lonxml.pm 2005/03/16 15:46:42 1.364 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.320 2004/06/03 14:28:39 www Exp $ +# $Id: lonxml.pm,v 1.364 2005/03/16 15:46:42 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -51,7 +51,7 @@ use Math::Cephes(); use Math::Random(); use Opcode(); use POSIX qw(strftime); - +use Time::HiRes qw( gettimeofday tv_interval ); sub register { my ($space,@taglist) = @_; @@ -149,28 +149,49 @@ $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; sub xmlbegin { - my $output=''; - if ($ENV{'browser.mathml'}) { - $output='' - .'' - .']>' + my ($style)=@_; + my $output=''; + @htmlareafields=(); + if ($ENV{'browser.mathml'}) { + $output='' + #.''."\n" +# .'] >' + .'' .''; - } else { - $output=''; - } - return $output; + .'xmlns="http://www.w3.org/1999/xhtml">'; + } else { + $output=''; + } + if ($style eq 'encode') { + $output=&HTML::Entities::encode($output,'<>&"'); + } + return $output; } sub xmlend { + my ($target,$parser)=@_; my $mode='xml'; my $status='OPEN'; if ($Apache::lonhomework::parsing_a_problem) { $mode='problem'; $status=$Apache::inputtags::status[-1]; } - return &Apache::lonfeedback::list_discussion($mode,$status).''; + my $discussion; + &Apache::loncommon::get_unprocessed_cgi + ($ENV{'query_string'},['LONCAPA_INTERNAL_no_discussion']); + if (! exists($ENV{'form.LONCAPA_INTERNAL_no_discussion'}) || + $ENV{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') { + $discussion=&Apache::lonfeedback::list_discussion($mode,$status); + } + if ($target eq 'tex') { + $discussion.='\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}'; + &Apache::lonxml::newparser($parser,\$discussion,''); + return ''; + } else { + return $discussion.&Apache::loncommon::endbodytag(); + } } sub tokeninputfield { @@ -274,11 +295,11 @@ sub printtokenheader { } } -sub fontsettings() { +sub fontsettings { my $headerstring=''; if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { $headerstring.= - ''; + ''; } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) { $headerstring.= ''; @@ -311,13 +332,15 @@ sub xmlparse { my $bodytext= $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'}; if ($bodytext) { - my $location=&Apache::lonnet::filelocation('',$bodytext); - my $styletext=&Apache::lonnet::getfile($location); - if ($styletext ne '-1') { - %style_for_target = (%style_for_target, - &Apache::style::styleparser($target,$styletext)); - } - } + foreach my $file (split(',',$bodytext)) { + my $location=&Apache::lonnet::filelocation('',$file); + my $styletext=&Apache::lonnet::getfile($location); + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); + } + } + } } elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) { my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'}); my $styletext=&Apache::lonnet::getfile($location); @@ -341,8 +364,8 @@ sub xmlparse { my @stack = (); my @parstack = (); - &initdepth; - + &initdepth(); + &init_alarm(); my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, $safeeval,\%style_for_target); @@ -351,28 +374,37 @@ sub xmlparse { } &do_registered_ssi(); if ($Apache::lonxml::counter_changed) { &store_counter() } + if ($ENV{'form.return_only_error_and_warning_counts'}) { + return "$errorcount:$warningcount"; + } return $finaloutput; } sub htmlclean { my ($raw,$full)=@_; +# Take care of CRLF etc - my $tree = HTML::TreeBuilder->new; - $tree->ignore_unknown(0); - - $tree->parse($raw); - - my $output= $tree->as_HTML(undef,' '); - - $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis; - $output=~s/\<\/(br|hr|img|meta|allow)\>//gis; + $raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs; + $raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs; + $raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs; + $raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs; + +# Generate empty tags, remove wrong end tags + $raw=~s/\<(br|hr|img|meta|allow|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis; + $raw=~s/\<\/(br|hr|img|meta|allow|basefont)\>//gis; unless ($full) { - $output=~s/\<[\/]*(body|head|html)\>//gis; + $raw=~s/\<[\/]*(body|head|html)\>//gis; } - - $tree = $tree->delete; - - return $output; +# Make standard tags lowercase + foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m', + 'table','tr','td','th','p','br','hr','img','embed','font', + 'a','strong','center','title','basefont','li','ol','ul', + 'input','select','form','option','script','pre') { + $raw=~s/\<$_\s*\>/\<$_\>/gis; + $raw=~s/\<\/$_\s*\>/<\/$_\>/gis; + $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis; + } + return $raw; } sub latex_special_symbols { @@ -388,8 +420,10 @@ sub latex_special_symbols { } else { $string=~s/\\/\\ensuremath{\\backslash}/g; $string=~s/([^\\]|^)\%/$1\\\%/g; - $string=~s/([^\\]|^)(\$|_)/$1\\$2/g; + $string=~s/([^\\]|^)\$/$1\\\$/g; + $string=~s/([^\\])\_/$1\\_/g; $string=~s/\$\$/\$\\\$/g; + $string=~s/\_\_/\_\\\_/g; $string=~s/\#\#/\#\\\#/g; $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g; $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less @@ -397,6 +431,7 @@ sub latex_special_symbols { # any & or # leftover should be safe to just escape $string=~s/([^\\]|^)\&/$1\\\&/g; $string=~s/([^\\]|^)\#/$1\\\#/g; + $string=~s/\|/\$\\mid\$/g; #single { or } How to escape? } return $string; @@ -604,6 +639,7 @@ sub setup_globals { my ($request,$target)=@_; $Apache::lonxml::request=$request; $Apache::lonxml::registered = 0; + @Apache::lonxml::htmlareafields=(); $errorcount=0; $warningcount=0; $Apache::lonxml::default_homework_loaded=0; @@ -662,7 +698,9 @@ sub init_safespace { $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse'); $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart'); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); - + $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval, + '&chem_standard_order'); + $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); @@ -736,9 +774,11 @@ sub init_safespace { $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); + $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange'); #need to inspect this class of ops # $safeeval->deny(":base_orig"); + $safeeval->permit("require"); $safeinit .= ';$external::target="'.$target.'";'; my $rndseed; my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); @@ -747,27 +787,6 @@ sub init_safespace { &Apache::lonxml::debug("Setting rndseed to $rndseed"); &Apache::run::run($safeinit,$safeeval); - my $subroutine=<<'EVALUATESUB'; -sub __LC_INTERNAL_EVALUATE__ { - my ($__LC__a,$__LC__b,$__LC__c)=@_; - my $__LC__prefix; - while(1){ - { - use strict; - no strict "vars"; - if (eval(defined(eval($__LC__a.$__LC__b)))) { - return $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c); - } - } - $__LC__prefix.=substr($__LC__a,0,1,""); - if ($__LC__a!~/^(\$|&|\#)/) { last; } - } - return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c; -} -EVALUATESUB - $safeeval->permit("require"); - $safeeval->reval($subroutine); - $safeeval->deny("require"); } sub default_homework_load { @@ -782,18 +801,48 @@ sub default_homework_load { } } +{ + my $alarm_depth; + sub init_alarm { + alarm(0); + $alarm_depth=0; + } + + sub start_alarm { + if ($alarm_depth<1) { + my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); + if ($old) { + &Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur."); + } + } + $alarm_depth++; + } + + sub end_alarm { + $alarm_depth--; + if ($alarm_depth<1) { alarm(0); } + } +} +my $metamode_was; sub startredirection { - $Apache::lonxml::redirection++; - push (@Apache::lonxml::outputstack, ''); + if (!$Apache::lonxml::redirection) { + $metamode_was=$Apache::lonxml::metamode; + } + $Apache::lonxml::metamode=0; + $Apache::lonxml::redirection++; + push (@Apache::lonxml::outputstack, ''); } sub endredirection { - if (!$Apache::lonxml::redirection) { - &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller); - return ''; - } - $Apache::lonxml::redirection--; - pop @Apache::lonxml::outputstack; + if (!$Apache::lonxml::redirection) { + &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller); + return ''; + } + $Apache::lonxml::redirection--; + if (!$Apache::lonxml::redirection) { + $Apache::lonxml::metamode=$metamode_was; + } + pop @Apache::lonxml::outputstack; } sub end_tag { @@ -809,6 +858,8 @@ sub initdepth { $Apache::lonxml::olddepth=-1; } +my @timers; +my $lasttime; sub increasedepth { my ($token) = @_; $Apache::lonxml::depth++; @@ -816,8 +867,15 @@ sub increasedepth { if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { $Apache::lonxml::olddepth=$Apache::lonxml::depth; } + my $time; + if ($Apache::lonxml::debug eq "1") { + push(@timers,[&gettimeofday()]); + $time=&tv_interval($lasttime); + $lasttime=[&gettimeofday()]; + } + my $spacing=' 'x($Apache::lonxml::depth-1); my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"); + &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n"); #print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; } @@ -832,37 +890,44 @@ sub decreasedepth { &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); $Apache::lonxml::depth='-1'; } + my ($timer,$time); + if ($Apache::lonxml::debug eq "1") { + $timer=pop(@timers); + $time=&tv_interval($lasttime); + $lasttime=[&gettimeofday()]; + } + my $spacing=' 'x$Apache::lonxml::depth; my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"); + &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n"); #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } sub get_all_text_unbalanced { #there is a copy of this in lonpublisher.pm - my($tag,$pars)= @_; - my $token; - my $result=''; - $tag='<'.$tag.'>'; - while ($token = $$pars[-1]->get_token) { - if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { - $result.=$token->[1]; - } elsif ($token->[0] eq 'PI') { - $result.=$token->[2]; - } elsif ($token->[0] eq 'S') { - $result.=$token->[4]; - } elsif ($token->[0] eq 'E') { - $result.=$token->[2]; - } - if ($result =~ /(.*)\Q$tag\E(.*)/is) { - &Apache::lonxml::debug('Got a winner with leftovers ::'.$2); - &Apache::lonxml::debug('Result is :'.$1); - $result=$1; - my $redo=$tag.$2; - &Apache::lonxml::newparser($pars,\$redo); - last; - } - } - return $result + my($tag,$pars)= @_; + my $token; + my $result=''; + $tag='<'.$tag.'>'; + while ($token = $$pars[-1]->get_token) { + if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { + $result.=$token->[1]; + } elsif ($token->[0] eq 'PI') { + $result.=$token->[2]; + } elsif ($token->[0] eq 'S') { + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; + } + if ($result =~ /\Q$tag\E/is) { + ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is; + #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2); + #&Apache::lonxml::debug('Result is :'.$1); + $redo=$tag.$redo; + &Apache::lonxml::newparser($pars,\$redo); + last; + } + } + return $result } sub increment_counter { @@ -1006,6 +1071,8 @@ sub parstring { unless ($_=~/\W/) { my $val=$token->[2]->{$_}; $val =~ s/([\%\@\\\"\'])/\\$1/g; + $val =~ s/(\$[^{a-zA-Z_])/\\$1/g; + $val =~ s/(\$)$/\\$1/; #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } $temp .= "my \$$_=\"$val\";"; } @@ -1094,21 +1161,20 @@ sub storefile { } sub createnewhtml { - my $filecontents=(< - - Title of Document Goes Here - +$title - - Body of Document Goes Here - +$body SIMPLECONTENT - return $filecontents; + return $filecontents; } sub createnewsty { @@ -1129,8 +1195,37 @@ sub inserteditinfo { $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); # my $editheader='Edit below
'; my $xml_help = ''; + my $initialize=''; if ($filetype eq 'html') { - $xml_help=Apache::loncommon::helpLatexCheatsheet(); + my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons(); + $initialize=&Apache::lonhtmlcommon::htmlareaheaders(). + &Apache::lonhtmlcommon::spellheader(); + if (!&Apache::lonhtmlcommon::htmlareablocked() && + &Apache::lonhtmlcommon::htmlareabrowser()) { + $initialize.=(< +$addbuttons + + HTMLArea.loadPlugin("FullPage"); + + function initDocument() { + var editor=new HTMLArea("filecont",config); + editor.registerPlugin(FullPage); + editor.generate(); + } + +FULLPAGE + } else { + $initialize.=(< +$addbuttons + function initDocument() { + } + +FULLPAGE + } + $result=~s/\]*)\>/\/i; + $xml_help=&Apache::loncommon::helpLatexCheatsheet(); } my $cleanbut = ''; if ($filetype eq 'html') { @@ -1146,18 +1241,22 @@ $cleanbut BUTTONS + $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont'); + $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont'); my $editfooter=(< -
+ $xml_help $buttons
- +
$buttons
$titledisplay + ENDFOOTER # $result=~s/(\]*\>)/$1$editheader/is; $result=~s/(\<\/body\>)/$editfooter/is; @@ -1198,12 +1297,12 @@ sub handler { $Apache::lonxml::debug=$ENV{'user.debug'}; - if ($ENV{'browser.mathml'}) { - &Apache::loncommon::content_type($request,'text/xml'); - } else { - &Apache::loncommon::content_type($request,'text/html'); - } + &Apache::loncommon::content_type($request,'text/html'); &Apache::loncommon::no_cache($request); + if ($ENV{'request.state'} eq 'published') { + $request->set_last_modified(&Apache::lonnet::metadata($request->uri, + 'lastrevisiondate')); + } $request->send_http_header; return OK if $request->header_only; @@ -1245,7 +1344,7 @@ $bodytag ENDNOTFOUND - $filecontents=''; + $filecontents=''; if ($ENV{'request.state'} ne 'published') { if ($filetype eq 'sty') { $filecontents=&createnewsty(); @@ -1256,6 +1355,10 @@ ENDNOTFOUND } } else { unless ($ENV{'request.state'} eq 'published') { + if ($filecontents=~/BEGIN LON-CAPA Internal/) { + &Apache::lonxml::error(&mt('This file appears to be a rendering of a Lon-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.')); + } + if ($ENV{'form.attemptclean'}) { $filecontents=&htmlclean($filecontents,1); } @@ -1277,7 +1380,11 @@ ENDNOTFOUND if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { my $displayfile=$request->uri; $displayfile=~s/^\/[^\/]*//; - $result=''. + my $bodytag=''; + if ($ENV{'environment.remote'} eq 'off') { + $bodytag=&Apache::loncommon::bodytag(); + } + $result=''.$bodytag. &Apache::lonxml::message_location().'

'. $displayfile. '

'; @@ -1312,42 +1419,65 @@ sub debug { my $request=$Apache::lonxml::request; if (!$request) { $request=Apache->request; } $request->print('
DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."
\n"); + #&Apache::lonnet::logthis($_[0]); + } +} + +sub show_error_warn_msg { + if ($ENV{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' && + &Apache::lonnet::allowed('mdc',$ENV{'request.course.id'})) { + return 1; } + return (($Apache::lonxml::debug eq 1) || + ($ENV{'request.state'} eq 'construct') || + ($Apache::lonhomework::browse eq 'F' + && + $ENV{'form.show_errors'} eq 'on')); } sub error { - $errorcount++; - my $request=$Apache::lonxml::request; - if (!$request) { $request=Apache->request; } - if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { - # If printing in construction space, put the error inside 

-      push(@Apache::lonxml::error_messages,
-	   $Apache::lonxml::warnings_error_header.
-	   "ERROR:".join("
\n",@_)."
\n");
-      $Apache::lonxml::warnings_error_header='';
-  } else {
-      push(@Apache::lonxml::error_messages,
-	   "An Error occured while processing this resource. The instructor has been notified. 
");
-    #notify author
-    &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_));
-    #notify course
-    if ( $ENV{'request.course.id'} ) {
-      my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
-      my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
-      foreach (keys %users) {
-	my ($user,$domain) = split(/:/, $_);
-	&Apache::lonmsg::user_normal_msg($user,$domain,
-        "Error [$declutter]",join('
',@_));
-      }
+    $errorcount++;
+    if ( &show_error_warn_msg() ) {
+	# If printing in construction space, put the error inside 

+	push(@Apache::lonxml::error_messages,
+	     $Apache::lonxml::warnings_error_header.
+	     "ERROR:".join("
\n",@_)."
\n");
+	$Apache::lonxml::warnings_error_header='';
+    } else {
+	my $errormsg;
+	my ($symb)=&Apache::lonnet::symbread();
+	if ( !$symb ) {
+	    #public or browsers
+	    $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
+	} 
+	#notify author
+	&Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_));
+	#notify course
+	if ( $symb && $ENV{'request.course.id'} ) {
+	    my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
+	    my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
+	    my @userlist;
+	    foreach (keys %users) {
+		my ($user,$domain) = split(/:/, $_);
+		push(@userlist,"$user\@$domain");
+		&Apache::lonmsg::user_normal_msg($user,$domain,
+						 "Error [$declutter]",join('
',@_));
+	    }
+	    if ($ENV{'request.role.adv'}) {
+		$errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
+	    } else {
+		$errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
+	    }
+	}
+	push(@Apache::lonxml::error_messages,"$errormsg 
");
     }
-  }
 }
 
 sub warning {
     $warningcount++;
   
     if ($ENV{'form.grade_target'} ne 'tex') {
-	if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
+	if ( &show_error_warn_msg() ) {
 	    my $request=$Apache::lonxml::request;
 	    if (!$request) { $request=Apache->request; }
 	    push(@Apache::lonxml::warning_messages,
@@ -1424,7 +1554,7 @@ sub get_param_var {
   } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }
   my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
   &Apache::lonxml::debug("first run is $value");
-  if ($value =~ /^[\$\@\%]\w+$/) {
+  if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
       &Apache::lonxml::debug("doing second");
       my @result=&Apache::run::run("return $value",$safeeval,1);
       if (!defined($result[0])) {
@@ -1512,29 +1642,36 @@ sub whichuser {
   my ($passedsymb)=@_;
   my ($symb,$courseid,$domain,$name,$publicuser);
   if (defined($ENV{'form.grade_symb'})) {
-    my $tmp_courseid=$ENV{'form.grade_courseid'};
-    my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
-    if ($allowed) {
-      $symb=$ENV{'form.grade_symb'};
-      $courseid=$ENV{'form.grade_courseid'};
-      $domain=$ENV{'form.grade_domain'};
-      $name=$ENV{'form.grade_username'};
-    }
-  } else {
-      if (!$passedsymb) {
-          $symb=&Apache::lonnet::symbread();
-      } else {
-          $symb=$passedsymb;
+      my ($tmp_courseid)=
+	  &Apache::loncommon::get_env_multiple('form.grade_courseid');
+      my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
+      if (!$allowed && 
+	  exists($ENV{'request.course.sec'}) && 
+	  $ENV{'request.course.sec'} !~ /^\s*$/) {
+	  $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.
+					    '/'.$ENV{'request.course.sec'});
       }
-      $courseid=$ENV{'request.course.id'};
-      $domain=$ENV{'user.domain'};
-      $name=$ENV{'user.name'};
-      if ($name eq 'public' && $domain eq 'public') {
-	  if (!defined($ENV{'form.username'})) {
-	      $ENV{'form.username'}.=time.rand(10000000);
-	  }
-	  $name.=$ENV{'form.username'};
+      if ($allowed) {
+	  ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');
+	  $courseid=$tmp_courseid;
+	  ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');
+	  ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');
+	  return ($symb,$courseid,$domain,$name,$publicuser);
+      }
+  }
+  if (!$passedsymb) {
+      $symb=&Apache::lonnet::symbread();
+  } else {
+      $symb=$passedsymb;
+  }
+  $courseid=$ENV{'request.course.id'};
+  $domain=$ENV{'user.domain'};
+  $name=$ENV{'user.name'};
+  if ($name eq 'public' && $domain eq 'public') {
+      if (!defined($ENV{'form.username'})) {
+	  $ENV{'form.username'}.=time.rand(10000000);
       }
+      $name.=$ENV{'form.username'};
   }
   return ($symb,$courseid,$domain,$name,$publicuser);
 }


500 Internal Server Error


Internal Server Error


The server encountered an internal error or
misconfiguration and was unable to complete
your request.


Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.


More information about this error may be available
in the server error log.