--- loncom/xml/run.pm 2002/05/23 21:15:34 1.29 +++ loncom/xml/run.pm 2003/06/09 21:45:23 1.38 @@ -1,6 +1,6 @@ package Apache::run; # -# $Id: run.pm,v 1.29 2002/05/23 21:15:34 albertel Exp $ +# $Id: run.pm,v 1.38 2003/06/09 21:45:23 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,60 +29,86 @@ use HTML::Entities; $Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; my %_LONCAPA_INTERNAL_oldexpressions=(); - my $i=0; while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { $_LONCAPA_INTERNAL_oldexpressions{$_}=1; $_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg; - if ($i++ > 10 ) { last; } + if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} } ENDEVALUATE sub evaluate { - my ($expression,$safeeval,$decls) = @_; - unless (defined($expression)) { return ''; } - if (!$Apache::lonxml::evaluate) { return $expression; } - my $result = ''; - $@=''; - if ($Apache::lonxml::request) { - $Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code"); - } - $safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. - "\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); - if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; } -# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); - my $error=$@; - if ($@ eq '') { - $result = $safeeval->reval('return $_;'); - chomp $result; - } else { - &Apache::lonxml::error('substitution on
'.$expression.
-			   '
with
'.$decls.
-			   '
caused
'.$error);
-  }  
-  return $result
+    my ($expression,$safeeval,$decls) = @_;
+    unless (defined($expression)) { return ''; }
+    if ($Apache::lonxml::evaluate < 1) { return $expression; }
+    my $result = '';
+    $@='';
+    $Apache::run::timeout=0;
+    $main::SIG{'ALRM'} = sub {
+	$Apache::run::timeout=1;
+	die("timeout");
+    };
+    my $innererror;
+    eval {
+	alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
+	$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression.
+			 "\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}');
+	$innererror=$@;
+	alarm(0);
+    };
+    my $error=$@;
+    if ($error eq '' && $innererror eq '' && !$Apache::run::timeout) {
+	$result = $safeeval->reval('return $_;');
+	chomp $result;
+    } else {
+	if ($Apache::run::timeout) {
+	    $error = 'Code ran too long. It ran for more than '.
+		Apache->request->server->timeout.' seconds';
+	}
+	&Apache::lonxml::error('substitution on 
'.
+			       &HTML::Entities::encode($expression).
+			       '
with
'.
+			       &HTML::Entities::encode($decls).
+			       '
caused
'.
+			       &HTML::Entities::encode($error).' '.
+			       &HTML::Entities::encode($innererror).
+			       '
'); + } + return $result } sub run { - my ($code,$safeeval,$hideerrors) = @_; -# print "inside run\n"; - $@=''; - if ($Apache::lonxml::request) { - $Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code"); - } - my (@result)=$safeeval->reval($code); - if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; } - my $error=$@; - if ($error ne '' && !$hideerrors) { - &Apache::lonxml::error('
'.&HTML::Entities::encode($error).
-			   '
occured while running
'.
-			   &HTML::Entities::encode($code).'
'); - } - if ( $#result < '1') { - return $result[0]; - } else { - &Apache::lonxml::debug("Got lots results:$#result:"); - return (@result); - } + my ($code,$safeeval,$hideerrors) = @_; + my @result; + $@=''; + $Apache::run::timeout=0; + $main::SIG{'ALRM'} = sub { + $Apache::run::timeout=1; + die("timeout"); + }; + my $innererror; + eval { + alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); + @result=$safeeval->reval($code); + $innererror=$@; + alarm(0); + }; + my $error=$@; + if (($Apache::run::timeout || $error ne '' || $innererror ne '') && !$hideerrors) { + if ($Apache::run::timeout) { + $error = 'Code ran too long. It ran for more than '. + Apache->request->server->timeout.' seconds'; + } + &Apache::lonxml::error('
'.&HTML::Entities::encode($error).' '.
+			       &HTML::Entities::encode($innererror).
+			       '
occured while running
'.
+			       &HTML::Entities::encode($code).'
'); + } + if ( $#result < '1') { + return $result[0]; + } else { + &Apache::lonxml::debug("Got lots results:$#result:"); + return (@result); + } } sub dump {