… | |
… | |
3141 | our $safe_hole = new Safe::Hole; |
3141 | our $safe_hole = new Safe::Hole; |
3142 | |
3142 | |
3143 | $SIG{FPE} = 'IGNORE'; |
3143 | $SIG{FPE} = 'IGNORE'; |
3144 | |
3144 | |
3145 | $safe->permit_only (Opcode::opset qw( |
3145 | $safe->permit_only (Opcode::opset qw( |
3146 | :base_core :base_mem :base_orig :base_math |
3146 | :base_core :base_mem :base_orig :base_math :base_loop |
3147 | grepstart grepwhile mapstart mapwhile |
3147 | grepstart grepwhile mapstart mapwhile |
3148 | sort time |
3148 | sort time |
3149 | )); |
3149 | )); |
3150 | |
3150 | |
3151 | # here we export the classes and methods available to script code |
3151 | # here we export the classes and methods available to script code |
… | |
… | |
3203 | $qcode =~ s/"/‟/g; # not allowed in #line filenames |
3203 | $qcode =~ s/"/‟/g; # not allowed in #line filenames |
3204 | $qcode =~ s/\n/\\n/g; |
3204 | $qcode =~ s/\n/\\n/g; |
3205 | |
3205 | |
3206 | %vars = (_dummy => 0) unless %vars; |
3206 | %vars = (_dummy => 0) unless %vars; |
3207 | |
3207 | |
|
|
3208 | my @res; |
3208 | local $_; |
3209 | local $_; |
3209 | local @safe::cf::_safe_eval_args = values %vars; |
|
|
3210 | |
3210 | |
3211 | my $eval = |
3211 | my $eval = |
3212 | "do {\n" |
3212 | "do {\n" |
3213 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
3213 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
3214 | . "#line 0 \"{$qcode}\"\n" |
3214 | . "#line 0 \"{$qcode}\"\n" |
3215 | . $code |
3215 | . $code |
3216 | . "\n}" |
3216 | . "\n}" |
3217 | ; |
3217 | ; |
3218 | |
3218 | |
|
|
3219 | if ($CFG{safe_eval}) { |
3219 | sub_generation_inc; |
3220 | sub_generation_inc; |
|
|
3221 | local @safe::cf::_safe_eval_args = values %vars; |
3220 | my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); |
3222 | @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); |
3221 | sub_generation_inc; |
3223 | sub_generation_inc; |
|
|
3224 | } else { |
|
|
3225 | local @cf::_safe_eval_args = values %vars; |
|
|
3226 | @res = wantarray ? eval eval : scalar eval $eval; |
|
|
3227 | } |
3222 | |
3228 | |
3223 | if ($@) { |
3229 | if ($@) { |
3224 | warn "$@"; |
3230 | warn "$@"; |
3225 | warn "while executing safe code '$code'\n"; |
3231 | warn "while executing safe code '$code'\n"; |
3226 | warn "with arguments " . (join " ", %vars) . "\n"; |
3232 | warn "with arguments " . (join " ", %vars) . "\n"; |