File Coverage

lib/PHP/Decode/Transformer.pm
Criterion Covered Total %
statement 2833 3386 83.6
branch 1738 2646 65.6
condition 552 842 65.5
subroutine 92 102 90.2
pod 12 67 17.9
total 5227 7043 74.2


line stmt bran cond sub pod time code
1             #
2             # transform parsed PHP statements
3             #
4             package PHP::Decode::Transformer;
5              
6 4     4   140252 use strict;
  4         29  
  4         119  
7 4     4   22 use warnings;
  4         11  
  4         105  
8 4     4   19 use Carp 'croak';
  4         8  
  4         186  
9 4     4   896 use PHP::Decode::Array qw(is_int_index);
  4         9  
  4         197  
10 4     4   1840 use PHP::Decode::Parser qw(:all);
  4         11  
  4         816  
11 4     4   3399 use PHP::Decode::Func;
  4         19  
  4         343  
12              
13             our $VERSION = '0.301';
14              
15             # avoid 'Deep recursion' warnings for depth > 100
16             #
17 4     4   26 no warnings 'recursion';
  4         12  
  4         213601  
18              
19             # In php-5.3 old superglobal names were still available and mapped to new names:
20             # $HTTP_SERVER_VARS $_SERVER
21             # $HTTP_GET_VARS $_GET
22             # $HTTP_POST_VARS $_POST
23             # $HTTP_POST_FILES $_FILES
24             # $HTTP_SESSION_VARS $_SESSION
25             # $HTTP_ENV_VARS $_ENV
26             # $HTTP_COOKIE_VARS $_COOKIE
27             #
28             my @superglobal_old = ('$HTTP_SERVER_VARS', '$HTTP_GET_VARS', '$HTTP_POST_VARS', '$HTTP_POST_FILES', '$HTTP_SESSION_VARS', '$HTTP_ENV_VARS', '$HTTP_COOKIE_VARS');
29             my %superglobal = map { $_ => 1 } ('$GLOBALS', '$_SERVER', '$_GET', '$_POST', '$_FILES', '$_COOKIE', '$_SESSION', '$_REQUEST', '$_ENV', @superglobal_old);
30              
31             my $histidx = 0;
32              
33             # Context:
34             # - $ctx->{defines}: map of constants & user-defined values
35             # - $ctx->{globals}: map of defined global & superglobal variables
36             # - $ctx->{varmap}: map of defined local variables (points to $ctx->{globals} on toplevel)
37             # - $ctx->{varmap}{global}: map of 'global $var' declarations in scope (renames $var to '$GLOBALS$var')
38             # - $ctx->{varmap}{static}: map of 'static $var' declarations for functions & methods
39             # - $ctx->{varmap}{ref}: map of $var = &$var2 references in scope
40             # - $ctx->{varmap}{fun}: map of registered functions
41             # - $ctx->{varmap}{class}: map of registered classes
42             # - $ctx->{varmap}{inst}: map of #inst -> $var references in scope (renames obj->var to '$inst$var')
43             # - $ctx->{varhist}: tracks variable assignments to insert on block level
44             # - $ctx->{infunction}: function/method name if in function (lowercase)
45             # - $ctx->{class_scope}: class name exists only if in classfunc/method-call (lowercase)
46             # - $ctx->{namespace}: namespace or '' if default namespace
47             # - $ctx->{incall}: in function/method calls (with resolved arguments)
48             # - $ctx->{tainted}: incomplete variables in context
49             # - $ctx->{skipundef}: skip conditions like empty($x) for undefined $x, so that no block is dropped
50             #
51             # Note: {static}{} & {inst}{} entries are always lowercase.
52             #
53             # supported {simplify} flags: {expr => 1, elem => 1, stmt => 1, call => 1, arr => 1}
54             # supported {skip} flags: {call => 1, loop => 1, null => 1, stdout => 1, treat_empty_str_like_empty_array => 1}
55             # supported {with} flags: {getenv => {}, optimize_block_vars => 1, invalidate_tainted_vars => 1, translate => 1}
56             #
57             sub new {
58 1524     1524 1 8307 my ($class, %args) = @_;
59 1524         2707 my %varmap;
60 1524 50       3711 my $parser = $args{parser} or croak __PACKAGE__ . " expects parser";
61              
62             my $self = bless {
63             toplevel => 1, # append STDOUT after eval
64             defines => {},
65             globals => \%varmap,
66             varmap => \%varmap,
67             varhist => {},
68             infunction => 0,
69             incall => 0,
70             namespace => '',
71             tainted => 0,
72             skipundef => 0,
73             max_loop => 10000,
74             simplify => {expr => 1, elem => 1, stmt => 1, call => 1, arr => 1},
75             skip => {},
76             with => {},
77       0     warn => sub { },
78 1524         25782 superglobal => \%superglobal,
79             %args, # might override preceding keys
80             }, $class;
81              
82 1524         7117 $self->{max_loop_const} = $self->{max_loop};
83 1524         3024 $self->{max_loop_while} = 10 * $self->{max_loop};
84 1524         2816 $self->{max_repeat} = $self->{max_loop};
85              
86 1524 100       4014 $self->{varmap}{inst} = {} unless exists $self->{varmap}{inst};
87 1524 100       3370 $self->{varmap}{fun} = {} unless exists $self->{varmap}{fun};
88 1524 100       3687 $self->{varmap}{class} = {} unless exists $self->{varmap}{class};
89 1524 100       3537 $self->{varmap}{static} = {} unless exists $self->{varmap}{static};
90 1524 100       4251 $self->{varmap}{stdout} = { buf => [] } unless exists $self->{varmap}{stdout};
91              
92 1524 0 33     3425 $self->_setup_env($self->{with}{getenv}) if exists $self->{with}{getenv} && $self->{toplevel};
93              
94 1524         5004 return $self;
95             }
96              
97             # The default is to reference the global and local varmaps from parent.
98             #
99             sub subctx {
100 801     801 1 2940 my ($ctx, %args) = @_;
101              
102 801 100       2293 $args{globals} = $ctx->{globals} unless exists $args{globals};
103 801 100       1741 $args{varmap} = $ctx->{varmap} unless exists $args{varmap};
104 801 100       1876 $args{parser} = $ctx->{parser} unless exists $args{parser};
105              
106             my $ctx2 = PHP::Decode::Transformer->new(
107             toplevel => 0,
108             defines => $ctx->{defines},
109             infunction => $ctx->{infunction},
110             incall => $ctx->{incall},
111             namespace => $ctx->{namespace},
112             tainted => $ctx->{tainted},
113             skipundef => $ctx->{skipundef},
114             max_loop => $ctx->{max_loop},
115             simplify => $ctx->{simplify},
116             skip => $ctx->{skip},
117             with => $ctx->{with},
118             warn => $ctx->{warn},
119             exists $ctx->{log} ? (log => $ctx->{log}) : (),
120 801 50       5268 exists $ctx->{class_scope} ? (class_scope => $ctx->{class_scope}) : (),
    100          
121             %args);
122              
123 801         2631 return $ctx2;
124             }
125              
126             # Create a clone of current context with a shallow copy of varmap & globals map
127             #
128             # This is used for speculative execution when a if- or loop-condition could
129             # not be resolved.
130             #
131             sub clone {
132 172     172 0 332 my ($ctx) = @_;
133 172         317 my %varmap = %{$ctx->{varmap}};
  172         1616  
134 172 100       603 my $globals = $ctx->{infunction} ? {%{$ctx->{globals}}} : \%varmap;
  64         245  
135              
136 172         626 return $ctx->subctx(globals => $globals, varmap => \%varmap, varhist => {}, skipundef => 1);
137             }
138              
139             # used for function simplifications
140             #
141             sub simplification_ctx {
142 242     242 0 751 my ($ctx, %args) = @_;
143              
144 242         543 $args{globals} = {};
145 242         522 $args{varmap} = {};
146 242         535 $args{varhist} = {};
147 242         434 $args{skipundef} = 1; # skip undefined variables
148 242         412 $args{tainted} = 1; # don't assume #null for undefined vars
149              
150             # allow to reference global functions and classes, when
151             # a function or class is simplified.
152             #
153             # create shallow copies, so that no new functions are
154             # created for parent ctx.
155             #
156 242 100       578 if (exists $ctx->{globals}{fun}) {
157 232 50       471 if (exists $ctx->{varmap}{fun}) {
158 232         396 $args{globals}{fun} = {%{$ctx->{globals}{fun}}, %{$ctx->{varmap}{fun}}};
  232         697  
  232         864  
159             } else {
160 0         0 $args{globals}{fun} = {%{$ctx->{globals}{fun}}};
  0         0  
161             }
162             }
163 242 100       665 if (exists $ctx->{globals}{class}) {
164 229 50       470 if (exists $ctx->{varmap}{class}) {
165 229         318 $args{globals}{class} = {%{$ctx->{globals}{class}}, %{$ctx->{varmap}{class}}};
  229         505  
  229         587  
166             } else {
167 0         0 $args{globals}{class} = {%{$ctx->{globals}{class}}};
  0         0  
168             }
169             }
170             # keep global statements active when functions are simplified
171             #
172 242 100       636 if (exists $ctx->{varmap}{global}) {
173 8         23 $args{varmap}{global} = {%{$ctx->{varmap}{global}}};
  8         22  
174             }
175 242         826 return $ctx->subctx(%args);
176             }
177              
178             # used for function calls (local vars can be used even if caller is tainted)
179             #
180             sub subscope_ctx {
181 272     272 0 1063 my ($ctx, %args) = @_;
182 272 50       719 my $varmap = $args{varmap} or croak __PACKAGE__ . " expects varmap";
183              
184 272         511 $args{parent} = $ctx; # keep reference to parent scope
185              
186             # copy globals and pass new varmap
187             # add instance var context to local varmap.
188             #
189 272 100       634 if (exists $ctx->{varmap}{'$this'}) {
190 1         9 $args{varmap}{'$this'} = $ctx->{varmap}{'$this'};
191             }
192 272 50       576 if (exists $ctx->{varmap}{inst}) {
193 272         562 $args{varmap}{inst} = $ctx->{varmap}{inst};
194             }
195 272 50       563 if (exists $ctx->{varmap}{fun}) {
196 272         523 $args{varmap}{fun} = $ctx->{varmap}{fun};
197             }
198 272 50       687 if (exists $ctx->{varmap}{class}) {
199 272         519 $args{varmap}{class} = $ctx->{varmap}{class};
200             }
201 272 50       568 if (exists $ctx->{varmap}{static}) {
202 272         477 $args{varmap}{static} = $ctx->{varmap}{static};
203             }
204 272         940 return $ctx->subctx(%args);
205             }
206              
207             sub _setup_env {
208 0     0   0 my ($ctx, $env) = @_;
209 0         0 my $parser = $ctx->{parser};
210 0         0 my $arr = $parser->newarr();
211              
212 0         0 foreach my $key (keys %$env) {
213 0         0 my $k = $parser->setstr($key);
214 0         0 my $v = $parser->setstr($env->{$key});
215 0         0 $arr->set($k, $v);
216             }
217 0         0 $ctx->{globals}{'$_ENV'} = $arr->{name};
218 0         0 my $arr2 = $arr->copy();
219 0         0 $ctx->{globals}{'$_SERVER'} = $arr2->{name};
220              
221             # superglobal arrays are currently created on the fly
222             #
223 0         0 if (0) {
224             foreach my $var (keys %{$ctx->{superglobal}}) {
225             unless (exists ($ctx->{globals}{$var})) {
226             $arr = $parser->newarr();
227             $ctx->{globals}{$var} = $arr->{name};
228             }
229             }
230             }
231             }
232              
233             sub cmd_getenv {
234 0     0 0 0 my ($ctx, $cmd, $args) = @_;
235 0         0 my $parser = $ctx->{parser};
236              
237 0 0 0     0 if (exists $ctx->{with}{getenv} && (scalar @$args == 1)) {
238 0         0 my $s = $parser->get_strval($$args[0]);
239 0 0       0 if (defined $s) {
240             # on some platforms getenv is case-independant, $_ENV/$_SERVER is not
241             # https://php.net/manual/en/function.getenv.php
242             #
243 0 0       0 if (exists $ctx->{globals}{'$_ENV'}) {
244 0         0 my $arr = $parser->{strmap}{$ctx->{globals}{'$_ENV'}};
245 0         0 my $idxstr = $$args[0];
246 0 0       0 if ($s ne uc($s)) {
247 0         0 $idxstr = $parser->setstr(uc($s));
248             }
249 0         0 my $arrval = $arr->get($idxstr);
250 0 0       0 if (defined $arrval) {
251 0         0 return $arrval;
252             }
253             }
254 0         0 return $parser->setstr('');
255             }
256             }
257 0         0 return;
258             }
259              
260             sub cmd_ob_start {
261 1     1 0 4 my ($ctx, $cmd, $args) = @_;
262 1         4 my $parser = $ctx->{parser};
263              
264             # https://php.net/manual/en/function.ob-start.php
265             # buffer output until ob_end_flush()/ob_end_clean() is called.
266             # read output buffer via ob_get_contents().
267             #
268             # TODO: ob_start stacking
269             #
270 1 50       5 if (scalar @$args >= 1) {
271             # string handler ( string $buffer [, int $phase ] )
272             #
273 1         4 my $handler = $$args[0];
274 1         6 my $name = $parser->get_strval($$args[0]);
275 1 50 33     13 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout} && defined $name) {
      33        
276 1 50       4 unless ($ctx->{infunction}) {
277 1 50       4 $ctx->{log}->($ctx, 'cmd', $cmd, "(handler: $name)") if $ctx->{log};
278              
279 1         4 my $fun = $ctx->getfun($name);
280 1 50       16 if (defined $fun) {
281 1         3 my ($_name, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  1         7  
282 1         7 my $f = $parser->setfun(undef, $a, $b);
283 1         6 my $v = '$ob_'.$name;
284 1         6 $ctx->{globals}{stdout}{handler} = $v; # handler variable
285 1         3 $ctx->{globals}{stdout}{ob} = [];
286              
287             # note: returns handler assignment instead of bool here
288             #
289 1         5 my $e = $parser->setexpr('=', $v, $f);
290             #my $e = $parser->setcall('ob_start', [$f]);
291 1         8 return $e;
292             #return $parser->setnum(1);
293             } else {
294 0         0 return $parser->setnum(0);
295             }
296             }
297             }
298             } else {
299 0 0 0     0 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
300 0 0       0 unless ($ctx->{infunction}) {
301 0 0       0 $ctx->{log}->($ctx, 'cmd', $cmd, "()") if $ctx->{log};
302 0         0 $ctx->{globals}{stdout}{handler} = '#null';
303 0         0 $ctx->{globals}{stdout}{ob} = [];
304 0         0 return $parser->setnum(1);
305             }
306             }
307             }
308 0         0 return;
309             }
310              
311             sub cmd_ob_end_flush {
312 1     1 0 10 my ($ctx, $cmd, $args) = @_;
313 1         4 my $parser = $ctx->{parser};
314              
315 1 50 33     9 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
316 1 50       6 if (exists $ctx->{globals}{stdout}{handler}) {
317 1 50       4 unless ($ctx->{infunction}) {
318 1         5 my @r;
319 1         5 my $handler = $ctx->{globals}{stdout}{handler};
320 1         4 my @ob = @{$ctx->{globals}{stdout}{ob}};
  1         4  
321 1         3 delete $ctx->{globals}{stdout}{handler};
322 1         4 delete $ctx->{globals}{stdout}{ob};
323 1 50       5 $ctx->{log}->($ctx, 'cmd', $cmd, "(handler: $handler) [%s]", join(' ', @ob)) if $ctx->{log};
324 1         6 merge_str_list(\@ob, $parser);
325 1         6 while (my $s = shift @ob) {
326 1 50 33     3 if (is_strval($s) && ($handler ne '#null')) {
327 1         7 my $h = $parser->setcall($handler, [$s]);
328 1         6 my $k = $ctx->exec_statement($h);
329              
330 1 50       11 if (defined $k) {
331 1         8 push(@r, $h);
332             }
333             } else {
334 0         0 push(@{$ctx->{globals}{stdout}{buf}}, $s);
  0         0  
335             }
336             }
337 1 50       5 if (@r) {
338             # note: returns handler call instead of bool here
339             #
340 1         6 return _flat_block_or_single($parser, \@r);
341             }
342 0         0 return $parser->setnum(1);
343             }
344             } else {
345 0 0       0 unless ($ctx->{infunction}) {
346 0         0 return $parser->setnum(0);
347             }
348             }
349             }
350 0         0 return;
351             }
352              
353             sub cmd_ob_end_clean {
354 0     0 0 0 my ($ctx, $cmd, $args) = @_;
355 0         0 my $parser = $ctx->{parser};
356              
357 0 0 0     0 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
358 0 0       0 if (exists $ctx->{globals}{stdout}{handler}) {
359 0 0       0 unless ($ctx->{infunction}) {
360 0         0 delete $ctx->{globals}{stdout}{handler};
361 0         0 delete $ctx->{globals}{stdout}{ob};
362 0         0 return $parser->setnum(1);
363             }
364             } else {
365 0 0       0 unless ($ctx->{infunction}) {
366 0         0 return $parser->setnum(0);
367             }
368             }
369             }
370 0         0 return;
371             }
372              
373              
374             sub register_funcs {
375 1013     1013 0 1748 my ($list, $ctx, $parser) = @_;
376              
377 1013         2053 foreach my $k (@$list) {
378 1536 100 100     6347 if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) {
    100          
    100          
379 10         22 my ($arg, $block) = @{$parser->{strmap}->{$k}}[1..2];
  10         32  
380 10         26 $ctx->{namespace} = $arg; # always use case in-sensitive later
381             } elsif ($k =~ /^#fun\d+$/) {
382 175         288 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$k}};
  175         524  
383 175 100       469 if (defined $f) {
384 164         396 $ctx->registerfun($f, $k);
385             }
386             } elsif ($k =~ /^#class\d+$/) {
387 53         82 my ($c, $b, $p) = @{$parser->{strmap}->{$k}};
  53         159  
388 53         76 my ($type, $arglist) = @{$parser->{strmap}->{$b}};
  53         119  
389              
390 53         127 foreach my $a (@$arglist) {
391 89 100       227 if ($a =~ /^#fun\d+$/) {
392 45         102 my $f = $parser->{strmap}->{$a}->[0];
393 45 50       103 if (defined $f) {
394 45 50       93 my $name = defined $c ? $c : 'class@anonymous';
395 45         138 my $ctx2 = $ctx->subctx(class_scope => lc($name), infunction => 0);
396 45         146 $ctx2->registerfun($f, $a);
397             }
398             }
399             }
400 53 50       149 if (defined $c) {
401 53         119 $ctx->registerclass($c, $k);
402             }
403             }
404             }
405 1013         1752 return;
406             }
407              
408             sub _move_funcs_to_start {
409 784     784   1355 my ($parser, $stmt) = @_;
410 784         1114 my @funcs = ();
411 784         1031 my @code = ();
412 784         1068 my @block = ();
413            
414 784 100       1960 if (is_block($stmt)) {
415 457         648 my ($type, $a) = @{$parser->{strmap}{$stmt}};
  457         1181  
416              
417 457         1002 foreach my $k (@$a) {
418 1090 100 100     4185 if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) {
    100          
419 10         17 push(@block, @funcs);
420 10         16 push(@block, @code);
421 10         20 push(@block, $k);
422 10         14 @funcs = ();
423 10         16 @code = ();
424             } elsif ($k =~ /^#(fun|class)\d+$/) {
425 184         436 push(@funcs, $k);
426             } else {
427 896         1725 push(@code, $k);
428             }
429             }
430 457         738 push(@block, @funcs);
431 457         791 push(@block, @code);
432 457 100       1004 if (scalar @block == 1) {
433 1         4 return $block[0];
434             }
435 456         1476 my $s = $parser->setblk('flat', [@block]);
436 456         1214 return $s;
437             }
438 327         770 return $stmt;
439             }
440              
441             sub parse_eval {
442 792     792 1 1611 my ($ctx, $arg) = @_;
443 792         1385 my $parser = $ctx->{parser};
444              
445 792         2214 my $s = $parser->get_strval($arg);
446 792 100       1987 if (defined $s) {
447 784 50       1727 $ctx->{log}->($ctx, 'eval', $arg, "%s", $parser->shortstr($s, 400)) if $ctx->{log};
448              
449 784 100       2264 $parser->{strmap}->{'__FILE__'} = $s if $ctx->{toplevel}; # for fopen('__FILE__')
450              
451             # (1) tokenize input file
452             #
453 784         3162 my $quote = $parser->tokenize_line($s, $ctx->{quote});
454 784 50       1962 if (defined $quote) {
455             # some lines are cut at the end
456 0         0 $ctx->{warn}->($ctx, 'eval', $arg, "tokenize bad quote %s, line: [%s]", $quote, $parser->shortstr($s, 200));
457             }
458 784         1297 my $tok = $parser->{tok};
459              
460             #$ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", $parser->shortstr(join(' ', @$tok), 200)) if $ctx->{log};
461 784 50       1597 $ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", join(' ', @$tok)) if $ctx->{log};
462              
463             # (2) parse tokens to statements
464             #
465 784         2051 my $out = $parser->read_code($tok);
466              
467 784 50       1866 if ($parser->{debug}) {
468 0         0 my $line = $parser->format_stmt($out, {format => 1});
469 0 0       0 $parser->{debug}->('eval', "$arg: parsed line: %s", $line) if $parser->{debug};
470             }
471 784         2563 return $out; # empty block if token list is empty
472             }
473 8         31 return;
474             }
475              
476             sub exec_eval {
477 784     784 1 2185 my ($ctx, $arg) = @_;
478 784         1348 my $parser = $ctx->{parser};
479              
480 784 50       1640 if (defined $arg) {
    0          
481 784         1274 my @funcs = ();
482 784         1240 my @code = ();
483              
484 784         1454 $ctx->{tainted} = 0;
485              
486             # rearrange tokens
487             #
488 784         1563 my $out = _move_funcs_to_start($parser, $arg);
489 784 100       1711 if (is_block($out)) {
490 456         656 my ($type, $a) = @{$parser->{strmap}->{$out}};
  456         1030  
491 456         1219 @funcs = @$a;
492             } else {
493 328         686 @funcs = ($out);
494             }
495              
496             # (3) exec statements
497             #
498 784         2216 register_funcs(\@funcs, $ctx, $parser);
499 784 50       1733 $ctx->{log}->($ctx, 'eval', $arg, "parsed: $out") if $ctx->{log};
500 784 100       1620 my $in_block = is_block($out) ? 0 : 1;
501 784         2098 my $stmt = $ctx->exec_statement($out, $in_block);
502              
503 784 50       1805 $ctx->{log}->($ctx, 'eval', $arg, "statement: $stmt") if $ctx->{log};
504              
505             # (4) insert remaining assignments at front of block
506             #
507 784         1729 $stmt = $ctx->insert_assignments($stmt);
508              
509             # (5) flush output buffer
510             #
511 784 50 66     3058 if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) {
512 722 100       1654 if (exists $ctx->{varmap}{stdout}{handler}) {
513             # call handler at the end of the request
514             # see: https://www.php.net/manual/en/function.ob-start.php
515             #
516 1         8 my $e = $parser->setcall('ob_end_flush', []);
517 1         5 my $k = $ctx->exec_statement($e);
518              
519 1         4 my @seq = ();
520 1         6 $parser->flatten_block($stmt, \@seq);
521 1         14 $stmt = $parser->setblk('flat', [@seq, $k]);
522             }
523             }
524              
525             # (6) log stdout
526             #
527 784 50 66     2555 if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) {
528 722 100       1082 if (@{$ctx->{varmap}{stdout}{buf}}) {
  722         1807  
529 96         234 my @stdout = @{$ctx->{varmap}{stdout}{buf}};
  96         338  
530 96         187 my $v = '$STDOUT';
531 96         147 my $k;
532 96         329 merge_str_list(\@stdout, $parser);
533 96         334 while (my $s = shift @stdout) {
534 97 100       626 if (defined $k) {
535 1         3 $k = $parser->setexpr('.', $k, $s);
536             } else {
537 96         248 $k = $s;
538             }
539             }
540 96 50       257 unless (exists $ctx->{skip}{stdout}) {
541 96         271 my $e = $parser->setexpr('=', $v, $k);
542 96         215 my @seq = ();
543 96         488 $parser->flatten_block($stmt, \@seq);
544 96         384 $stmt = $parser->setblk('flat', [@seq, $e]);
545             }
546             }
547             }
548              
549             # (7) flatten block if necessary
550             #
551 784 100       1738 if (is_block($stmt)) {
552 519         757 my ($type, $a) = @{$parser->{strmap}->{$stmt}};
  519         1248  
553 519 100       1395 if ($type ne 'flat') {
554 12         31 my @seq = ();
555 12         47 $parser->flatten_block($stmt, \@seq);
556 12 50       35 if (scalar @seq > 1) {
    0          
557 12         35 $stmt = $parser->setblk('flat', [@seq]);
558             } elsif (scalar @seq > 0) {
559 0         0 $stmt = $seq[0];
560             }
561             }
562             }
563 784         1126 my $outlist;
564 784 100 50     1682 $outlist = join(' ', @{$ctx->{varmap}{stdout}{buf}}) if (exists $ctx->{varmap}{stdout} && scalar @{$ctx->{varmap}{stdout}{buf}});
  104         324  
  784         2306  
565 784 0       1596 $ctx->{log}->($ctx, 'eval', $arg, "got: $stmt%s", defined $outlist ? ' ('.$outlist.')' : '') if $ctx->{log};
    50          
566 784         3044 return $stmt;
567             } elsif (is_null($arg)) { # might be return from nested eval
568 0 0       0 $ctx->{log}->($ctx, 'eval', $arg, "got null") if $ctx->{log};
569 0         0 return $arg; # stray null statements are removed by flatten_block()
570             }
571 0         0 return;
572             }
573              
574             # check if elem without recursive subreferences
575             #
576             sub is_flat_elem {
577 859     859 0 1705 my ($s, $parser) = @_;
578            
579 859 100       2040 if ($s =~ /^#elem\d+$/) {
580 17         57 my ($v, $i) = @{$parser->{strmap}->{$s}};
  17         77  
581 17 50       55 if (defined $v) {
582 17 100       45 if (!is_variable($v)) {
583 4         19 return 0;
584             }
585             }
586 13 50       43 if (defined $i) {
587 13 100       43 if (!is_strval($i)) {
588 2         13 return 0;
589             }
590             }
591 11         61 return 1;
592             }
593 842         3224 return 0;
594             }
595              
596             # check if elem is anonymous function call, and return it
597             #
598             sub _anon_func_call {
599 20     20   61 my ($parser, $s) = @_;
600              
601 20 50       59 if ($s =~ /^#call\d+$/) {
602 0         0 my ($f, $a) = @{$parser->{strmap}->{$s}};
  0         0  
603 0 0       0 if ($f =~ /^#fun\d+$/) {
604 0         0 my ($fn, $fa, $fb, $fp) = @{$parser->{strmap}->{$f}};
  0         0  
605 0 0       0 if (!defined $fn) {
606 0         0 return $f;
607             }
608             }
609             }
610 20         61 return;
611             }
612              
613             # check if expression in block contains a local variable
614             #
615             sub contains_local_var {
616 258     258 0 457 my ($ctx, $info) = @_;
617              
618 258         348 foreach my $var (keys %{$info->{vars}}) {
  258         650  
619 11 100       36 next if $ctx->is_superglobal($var);
620 4 50       15 next if $ctx->is_global_var($var);
621              
622 4         13 return 1;
623             }
624 254         1000 return 0;
625             }
626              
627             # if expression in block contains an unresolvable variable, then return it
628             #
629             sub unresolvable_var {
630 1121     1121 0 2431 my ($ctx, $info) = @_;
631              
632 1121         1450 foreach my $var (keys %{$info->{vars}}) {
  1121         2946  
633 194 100       446 next if $ctx->is_superglobal($var);
634              
635 188         492 my $val = $ctx->getvar($var, 1);
636 188 100       660 if (!defined $val) {
    100          
637 7         23 return $var;
638             } elsif ($val eq '#unresolved') {
639 14         90 return $var;
640             }
641             }
642 1100         3452 return;
643             }
644              
645             # if expression in block contains an unresolvable local or instance variable, then return it
646             #
647             sub unresolvable_local_var {
648 0     0 0 0 my ($ctx, $info) = @_;
649              
650 0         0 foreach my $var (keys %{$info->{vars}}) {
  0         0  
651 0 0       0 next if $ctx->is_superglobal($var);
652 0 0       0 next if $ctx->is_global_var($var);
653              
654 0         0 my $val = $ctx->getvar($var, 1);
655 0 0       0 if (!defined $val) {
    0          
656 0         0 return $var;
657             } elsif ($val eq '#unresolved') {
658 0         0 return $var;
659             }
660             }
661 0         0 return;
662             }
663              
664             # return new list where consecutive strings are merged
665             # (keeps constants intact)
666             #
667             sub merge_str_list {
668 102     102 0 226 my ($seq, $parser) = @_;
669 102         167 my @list = ();
670              
671 102         263 while (my $s = shift @$seq) {
672 106 100 100     302 if (is_strval($s) && !is_const($s)) {
673 99         173 my $i;
674 99         252 for ($i=0; $i < scalar @$seq; $i++) {
675 29 100 100     120 last unless (is_strval($seq->[$i]) && !is_const($seq->[$i]));
676             }
677 99 100       531 if ($i > 0) {
    100          
    100          
678 17         63 my @list = ($s, splice(@$seq, 0, $i));
679 17         49 my $str = join('', map { $parser->{strmap}->{$_} } @list);
  43         136  
680 17         61 $s = $parser->setstr($str);
681             } elsif ($s =~ /^#(const|num)\d+$/) {
682 17         48 my $str = $parser->{strmap}->{$s};
683 17         53 $s = $parser->setstr($str);
684             } elsif (is_null($s)) {
685 1         5 $s = $parser->setstr('');
686             }
687             }
688 106         411 push(@list, $s);
689             }
690 102         211 @$seq = @list;
691 102         187 return;
692             }
693              
694             # return flat block or single statement
695             #
696             sub _flat_block_or_single {
697 128     128   284 my ($parser, $seq) = @_;
698              
699 128 100       351 if (scalar @$seq == 1) {
700 12         47 return $seq->[0];
701             }
702 116         405 return $parser->setblk('flat', [@$seq]);
703             }
704              
705             # convert flat block or statement to code block
706             #
707             sub _to_code_block {
708 10     10   24 my ($parser, $s) = @_;
709              
710 10 50       34 if (is_block($s)) {
711 10         17 my ($type, $a) = @{$parser->{strmap}->{$s}};
  10         40  
712 10 50       39 if ($type ne 'std') {
713 0         0 my @seq = ();
714 0         0 $parser->flatten_block($s, \@seq);
715 0         0 $s = $parser->setblk('std', [@seq]);
716             }
717             } else {
718 0         0 $s = $parser->setblk('std', [$s]);
719             }
720 10         23 return $s;
721             }
722              
723             # convert statements to anon function call without parameters
724             # (if not already anon function)
725             #
726             sub _to_anon_func_call {
727 4     4   14 my ($parser, $s) = @_;
728              
729 4 50       14 unless (_anon_func_call($parser, $s)) {
730 4         15 $s = _to_code_block($parser, $s);
731 4         31 my $f = $parser->setfun(undef, [], $s);
732 4         21 $s = $parser->setcall($f, []);
733             }
734 4         34 return $s;
735             }
736              
737             # get first block elem or elem itself
738             #
739             sub _first_statement {
740 0     0   0 my ($parser, $s) = @_;
741              
742 0 0       0 if (is_block($s)) {
743 0         0 my ($type, $a) = @{$parser->{strmap}->{$s}};
  0         0  
744 0 0       0 if (scalar @$a > 0) {
745 0         0 return $a->[0];
746             }
747             }
748 0         0 return $s;
749             }
750              
751             # if the final element of a block is a #stmt matching pattern, then return this #stmt
752             #
753             sub _final_break {
754 2763     2763   5180 my ($parser, $s, $pattern) = @_;
755              
756 2763 100       5205 if (is_block($s)) {
757 318         538 my ($type, $a) = @{$parser->{strmap}->{$s}};
  318         915  
758 318 100       858 if (scalar @$a > 0) {
759 300         769 return &_final_break($parser, $a->[-1], $pattern);
760             }
761             }
762 2463 100       6191 if ($s =~ /^#stmt\d+$/) {
763 767         1651 my $cmd = $parser->{strmap}->{$s}->[0];
764 767 100       14111 if ($cmd =~ /^$pattern$/) {
765 391         1565 return $s;
766             }
767             }
768 2072         4180 return;
769             }
770              
771             # if the a block contains functions, then return function list
772             #
773             sub _contained_functions {
774 0     0   0 my ($parser, $s) = @_;
775              
776 0 0       0 if (is_block($s)) {
777 0         0 my ($type, $a) = @{$parser->{strmap}->{$s}};
  0         0  
778 0         0 my @list = ();
779 0         0 foreach my $stmt (@$a) {
780 0         0 my $sublist = &_contained_functions($parser, $stmt);
781 0 0       0 if (scalar @$sublist > 0) {
782 0         0 push(@list, @$sublist);
783             }
784             }
785 0         0 return \@list;
786             }
787 0 0       0 if ($s =~ /^#fun\d+$/) {
788 0         0 return [$s];
789             }
790 0         0 return [];
791             }
792              
793             # if a block contains calls with resolved params, then return call list
794             #
795             sub _contained_resolved_calls {
796 0     0   0 my ($parser, $s) = @_;
797              
798 0 0       0 if (is_block($s)) {
799 0         0 my ($type, $a) = @{$parser->{strmap}->{$s}};
  0         0  
800 0         0 my @list = ();
801 0         0 foreach my $stmt (@$a) {
802 0         0 my $sublist = &_contained_resolved_calls($parser, $stmt);
803 0 0       0 if (scalar @$sublist > 0) {
804 0         0 push(@list, @$sublist);
805             }
806             }
807 0         0 return \@list;
808             }
809 0 0       0 if ($s =~ /^#call\d+$/) {
810 0         0 my ($name, $args) = @{$parser->{strmap}->{$s}};
  0         0  
811 0         0 foreach my $p (@$args) {
812 0 0 0     0 unless (is_strval($p) || is_array($p)) {
813 0         0 return [];
814             }
815             }
816 0         0 return [$s];
817             }
818 0         0 return [];
819             }
820              
821             sub _get_echo_arglist {
822 104     104   183 my ($parser, $s) = @_;
823              
824 104 100       296 if ($s =~ /^#stmt\d+$/) {
825 40         89 my $cmd = $parser->{strmap}->{$s}->[0];
826 40         91 my $arglist = $parser->{strmap}->{$s}->[1];
827 40 50       97 if ($cmd eq 'echo') {
828 40         57 my $all_str = 1;
829              
830 40         78 foreach my $p (@$arglist) {
831 40 50       79 $all_str = 0 if !is_strval($p);
832             }
833 40         114 return ($arglist, $all_str);
834             }
835             }
836 64         140 return;
837             }
838              
839             # if a unresolved #stmt or #call matching pattern remains in a function, return this element
840             #
841             sub _skipped_call {
842 1350     1350   2702 my ($parser, $s, $pattern, $info) = @_;
843              
844 1350         1960 foreach my $call (keys %{$info->{calls}}) {
  1350         4391  
845 102 100       467 next if ($info->{calls}{$call}) eq 'return'; # allow skipped call in return?
846              
847 95         210 my $name = $call;
848 95 50       362 if ($name !~ /^(ob_start|exit|die|__halt_compiler)$/i) { # allow skipped exit-like calls
849 95 50       230 if ($name !~ /^(error_reporting)$/i) { # allow skipped calls without side effects
850 95 50       644 if ($name =~ /^$pattern$/) {
851 95         378 return $call;
852             }
853             }
854             }
855             }
856 1255         1992 foreach my $stmt (keys %{$info->{stmts}}) {
  1255         2843  
857 51         169 my $cmd = $parser->{strmap}->{$stmt}->[0];
858 51 100       173 if ($cmd eq 'echo') {
    50          
859             # 'echo' is kept inline for non-string argument
860             #
861 50         106 my $arglist = $parser->{strmap}->{$stmt}->[1];
862 50 50 33     241 if ((scalar @$arglist > 1) || !is_strval($arglist->[0])) {
863 0 0       0 if ($cmd =~ /^$pattern$/) {
864 0         0 return $stmt;
865             }
866             }
867             } elsif ($cmd ne 'global') { # 'global $var' is always executed
868 1 50       24 if ($cmd =~ /^$pattern$/) {
869 1         5 return $stmt;
870             }
871             }
872             }
873 1254         3599 return;
874             }
875              
876             # collect info about unresolved calls and assignments in a function call
877             # - $info->{unresolved} = names of unresolvable calls and assignments
878             # - $info->{global_assigns} = global variables with resolved assignments
879             # - $info->{local_assigns} = local variables with resolved assignments
880             #
881             sub get_unresolved_info {
882 554     554 0 1192 my ($ctx, $cmd, $stmt) = @_;
883 554         1007 my $parser = $ctx->{parser};
884              
885 554         4175 my $info = {vars => {}, calls => {}, stmts => {}, assigns => {}, noassigns => {}, resolved => {$cmd => 1}, unresolved => {}, global_assigns => {}, local_assigns => {}};
886 554         2238 $parser->stmt_info($stmt, $info);
887              
888 554         815 foreach my $call (keys %{$info->{calls}}) {
  554         1636  
889 201         514 my $fun = $ctx->getfun($call);
890              
891 201         416 $call = lc($call);
892              
893 201 100       645 if (defined $fun) {
    100          
894 32         51 my ($name, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  32         108  
895              
896             # check if function was already visited
897             #
898 32 50       93 if (!exists $info->{resolved}{$call}) {
899 32         87 my $subinfo = $ctx->get_unresolved_info($call, $b);
900              
901 32         54 $info->{global_assigns} = {%{$info->{global_assigns}}, %{$subinfo->{global_assigns}}};
  32         62  
  32         84  
902 32         71 $info->{unresolved} = {%{$info->{unresolved}}, %{$subinfo->{unresolved}}};
  32         71  
  32         78  
903 32         65 $info->{resolved} = {%{$info->{resolved}}, %{$subinfo->{resolved}}};
  32         73  
  32         84  
904 32         177 $info->{resolved}{$call} = 1;
905             }
906             } elsif (my $f = PHP::Decode::Func::get_php_func($call)) {
907 40 100       108 if (PHP::Decode::Func::func_may_call_callbacks($call)) {
908 2         5 my $skip = 0;
909 2 50       6 if ($call eq 'array_filter') {
910 0         0 my @list = keys %{$info->{callargs}{$call}};
  0         0  
911 0 0 0     0 if ((scalar @list == 1) && ($list[0] eq '1')) {
912             # one-arg array_filter has no callable
913 0 0       0 $ctx->{log}->($ctx, 'exec', $stmt, "get_unresolved_info $cmd: skip 1-arg $call") if $ctx->{log};
914 0         0 $skip = 1;
915             }
916             }
917 2 50       6 unless ($skip) {
918 2         7 $info->{unresolved}{$call} = 1;
919             }
920             }
921             # func without side-effects on vars here
922             } else {
923 129         338 $info->{unresolved}{$call} = 1;
924             }
925             }
926 554         967 foreach my $var (keys %{$info->{assigns}}) {
  554         1405  
927 273 50       847 if ($var =~ /^#elem\d+$/) {
    100          
    100          
928 0         0 my $elemlist = _get_elemlist($parser, $var);
929 0         0 my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}};
  0         0  
930              
931 0         0 my $g = $parser->globalvar_to_var($v, $i);
932 0 0       0 if (defined $g) {
    0          
    0          
933 0         0 $info->{global_assigns}{$g} = 1;
934             } elsif ($ctx->is_superglobal($v)) {
935 0         0 $info->{global_assigns}{$var} = 1;
936             } elsif (is_variable($v)) {
937 0         0 my ($g) = global_split($v);
938 0 0       0 if (defined $g) {
939             # access on global array-var
940 0         0 $info->{global_assigns}{$g} = 1;
941             } else {
942 0         0 $info->{local_assigns}{$v} = 1;
943             }
944             } else {
945 0         0 $info->{unresolved}{$var} = 1;
946             }
947             } elsif (is_variable($var)) {
948 265         630 my ($g) = global_split($var);
949 265 100       654 if (defined $g) {
950 26         68 $info->{global_assigns}{$g} = 1;
951 26         55 next;
952             }
953 239 100       610 if ($ctx->is_superglobal($var)) {
954 2         5 $info->{global_assigns}{$var} = 1;
955 2         17 next;
956             }
957 237         665 $info->{local_assigns}{$var} = 1;
958             } elsif ($var =~ /^#obj\d+$/) {
959 7         24 $info->{local_assigns}{$var} = 1;
960             } else {
961 1         3 $info->{unresolved}{$var} = 1;
962             }
963             }
964 554         1999 return $info;
965             }
966              
967             # if a function returns just a single #call with same signature, then return this #call
968             #
969             sub _is_wrapped_call {
970 209     209   415 my ($parser, $s) = @_;
971              
972 209 50       768 unless ($s =~ /^#fun\d+$/) {
973 0         0 return;
974             }
975 209         348 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$s}};
  209         572  
976 209         575 $s = $parser->flatten_block_if_single($b);
977              
978 209 100       576 if ($s =~ /^#stmt\d+$/) {
979 92         209 my $cmd = $parser->{strmap}->{$s}->[0];
980 92 100       274 if (lc($cmd) eq 'return') {
981 61         149 my $val = $parser->{strmap}->{$s}->[1];
982 61 100       214 if ($val =~ /^#call\d+$/) {
983 7         28 my ($name, $arglist) = @{$parser->{strmap}->{$val}};
  7         23  
984              
985             # eval might create local vars
986 7 100 100     24 if (is_symbol($name) && (lc($name) ne 'eval') && (scalar @$arglist == scalar @$a)) {
      66        
987 5         13 my $i = 0;
988 5         10 my $arg_match = 1;
989 5         15 foreach my $k (@$arglist) {
990 4 100       19 if ($k ne $a->[$i]) {
991 1         5 $arg_match = 0;
992             }
993 4         12 $i++;
994             }
995 5 100       18 if ($arg_match) {
996 4         13 return $name;
997             }
998             }
999             }
1000             }
1001             }
1002 205         441 return;
1003             }
1004              
1005             # check if a variable should be marked as #unresolved based on right-hand-side of assignment
1006             #
1007             sub is_unresolved_assignment {
1008 1003     1003 0 1946 my ($ctx, $rhs) = @_;
1009 1003         1708 my $parser = $ctx->{parser};
1010              
1011 1003 100       2357 if ($rhs =~ /^#expr\d+$/) {
1012 54         125 my ($op, $v1, $v2) = @{$parser->{strmap}->{$rhs}};
  54         181  
1013              
1014 54 50 33     189 if (($op eq '=') && defined $v2) {
1015             # check for: $a = $b = 1;
1016 0         0 return $ctx->is_unresolved_assignment($v2);
1017             }
1018              
1019             # expressions should already have been resolved
1020             # (such assignments would lead to recursions like $a = expr:[$a + 1])
1021             #
1022 54         153 return 1;
1023             }
1024 949         3818 my $info = {vars => {}, calls => {}, stmts => {}};
1025 949         3402 $parser->stmt_info($rhs, $info);
1026              
1027 949 100 100     2203 if (my $c = _skipped_call($parser, $rhs, '(.*)', $info)) {
    100 100        
    100          
1028             # never replace content when the rhs contains
1029             # an unresolved #call
1030             #
1031 73         349 return 1;
1032             } elsif (!is_variable($rhs) && !is_flat_elem($rhs, $parser) && $ctx->unresolvable_var($info)) {
1033             # don't replace content when the rhs contains
1034             # a unresolved variable.
1035             # Make an exception for single variables and simple #elems.
1036             #
1037 7         35 return 1;
1038             } elsif (is_variable($rhs)) {
1039             # forward unresolved state to lhs
1040             #
1041 17         109 my $val = $ctx->getvar($rhs, 1);
1042 17 100 66     134 if (defined $val && ($val eq '#unresolved')) {
1043 15         80 return 1;
1044             }
1045             }
1046 854         4104 return 0;
1047             }
1048              
1049             # check if this is pre/post increment expr
1050             #
1051             sub _is_increment_op {
1052 1238     1238   2100 my ($parser, $stmt) = @_;
1053              
1054 1238 100       2459 if ($stmt =~ /^#expr\d+$/) {
1055 50         81 my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}};
  50         170  
1056 50   100     283 return ($op eq '++') || ($op eq '--');
1057             }
1058 1188         3142 return;
1059             }
1060              
1061             # return varable if statement is assignment
1062             #
1063             sub _var_assignment {
1064 2345     2345   4082 my ($parser, $stmt) = @_;
1065              
1066 2345 100       5922 if ($stmt =~ /^#expr\d+$/) {
1067 1120         1794 my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}};
  1120         3084  
1068              
1069 1120 100 66     3936 if (($op eq '=') && defined $v2) {
1070 1070         3941 return ($v1, $v2);
1071             }
1072             }
1073 1275         2404 return;
1074             }
1075              
1076             sub get_indexed_array_var {
1077 160     160 0 294 my ($ctx, $var) = @_;
1078 160         254 my $parser = $ctx->{parser};
1079              
1080 160 100       345 if ($var =~ /^#elem\d+$/) {
1081 50         76 my ($v, $i) = @{$parser->{strmap}->{$var}};
  50         115  
1082              
1083 50         106 my $val = $ctx->getvar($v, 1);
1084 50 50 33     176 if (defined $val && is_array($val)) {
1085 50         166 return ($v, $val);
1086             }
1087             }
1088 110         223 return;
1089             }
1090              
1091             # optimize loop variable assignments
1092             # 1) add block of new instructions from last loop iteration
1093             # 2) merge assignments to same variable or echo-statements
1094             # (just for strval/array values).
1095             #
1096             sub optimize_loop_var_list {
1097 113     113 0 281 my ($ctx, $type, $stmt, $list, $res) = @_;
1098 113         211 my $parser = $ctx->{parser};
1099 113         177 my $changed = 0;
1100              
1101 113         252 ELEM: for (my $i = 0; $i < scalar @$res; $i++) {
1102 160         282 my $elem = $res->[$i];
1103              
1104             # merge previous array assignment with new one
1105             #
1106 160         300 my ($v, $lhs) = _var_assignment($parser, $elem);
1107 160 100       390 if (defined $v) {
1108             # optimize only trailing var assignments to strval or array
1109             #
1110 133         318 for (my $j = scalar @$list; $j > 0; $j--) {
1111 167         310 my $prev = $list->[$j-1];
1112 167         301 my ($vp, $lhsp) = _var_assignment($parser, $prev);
1113 167 100       376 if (!defined $vp) {
1114 10 50 33     58 if (is_strval($prev) || is_array($prev)) {
    100          
1115 0         0 next; # allow plain values as statement
1116             } elsif (!_get_echo_arglist($parser, $prev)) {
1117 1         10 push(@$list, $elem);
1118 1         5 next ELEM; # other statements than echo or assign
1119             } else {
1120 9         23 next;
1121             }
1122             }
1123             #$ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v: $prev $vp $lhsp") if $ctx->{log};
1124 157 100 100     356 unless (is_strval($lhsp) || is_array($lhsp)) {
1125 1         4 push(@$list, $elem);
1126 1         5 next ELEM; # unresolved assignment
1127             }
1128             # substitute: multiple var assignment -> single assigment
1129             #
1130 156 100 100     394 if (is_variable($v) && ($v eq $vp)) {
1131 53 50       146 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v [$prev -> $elem]") if $ctx->{log};
1132 53         104 splice(@$list, $j-1, 1); # remove $prev from list
1133 53         90 $changed = 1;
1134 53         92 push(@$list, $elem);
1135 53         177 next ELEM;
1136             }
1137              
1138             # substitute: multiple array assignment -> single assigment
1139             #
1140 103         254 my ($va, $a) = $ctx->get_indexed_array_var($v);
1141 103 100       279 if (defined $va) {
1142 38 100       154 if ($va eq $vp) {
1143 21         105 my $k = $parser->setexpr('=', $va, $a);
1144 21 50       81 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v ($va $a) [$prev, $elem -> $k]") if $ctx->{log};
1145 21         43 splice(@$list, $j-1, 1); # remove $prev from list
1146 21         42 $res->[$i] = $k;
1147 21         30 $changed = 1;
1148 21         38 push(@$list, $k);
1149 21         70 next ELEM;
1150             }
1151             }
1152             }
1153             # if no variable was found, then substitute new single array elem assigment -> array assignmet
1154             #
1155 57         130 my ($va, $a) = $ctx->get_indexed_array_var($v);
1156 57 100       134 if (defined $va) {
1157 12         38 my $arr = $parser->{strmap}{$a};
1158 12         54 my $keys = $arr->get_keys();
1159 12         25 my $size = scalar @$keys;
1160              
1161             # also allow assignment to existing array ($size > 1)
1162             #
1163 12 100       28 if ($size > 1) {
1164 5 50       23 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va already has elements") if $ctx->{log};
1165             }
1166 12         35 my $k = $parser->setexpr('=', $va, $a);
1167 12 50       72 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va ($a size=$size) [$elem -> $k]") if $ctx->{log};
1168 12         22 $res->[$i] = $k;
1169 12         22 $changed = 1;
1170 12         21 push(@$list, $k);
1171 12         50 next ELEM;
1172             }
1173             }
1174              
1175             # merge previous echo statement with new one
1176             #
1177 72         195 my ($args, $all_str) = _get_echo_arglist($parser, $elem);
1178 72 100       204 if (defined $args) {
1179 21         53 for (my $j = scalar @$list; $j > 0; $j--) {
1180 22         50 my $prev = $list->[$j-1];
1181 22         49 my ($prev_args, $prev_all_str) = _get_echo_arglist($parser, $prev);
1182              
1183 22 100       50 if (!defined $prev_args) {
1184 12         29 next;
1185             }
1186 10         23 my $k;
1187 10 50 33     49 if ($all_str && $prev_all_str) {
1188 10         28 my $val = join('', map { $parser->{strmap}->{$_} } (@$prev_args, @$args));
  20         63  
1189 10         34 my $str = $parser->setstr($val);
1190 10         57 $k = $parser->setstmt(['echo', [$str]]);
1191             } else {
1192 0         0 $k = $parser->setstmt(['echo', [@$prev_args, @$args]]);
1193             }
1194 10 50       28 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: echo [$prev, $elem -> $k]") if $ctx->{log};
1195 10         27 splice(@$list, $j-1, 1); # remove $prev from list
1196 10         28 $res->[$i] = $k;
1197 10         17 $changed = 1;
1198 10         22 push(@$list, $k);
1199 10         32 next ELEM;
1200             }
1201             }
1202 62         171 push(@$list, $elem);
1203             }
1204 113         220 return $changed;
1205             }
1206              
1207             sub set_tainted {
1208 236     236 0 541 my ($ctx, $stmt) = @_;
1209              
1210 236 100       635 if ($ctx->{tainted}) {
1211 98         368 $ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted");
1212             } else {
1213 138         427 $ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted (untainted before)");
1214             }
1215 236 50       13725 if (exists $ctx->{with}{invalidate_tainted_vars}) {
1216 0         0 foreach my $k (keys %{$ctx->{globals}}) {
  0         0  
1217 0 0 0     0 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1218 0         0 $ctx->{globals}{$k} = '#unresolved';
1219             }
1220             }
1221 0         0 foreach my $k (keys %{$ctx->{varmap}{global}}) {
  0         0  
1222 0 0 0     0 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1223 0         0 $ctx->{globals}{$k} = '#unresolved';
1224             }
1225             }
1226             }
1227 236         496 $ctx->{tainted} += 1;
1228 236         570 return;
1229             }
1230              
1231             sub set_globals_unresolved {
1232 10     10 0 27 my ($ctx, $list) = @_;
1233              
1234 10         26 foreach my $k (@$list) {
1235 6 50 33     17 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1236 6 100 100     28 if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne '#unresolved')) {
1237 5 50       37 $ctx->{log}->($ctx, 'set_unresolved', $k, "(global)") if $ctx->{log};
1238 5         16 $ctx->{globals}{$k} = '#unresolved';
1239             }
1240             }
1241             }
1242 10         27 return;
1243             }
1244              
1245             sub set_locals_unresolved {
1246 45     45 0 124 my ($ctx, $list) = @_;
1247              
1248 45         136 foreach my $k (@$list) {
1249 87 100 66     213 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1250 82 100 100     360 if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne '#unresolved')) {
1251 45 50       120 $ctx->{log}->($ctx, 'set_unresolved', $k, "(local)") if $ctx->{log};
1252 45         133 $ctx->{varmap}{$k} = '#unresolved';
1253             }
1254             }
1255             }
1256 45         131 return;
1257             }
1258              
1259             sub set_undefined_globals_unresolved {
1260 12     12 0 34 my ($ctx, $list) = @_;
1261              
1262 12         39 foreach my $k (@$list) {
1263 15 50 33     47 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1264 15 100       41 if (!exists $ctx->{globals}{$k}) {
1265 12 50       34 $ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined global)") if $ctx->{log};
1266 12         41 $ctx->{globals}{$k} = '#unresolved';
1267             }
1268             }
1269             }
1270 12         23 return;
1271             }
1272              
1273             sub set_undefined_locals_unresolved {
1274 96     96 0 315 my ($ctx, $list) = @_;
1275              
1276 96         254 foreach my $k (@$list) {
1277 145 100 66     408 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1278 114 100       387 if (!exists $ctx->{varmap}{$k}) {
1279 63 100       184 if (exists $ctx->{varmap}{global}{$k}) {
1280 1 50       6 if (!exists $ctx->{globals}{$k}) {
1281 1 50       5 $ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined local global)") if $ctx->{log};
1282 1         5 $ctx->{globals}{$k} = '#unresolved';
1283             }
1284             } else {
1285 62 50       161 $ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined local)") if $ctx->{log};
1286 62         223 $ctx->{varmap}{$k} = '#unresolved';
1287             }
1288             }
1289             }
1290             }
1291 96         241 return;
1292             }
1293              
1294             # invalidate all undefined variables so that they do not resolve to '#null'.
1295             #
1296             sub invalidate_undefined_vars {
1297 102     102 0 250 my ($ctx, $info, $type, $stmt) = @_;
1298              
1299 102 100       150 if (keys %{$info->{globals}}) {
  102         397  
1300 12         31 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}}));
  12         69  
1301 12         1189 $ctx->set_undefined_globals_unresolved([keys %{$info->{globals}}]);
  12         100  
1302             }
1303 102 100       203 if (keys %{$info->{vars}}) {
  102         390  
1304 96   66     177 my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}};
  146         755  
  96         283  
1305 96 50       273 if (@vars) {
1306 96         515 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars));
1307 96         7985 $ctx->set_undefined_locals_unresolved(\@vars);
1308             }
1309             }
1310 102         252 return;
1311             }
1312              
1313             # invalidate all variables with dependencies on subsequent calls of same block.
1314             #
1315             sub invalidate_vars {
1316 31     31 0 89 my ($ctx, $info, $type, $stmt) = @_;
1317              
1318 31 100       56 if (keys %{$info->{global_assigns}}) {
  31         152  
1319 3         8 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found global assigns[%s]", join(' ', keys %{$info->{global_assigns}}));
  3         17  
1320 3         141 $ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]);
  3         20  
1321             }
1322 31 100       80 if (keys %{$info->{local_assigns}}) {
  31         103  
1323 28         56 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found local assigns[%s]", join(' ', keys %{$info->{local_assigns}}));
  28         172  
1324 28         1290 $ctx->set_locals_unresolved([keys %{$info->{local_assigns}}]);
  28         234  
1325             }
1326 31 100       64 if (keys %{$info->{unresolved}}) {
  31         135  
1327 18         44 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found unresolved[%s]", join(' ', keys %{$info->{unresolved}}));
  18         91  
1328              
1329             # TODO: is this necessary with set_tainted()?
1330             #
1331 18 100       366 if (keys %{$info->{globals}}) {
  18         107  
1332 2         16 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}}));
  2         22  
1333 2         31 $ctx->set_globals_unresolved([keys %{$info->{globals}}]);
  2         40  
1334             }
1335 18 100       46 if (keys %{$info->{vars}}) {
  18         72  
1336 17   33     36 my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}};
  33         181  
  17         44  
1337 17 50       59 if (@vars) {
1338 17         87 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars));
1339 17         316 $ctx->set_locals_unresolved(\@vars);
1340             }
1341             }
1342             }
1343 31         73 return;
1344             }
1345              
1346             sub update_unresolved {
1347 172     172 0 350 my ($ctx, $ctx2) = @_;
1348              
1349             # copy unresolved status from ctx2 to ctx
1350             #
1351 172         261 foreach my $k (keys %{$ctx2->{globals}}) {
  172         730  
1352 1053 100 100     2032 if (is_variable($k) && !$ctx2->is_superglobal($k)) {
1353 178 100 66     848 if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne $ctx2->{globals}{$k})) {
1354 34 50       125 $ctx->{log}->($ctx, 'set_unresolved', $k, "(global) update from clone") if $ctx->{log};
1355 34         90 $ctx->{globals}{$k} = '#unresolved';
1356             }
1357             }
1358             }
1359 172         379 foreach my $k (keys %{$ctx2->{varmap}}) {
  172         638  
1360 1473 100 100     2508 if (is_variable($k) && !$ctx2->is_superglobal($k)) {
1361 294 100 66     1174 if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne $ctx2->{varmap}{$k})) {
1362 37 50       117 $ctx->{log}->($ctx, 'set_unresolved', $k, "(local) update from clone") if $ctx->{log};
1363 37         115 $ctx->{varmap}{$k} = '#unresolved';
1364             }
1365             }
1366             }
1367 172         404 return;
1368             }
1369              
1370             sub is_superglobal {
1371 6090     6090 0 10564 my ($ctx, $var) = @_;
1372              
1373 6090         19902 return exists $ctx->{superglobal}{$var};
1374             }
1375              
1376             # check if variable is global in current context
1377             #
1378             sub is_global_var {
1379 20     20 0 48 my ($ctx, $var) = @_;
1380 20         50 my ($g) = global_split($var);
1381 20 100       70 if (defined $g) {
1382 10         26 return $g; # converted $GLOBALS['var']
1383             }
1384 10 50       45 if (exists $ctx->{varmap}{global}{$var}) {
1385 0         0 return $var; # 'global $var;'
1386             }
1387 10 50       32 unless ($ctx->{infunction}) {
1388 0         0 return $var; # outside of func all vars are global
1389             }
1390 10         21 return;
1391             }
1392              
1393             # check if variable is instance var
1394             #
1395             sub is_instvar {
1396 1856     1856 0 3252 my ($var) = @_;
1397 1856         4148 my ($inst, $instvar) = inst_split($var);
1398 1856 100       3825 if (defined $inst) {
1399 46         189 return ($inst =~ /^#inst\d+$/);
1400             }
1401 1810         4265 return 0;
1402             }
1403              
1404             sub is_inst_or_classvar {
1405 0     0 0 0 my ($var) = @_;
1406 0         0 my ($inst, $instvar) = inst_split($var);
1407 0 0       0 if (defined $inst) {
1408 0         0 return 1;
1409             }
1410 0         0 return 0;
1411             }
1412              
1413             sub setvar {
1414 1160     1160 1 2328 my ($ctx, $var, $val, $in_block) = @_;
1415 1160         1701 my $wasset = 0;
1416              
1417             # set class vars when classes are initialized
1418             #
1419 1160 100 100     3693 if (!$ctx->{infunction} && $ctx->{class_scope}) {
1420 9         28 my ($inst, $instvar) = inst_split($var);
1421 9 50 33     32 if (!defined $inst || ($inst ne 'GLOBALS')) {
1422 9         31 $var = inst_var($ctx->{class_scope}, $var);
1423             }
1424             }
1425 1160         2640 my ($global) = global_split($var);
1426 1160         2525 my ($inst, $instvar) = inst_split($var);
1427 1160 100       2568 $inst = lc($inst) if defined $inst;
1428              
1429 1160 100       2399 if ($ctx->is_superglobal($var)) {
1430 14         41 $global = $var;
1431             }
1432 1160 100 66     7062 if (defined $global) {
    100          
    100          
    100          
    100          
1433 34 50       123 if (exists $ctx->{globals}) {
1434 34         87 $ctx->{globals}{$global} = $val;
1435 34         57 $wasset = 1;
1436             }
1437             } elsif (exists $ctx->{varmap}{global}{$var}) {
1438 10 50       42 if (exists $ctx->{globals}) {
1439 10         27 $ctx->{globals}{$var} = $val;
1440 10         28 $var = global_var($var);
1441 10         22 $wasset = 1;
1442             }
1443             } elsif (exists $ctx->{varmap}{ref}{$var}) {
1444 6         13 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  6         23  
1445 6         21 $ctx2->setvar($var1, $val, $in_block);
1446             } elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) {
1447 4 100 66     19 if ($ctx->{infunction} && $ctx->{incall}) {
1448 3         8 $ctx->{varmap}{static}{$ctx->{infunction}}{$var} = $val;
1449 3         4 $wasset = 1;
1450             } else {
1451 1         13 $ctx->{warn}->($ctx, 'setvar', $var, "static not in call");
1452             }
1453             } elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) {
1454 27         66 $ctx->{varmap}{inst}{$inst}{$instvar} = $val;
1455 27         51 $wasset = 1;
1456             } else {
1457 1079         3032 $ctx->{varmap}{$var} = $val;
1458 1079         1662 $wasset = 1;
1459             }
1460 1160 100       2165 if ($wasset) {
1461 1153 100       2065 if (!$in_block) {
1462 192 50       513 $ctx->{log}->($ctx, 'setvar', $var, "= $val [TRACK]") if $ctx->{log};
1463 192         534 $ctx->track_assignment($var, $val);
1464             } else {
1465 961 50       1936 $ctx->{log}->($ctx, 'setvar', $var, "= $val") if $ctx->{log};
1466             }
1467             }
1468 1160         2111 return;
1469             }
1470              
1471             sub add_namespace {
1472 896     896 0 1652 my ($ctx, $name) = @_;
1473              
1474 896 100       2832 if ($name =~ /^\\(.*)$/) {
    100          
1475 3         10 $name = $1; # remove absolute
1476             } elsif ($ctx->{namespace}) {
1477 7         41 $name = ns_name(lc($ctx->{namespace}), $name); # relative
1478             }
1479 896         2018 return $name;
1480             }
1481              
1482             # function and class names are case-insensitive
1483             # https://www.php.net/manual/en/functions.user-defined.php
1484             #
1485             sub registerfun {
1486 296     296 1 599 my ($ctx, $name, $f) = @_;
1487              
1488             # functions are always global, but locally defined functions
1489             # are temporarily registered in the local varmap if a function
1490             # is simplified (see: subglobctx).
1491             #
1492 296 100       583 if (exists $ctx->{class_scope}) {
1493 62         222 $name = method_name($ctx->{class_scope}, lc($name));
1494             } else {
1495 234         431 $name = lc($name); # functions are not case-sensitive
1496             }
1497 296 100       684 if ($ctx->{namespace}) {
1498 6         27 $name = ns_name(lc($ctx->{namespace}), $name);
1499             }
1500 296 100       565 if ($ctx->{infunction}) {
1501 9         27 $ctx->{varmap}{fun}{$name} = $f;
1502             } else {
1503 287         722 $ctx->{globals}{fun}{$name} = $f;
1504             }
1505 296 50       610 $ctx->{log}->($ctx, 'registerfun', $name, "$f") if $ctx->{log};
1506 296         787 return;
1507             }
1508              
1509             # lookup method name by instance name
1510             #
1511             sub lookup_method_name {
1512 1217     1217 0 2033 my ($ctx, $name) = @_;
1513              
1514 1217         1745 $name = lc($name); # functions are not case-sensitive
1515              
1516 1217         3120 my ($inst, $prop) = method_split($name);
1517              
1518 1217 100       2648 if (defined $inst) {
1519 196 100 100     806 if (exists $ctx->{varmap}{inst}{$inst} && exists $ctx->{varmap}{inst}{$inst}{$prop}) {
1520 60         121 my $method = $ctx->{varmap}{inst}{$inst}{$prop}; # lookup instance function
1521 60         166 return $method;
1522             }
1523             }
1524 1157         3257 return;
1525             }
1526              
1527             sub getfun {
1528 1157     1157 1 2252 my ($ctx, $name) = @_;
1529              
1530 1157         1997 $name = lc($name); # functions are not case-sensitive
1531              
1532 1157 100       2551 if (my $method = $ctx->lookup_method_name($name)) {
    100          
1533 30         54 $name = $method;
1534             } elsif (exists $ctx->{class_scope}) {
1535 59         170 my $method = lc(method_name($ctx->{class_scope}, $name));
1536 59 100       211 if (exists $ctx->{globals}{fun}{$method}) {
    50          
1537 31         278 return $ctx->{globals}{fun}{$method};
1538             } elsif (exists $ctx->{varmap}{fun}{$method}) {
1539 0         0 return $ctx->{varmap}{fun}{$method};
1540             }
1541             }
1542 1126 100       3454 if (exists $ctx->{globals}{fun}{$name}) {
    100          
1543 341         1808 return $ctx->{globals}{fun}{$name};
1544             } elsif (exists $ctx->{varmap}{fun}{$name}) {
1545 4         38 return $ctx->{varmap}{fun}{$name};
1546             }
1547 781         1369 return;
1548             }
1549              
1550             sub registerclass {
1551 68     68 1 151 my ($ctx, $name, $c) = @_;
1552              
1553 68         128 $name = lc($name);
1554              
1555 68 100       145 if ($ctx->{namespace}) {
1556 1         8 $name = ns_name(lc($ctx->{namespace}), $name);
1557             }
1558 68 100       141 if ($ctx->{infunction}) {
1559 2         15 $ctx->{varmap}{class}{$name} = $c;
1560             } else {
1561 66         173 $ctx->{globals}{class}{$name} = $c;
1562             }
1563 68 50       138 $ctx->{log}->($ctx, 'registerclass', $name, "$c") if $ctx->{log};
1564 68         141 return;
1565             }
1566              
1567             sub getclass {
1568 136     136 1 274 my ($ctx, $name) = @_;
1569              
1570 136         211 $name = lc($name);
1571              
1572 136 100       339 if (exists $ctx->{globals}{class}{$name}) {
    100          
1573 126         362 return $ctx->{globals}{class}{$name};
1574             } elsif (exists $ctx->{varmap}{class}{$name}) {
1575 1         14 return $ctx->{varmap}{class}{$name};
1576             }
1577 9         23 return;
1578             }
1579              
1580             sub getvar {
1581 2031     2031 1 3949 my ($ctx, $var, $quiet) = @_;
1582              
1583             # variable names are case sensitive
1584             #
1585 2031         4855 my ($global) = global_split($var);
1586 2031         4460 my ($inst, $instvar) = inst_split($var);
1587 2031 100       4253 $inst = lc($inst) if defined $inst;
1588              
1589 2031 100       4516 if ($ctx->is_superglobal($var)) {
1590 273         538 $global = $var;
1591             }
1592 2031 100 66     11749 if (defined $global) {
    100          
    100          
    100          
    100          
    100          
1593 331 50       800 if (exists $ctx->{globals}) {
1594 331 100       776 if (exists $ctx->{globals}{$global}) {
1595 43         110 my $val = $ctx->{globals}{$global};
1596 43         112 return $val;
1597             }
1598 288 100       607 if (!$ctx->is_superglobal($var)) {
1599 31 50 66     151 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1600 31 100       92 unless ($ctx->{tainted}) {
1601 5 50       27 $ctx->{warn}->($ctx, 'getvar', $var, "global not found -> #null") unless $quiet;
1602 5         318 return '#null';
1603             }
1604             }
1605             }
1606 283 100       1102 $ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet;
1607             }
1608             } elsif (exists $ctx->{varmap}{global}{$var}) {
1609 14 50       47 if (exists $ctx->{globals}) {
1610 14 100       42 if (exists $ctx->{globals}{$var}) {
1611 9         19 my $val = $ctx->{globals}{$var};
1612 9         26 return $val;
1613             }
1614 5 50       32 $ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet;
1615             }
1616             } elsif (exists $ctx->{varmap}{ref}{$var}) {
1617 3         13 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  3         17  
1618 3         29 return $ctx2->getvar($var1, $quiet);
1619             } elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) {
1620 13 100 66     57 if ($ctx->{infunction} && $ctx->{incall}) {
1621 9         20 my $val = $ctx->{varmap}{static}{$ctx->{infunction}}{$var};
1622 9 100       20 if (!defined $val) {
1623 1         3 return '#null';
1624             }
1625 8         20 return $val;
1626             }
1627 4 50       17 $ctx->{warn}->($ctx, 'getvar', $var, "static not in call") unless $quiet;
1628             } elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) {
1629 45 100 33     128 if (exists $ctx->{varmap}{inst}{$inst}{$instvar}) {
    50          
1630 40         86 my $val = $ctx->{varmap}{inst}{$inst}{$instvar};
1631 40 100       106 if (!defined $val) {
1632 5         11 return '#null';
1633             }
1634 35         82 return $val;
1635             } elsif (exists $ctx->{class_scope} && $ctx->{varmap}{inst}{$ctx->{class_scope}}{$instvar}) {
1636 0 0       0 $ctx->{log}->($ctx, 'getvar', $var, "class $ctx->{class_scope}") if $ctx->{log};
1637 0         0 my $val = $ctx->{varmap}{inst}{$ctx->{class_scope}}{$instvar};
1638 0 0       0 if (!defined $val) {
1639 0         0 return '#null';
1640             }
1641 0         0 return $val;
1642             }
1643 5 50 33     35 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1644 5 100       15 if (!$ctx->{tainted}) {
1645 3 50       20 $ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found -> #null") unless $quiet;
1646 3         151 return '#null';
1647             }
1648             }
1649 2 50       19 $ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found") unless $quiet;
1650             } elsif (exists $ctx->{varmap}{$var}) {
1651 1387         2811 my $val = $ctx->{varmap}{$var};
1652 1387         3174 return $val;
1653             } else {
1654             # if the program is executed and the variable ist not a superglobal,
1655             # then the default val for undefined vars is null:
1656             # https://php.net/manual/en/language.types.null.php
1657             #
1658             # - with E_NOTICE php warn 'Undefined Variable'
1659             # - in arithmetic operations an undefined var is 0
1660             #
1661 238 50 66     1108 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1662 238 100       638 if (!$ctx->{tainted}) {
1663 149 100       673 $ctx->{warn}->($ctx, 'getvar', $var, "not found -> #null") unless $quiet;
1664 149         14859 return '#null';
1665             }
1666             }
1667 89 100       431 $ctx->{warn}->($ctx, 'getvar', $var, "not found") unless $quiet;
1668             }
1669 383         32692 return;
1670             }
1671              
1672             # remove local variable assignments from block if variable is otherwise unused
1673             #
1674             sub eliminate_local_assigments {
1675 207     207 0 539 my ($ctx, $info, $code) = @_;
1676 207         440 my $parser = $ctx->{parser};
1677              
1678 207 100       806 $info->{remaining_locals} = {} unless exists $info->{remaining_locals};
1679 207 100       574 $info->{remaining_statics} = {} unless exists $info->{remaining_statics};
1680              
1681             my $out = $parser->map_stmt($code, sub {
1682 845     845   1473 my ($s) = @_;
1683              
1684 845 100       3173 if ($s =~ /^#expr\d+$/) {
    100          
    100          
    100          
1685             # $var =
1686 111         169 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  111         379  
1687 111 100 100     496 if (($op eq '=') && is_variable($v1)) {
    100 100        
1688 97         314 my ($inst, $instvar) = inst_split($v1);
1689              
1690             # note: class functions are inititialized without {inst}-map,
1691             # so don't check for class-var existence here.
1692             #
1693 97 50 100     344 if ($ctx->is_superglobal($v1)) {
    100 33        
    100 66        
    100 33        
    100          
    100          
    50          
1694 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep superglobal $v1") if $ctx->{log};
1695             } elsif (exists $ctx->{varmap}{ref}{$v1}) {
1696 3 50       12 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep ref var $v1") if $ctx->{log};
1697 3         8 $info->{remaining_locals}{$v1} = 1; # XXX
1698             } elsif (exists $ctx->{varmap}{global}{$v1}) {
1699 4         12 my $vv1 = global_var($v1); # convert to explicit global
1700 4         17 my $vv2 = $ctx->eliminate_local_assigments($info, $v2);
1701 4 50       23 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: convert global var $v1=$v2 -> $vv1=$vv2") if $ctx->{log};
1702 4         11 $info->{global_assigns}{$v1} = 1;
1703 4         19 my $k = $parser->setexpr('=', $vv1, $vv2);
1704 4         14 return $k;
1705             } elsif (defined $inst && ($inst eq 'GLOBALS')) {
1706 6 50       45 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep global var $v1") if $ctx->{log};
1707             } elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v1}) {
1708 3 50       8 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static func var $v1") if $ctx->{log};
1709 3         9 $info->{remaining_statics}{$v1} = 1;
1710             } elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) {
1711 12 50       30 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static class var $v1") if $ctx->{log};
1712 12         33 $info->{remaining_statics}{$v1} = 1;
1713 12         28 delete $info->{local_assigns}{$v1};
1714             } elsif (exists $info->{local_assigns}{$v1}) {
1715 69 100 66     235 if (exists $info->{noassigns}{$v1}) {
    100          
    100          
    100          
1716 3 50       15 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining local var $v1") if $ctx->{log};
1717 3         11 $info->{remaining_locals}{$v1} = 1;
1718             } elsif (is_strval($v2)) {
1719 13 50       44 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log};
1720 13         43 my $empty = $parser->setblk('flat', []);
1721 13         45 return $empty;
1722             } elsif (is_array($v2) && PHP::Decode::Op::array_is_const($parser, $v2)) {
1723 50 50       144 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log};
1724 50         148 my $empty = $parser->setblk('flat', []);
1725 50         170 return $empty;
1726             } elsif (is_variable($v2)) {
1727 2 50       7 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log};
1728 2         6 my $empty = $parser->setblk('flat', []);
1729 2         7 return $empty;
1730             } else {
1731 1         17 my $vv2 = $ctx->eliminate_local_assigments($info, $v2);
1732 1 50       9 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> $vv2") if $ctx->{log};
1733 1         5 return $vv2;
1734             }
1735             } else {
1736 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining unknown var $v1") if $ctx->{log};
1737 0         0 $info->{remaining_locals}{$v1} = 1;
1738             }
1739             } elsif (($op eq '=') && ($v1 =~ /^#elem\d+$/)) {
1740 3         11 my $elemlist = _get_elemlist($parser, $v1);
1741 3         7 my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}};
  3         31  
1742 3 50       17 if ($v =~ /^\$GLOBALS$/) {
    100          
    50          
    50          
1743 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep global elem $v1") if $ctx->{log};
1744             } elsif ($ctx->is_superglobal($v)) {
1745 1 50       6 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep superglobal elem $v1") if $ctx->{log};
1746             } elsif (exists $info->{noassigns}{$v}) {
1747 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining local elem $v1") if $ctx->{log};
1748 0         0 $info->{remaining_locals}{$v} = 1;
1749             } elsif (is_variable($v)) {
1750 2 50       13 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local elem $v1=$v2 -> []") if $ctx->{log};
1751 2         10 my $empty = $parser->setblk('flat', []);
1752 2         10 return $empty;
1753             } else {
1754 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining unknown elem $v1") if $ctx->{log};
1755 0         0 $info->{remaining_locals}{$v} = 1;
1756             }
1757             }
1758             } elsif ($s =~ /^#obj\d+$/) {
1759 4         25 my ($o, $m) = @{$parser->{strmap}->{$s}};
  4         13  
1760 4 50       25 if (lc($o) eq '$this') {
1761 4         14 $info->{remaining_statics}{$s} = 1; # XXX
1762             } else {
1763 0         0 $info->{remaining_locals}{$s} = 1;
1764             }
1765 4 50       17 $ctx->{log}->($ctx, 'eliminate', $code, "keep obj $s") if $ctx->{log};
1766             } elsif ($s =~ /^#stmt\d+$/) {
1767 180         447 my $cmd = $parser->{strmap}->{$s}->[0];
1768 180 100       565 if ($cmd eq 'static') {
    100          
1769 4         7 my $arglist = $parser->{strmap}->{$s}->[1];
1770 4         10 foreach my $v (@$arglist) {
1771 4 100       9 if ($v =~ /^#expr\d+$/) {
1772 2 50       10 $ctx->{log}->($ctx, 'eliminate', $code, "$v from static assignment $s") if $ctx->{log};
1773             } else {
1774 2 50       9 $ctx->{log}->($ctx, 'eliminate', $code, "$v from static definition $s") if $ctx->{log};
1775             }
1776             }
1777 4         14 my $empty = $parser->setblk('flat', []);
1778 4         12 return $empty;
1779             } elsif ($cmd eq 'global') {
1780 4         10 my $arglist = $parser->{strmap}->{$s}->[1];
1781 4         14 return $s; # keep variables in global statement as is
1782             }
1783             } elsif (is_variable($s)) {
1784 57         155 my ($inst, $instvar) = inst_split($s);
1785              
1786 57 100 100     144 if ($ctx->is_superglobal($s)) {
    100 33        
    50 66        
    100 33        
    100          
    100          
    100          
1787 10 50       32 $ctx->{log}->($ctx, 'eliminate', $code, "keep superglobal $s") if $ctx->{log};
1788             } elsif (exists $ctx->{varmap}{ref}{$s}) {
1789 3 50       8 $ctx->{log}->($ctx, 'eliminate', $code, "keep ref var $s") if $ctx->{log};
1790 3         6 $info->{remaining_locals}{$s} = 1; # XXX
1791             } elsif (exists $ctx->{varmap}{global}{$s}) {
1792 0         0 my $v = global_var($s); # convert to explicit global
1793 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "convert global var $s -> $v") if $ctx->{log};
1794 0         0 return $v;
1795             } elsif (defined $inst && ($inst eq 'GLOBALS')) {
1796 9 50       24 $ctx->{log}->($ctx, 'eliminate', $code, "keep global var $s") if $ctx->{log};
1797             } elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$s}) {
1798 3 50       9 $ctx->{log}->($ctx, 'eliminate', $code, "is static func var $s") if $ctx->{log};
1799 3         16 $info->{remaining_statics}{$s} = 1;
1800             } elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) {
1801 16 50       41 $ctx->{log}->($ctx, 'eliminate', $code, "keep static class var $s") if $ctx->{log};
1802 16         35 $info->{remaining_statics}{$s} = 1;
1803             } elsif (exists $info->{vars}{$s}) {
1804 12 50       33 if (lc($s) eq '$this') {
1805 0 0       0 $ctx->{log}->($ctx, 'eliminate', $code, "remaining local static var $s") if $ctx->{log};
1806 0         0 $info->{remaining_statics}{$s} = 1;
1807             } else {
1808 12 50       26 $ctx->{log}->($ctx, 'eliminate', $code, "remaining local var $s") if $ctx->{log};
1809 12         22 $info->{remaining_locals}{$s} = 1;
1810             }
1811             } else {
1812 4 50       13 $ctx->{log}->($ctx, 'eliminate', $code, "remaining unknown var $s") if $ctx->{log};
1813 4         11 $info->{remaining_locals}{$s} = 1;
1814             }
1815             }
1816 765         1507 return;
1817 207         4765 });
1818              
1819 207 100       6925 if ($out ne $code) {
1820 72 50       222 $ctx->{log}->($ctx, 'eliminate', $code, "changed -> $out") if $ctx->{log};
1821             }
1822 207         514 return $out;
1823             }
1824              
1825             # convert assignment followed directly by return to single return
1826             #
1827             sub convert_assign_return {
1828 512     512 0 880 my ($ctx, $code) = @_;
1829 512         825 my $parser = $ctx->{parser};
1830              
1831             my $out = $parser->map_stmt($code, sub {
1832 1818     1818   2877 my ($s) = @_;
1833              
1834 1818 100       3875 if ($s =~ /^#blk\d+$/) {
1835 212         327 my ($type, $a) = @{$parser->{strmap}->{$s}};
  212         546  
1836 212         358 my @args = ();
1837 212         309 my $arg_changed = 0;
1838              
1839 212         544 for (my $i=0; $i < scalar @$a; $i++) {
1840 311         565 my $k = $a->[$i];
1841 311 100       643 if (($i+1) < scalar @$a) {
1842 102         236 my $k2 = $a->[$i+1];
1843 102         150 my $var;
1844 102 100       311 if ($k2 =~ /^#stmt\d+$/) {
1845 82         159 my $cmd2 = $parser->{strmap}->{$k2}->[0];
1846 82 100       209 if ($cmd2 eq 'return') {
1847 74         155 $var = $parser->{strmap}->{$k2}->[1];
1848             }
1849             }
1850 102 100 100     404 if (defined $var && ($k =~ /^#expr\d+$/)) {
1851 67         105 my ($op, $v1, $v2) = @{$parser->{strmap}->{$k}};
  67         207  
1852 67 100 66     326 if (($op eq '=') && ($var eq $v1)) {
1853 2         10 my $r = $parser->setstmt(['return', $v2]);
1854 2 50       15 $ctx->{log}->($ctx, 'convert', $code, "assign_return $k+$k2 -> $r") if $ctx->{log};
1855 2         5 push(@args, $r);
1856 2         5 $arg_changed = 1;
1857 2         5 $i++;
1858 2         6 next;
1859             }
1860             }
1861             }
1862 309         706 my $v = $ctx->convert_assign_return($k);
1863 309 50       648 if ($v ne $k) {
1864 0 0       0 unless ($parser->is_empty_block($v)) {
1865 0         0 push(@args, $v);
1866             }
1867 0         0 $arg_changed = 1;
1868             } else {
1869 309         945 push(@args, $v);
1870             }
1871             }
1872 212 100       484 if ($arg_changed) {
1873 2         10 $s = $parser->setblk($type, \@args);
1874 2         5 return $s;
1875             }
1876             }
1877 1816         3295 return;
1878 512         3913 });
1879              
1880 512 100       5135 if ($out ne $code) {
1881 2 50       11 $ctx->{log}->($ctx, 'convert', $code, "assign_return changed -> $out") if $ctx->{log};
1882             }
1883 512         1030 return $out;
1884             }
1885              
1886             # convert globals so that they match toplevel or another function
1887             #
1888             sub convert_globals_to_caller_ctx {
1889 297     297 0 652 my ($ctx, $info, $code, $cctx) = @_;
1890 297         496 my $parser = $ctx->{parser};
1891              
1892 297 100       410 unless (scalar keys %{$info->{global_assigns}} > 0) {
  297         885  
1893 286         652 return $code; # no global exists
1894             }
1895              
1896             my $out = $parser->map_stmt($code, sub {
1897 68     68   119 my ($s) = @_;
1898              
1899 68 100       188 if ($s =~ /^#stmt\d+$/) {
    100          
1900 4         11 my $cmd = $parser->{strmap}->{$s}->[0];
1901 4 50       25 if ($cmd eq 'global') {
1902 4         12 my $arglist = $parser->{strmap}->{$s}->[1];
1903 4 50       13 $ctx->{log}->($ctx, 'convert', $code, "global $s -> drop global stmt") if $ctx->{log};
1904 4         16 my $empty = $parser->setblk('flat', []);
1905 4         14 return $empty;
1906             }
1907             } elsif (is_variable($s)) {
1908 16         70 my $g = $ctx->is_global_var($s);
1909 16         56 my ($inst, $instvar) = inst_split($s);
1910              
1911 16 50 66     88 if (defined $inst && ($inst ne 'GLOBALS')) {
    100          
1912 0 0       0 if ($inst =~ /^#inst\d+$/) {
1913 0 0       0 $ctx->{log}->($ctx, 'convert', $code, "global $s -> is instvar") if $ctx->{log};
1914             } else {
1915 0 0       0 $ctx->{log}->($ctx, 'convert', $code, "global $s -> is classvar") if $ctx->{log};
1916             }
1917             } elsif (defined $g) {
1918 10 50       32 if ($cctx->{infunction}) {
1919 0         0 my $v = global_var($g); # keep global annotation
1920 0         0 return $v;
1921             } else {
1922             # caller is toplevel
1923 10         29 return $g;
1924             }
1925             }
1926             }
1927 54         106 return;
1928 11         100 });
1929              
1930 11 100       134 if ($out ne $code) {
1931 10 50       29 $ctx->{log}->($ctx, 'convert', $code, "global changed -> $out") if $ctx->{log};
1932             }
1933 11         27 return $out;
1934             }
1935              
1936             # convert global vars to explicit globals
1937             #
1938             sub globlify_local_vars {
1939 4     4 0 9 my ($ctx, $info, $code) = @_;
1940 4         10 my $parser = $ctx->{parser};
1941              
1942             my $out = $parser->map_stmt($code, sub {
1943 16     16   27 my ($s) = @_;
1944              
1945 16 100       36 if (is_variable($s)) {
1946 5         20 my ($inst, $instvar) = inst_split($s);
1947              
1948 5 50 0     21 if ($ctx->is_superglobal($s)) {
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
1949 5 50       27 $ctx->{log}->($ctx, 'globlify', $code, "keep superglobal $s") if $ctx->{log};
1950             } elsif (exists $ctx->{varmap}{ref}{$s}) {
1951 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "keep ref var $s") if $ctx->{log};
1952             } elsif (exists $ctx->{varmap}{global}{$s}) {
1953 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "keep global var $s") if $ctx->{log};
1954             } elsif (defined $inst && ($inst eq 'GLOBALS')) {
1955 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "keep global var $s") if $ctx->{log};
1956             } elsif ($ctx->{infunction} && exists $ctx->{varmap}{static}{$ctx->{infunction}}{$s}) {
1957 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "keep static func var $s") if $ctx->{log};
1958             } elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) {
1959 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "keep static class var $s") if $ctx->{log};
1960             } elsif (exists $info->{vars}{$s}) {
1961 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "remaining local var $s") if $ctx->{log};
1962 0         0 my $v = global_var($s);
1963 0         0 return $v;
1964             }
1965             }
1966 16         33 return;
1967 4         45 });
1968              
1969 4 50       69 if ($out ne $code) {
1970 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "changed -> $out") if $ctx->{log};
1971             }
1972 4         9 return $out;
1973             }
1974              
1975             sub _remove_final_statement {
1976 127     127   294 my ($parser, $pattern, $code) = @_;
1977 127         206 my @seq = ();
1978 127         192 my @out = ();
1979 127         196 my $changed = 0;
1980              
1981 127         398 $parser->flatten_block($code, \@seq);
1982              
1983 127         297 foreach my $s (@seq) {
1984 142 100       470 if ($s =~ /^#stmt\d+$/) {
1985 129         259 my $cmd = $parser->{strmap}->{$s}->[0];
1986 129 100       802 if ($cmd =~ /^$pattern$/) {
1987 127         267 $changed = 1;
1988 127         314 next;
1989             }
1990             }
1991 15         34 push(@out, $s);
1992             }
1993 127 50       298 if ($changed) {
1994 127         362 return _flat_block_or_single($parser, \@out);
1995             }
1996 0         0 return $code;
1997             }
1998              
1999             # can_inline is called for the callee context, and the final return
2000             # statement is already removed (if function returns a value).
2001             #
2002             sub can_inline {
2003 249     249 0 477 my ($ctx, $code) = @_;
2004 249         388 my $parser = $ctx->{parser};
2005 249         361 my $allow = 1;
2006              
2007             my $out = $parser->map_stmt($code, sub {
2008 317     317   520 my ($s) = @_;
2009 317 100       676 return $s unless $allow;
2010              
2011 313 100       1651 if ($s =~ /^#stmt\d+$/) {
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    50          
2012 38         106 my $cmd = $parser->{strmap}->{$s}->[0];
2013 38 100       110 if ($cmd eq 'echo') {
    50          
    100          
    50          
2014 33         62 my $arglist = $parser->{strmap}->{$s}->[1];
2015 33         57 foreach my $a (@$arglist) {
2016 33 50       83 unless ($ctx->can_inline($a)) {
2017 0         0 $allow = 0;
2018 0         0 last;
2019             }
2020             }
2021 33         84 return $s;
2022             } elsif ($cmd eq 'print') {
2023 0         0 my $arg = $parser->{strmap}->{$s}->[1];
2024 0 0       0 if ($ctx->can_inline($arg)) {
2025 0         0 $allow = 0;
2026             }
2027 0         0 return $s;
2028             } elsif ($cmd eq 'global') {
2029 4         14 return $s;
2030             } elsif ($cmd eq 'return') {
2031 0 0       0 $ctx->{log}->($ctx, 'inline', $code, "detected remaining return $s") if $ctx->{log};
2032             } else {
2033 1         4 return; # check other statements
2034             }
2035             } elsif ($s =~ /^#blk\d+$/) {
2036 165         406 return; # check block elements
2037             } elsif ($s =~ /^#expr\d+$/) {
2038 14         24 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  14         40  
2039              
2040 14 50       37 if ($op ne '$') { # keep varvar
2041 14 50       33 if (defined $v1) {
2042 14 100       45 unless ($ctx->can_inline($v1)) {
2043 1         4 $allow = 0;
2044             }
2045             }
2046 14 100 66     63 if ($allow && defined $v2) {
2047 13 50       33 unless ($ctx->can_inline($v2)) {
2048 0         0 $allow = 0;
2049             }
2050             }
2051 14         37 return $s;
2052             }
2053             } elsif ($s =~ /^#elem\d+$/) {
2054 6         16 my ($v, $i) = @{$parser->{strmap}->{$s}};
  6         18  
2055              
2056 6 50       19 unless ($ctx->can_inline($v)) {
2057 0         0 $allow = 0;
2058             }
2059 6 50 33     25 if ($allow && defined $i) {
2060 6 50       16 unless ($ctx->can_inline($i)) {
2061 0         0 $allow = 0;
2062             }
2063             }
2064 6         17 return $s;
2065             } elsif ($s =~ /^#call\d+$/) {
2066 13         21 my ($name, $arglist) = @{$parser->{strmap}->{$s}};
  13         49  
2067 13         43 my ($inst, $prop) = method_split($name);
2068 13 0 66     66 if (defined $inst || is_symbol($name) || is_strval($name) || ($name =~ /^#fun\d+$/)) {
      33        
      33        
2069 13 50       68 unless ($name =~ /^(eval|create_function)$/i) {
2070 13         23 my $can = 1;
2071 13         25 my $arglist = $parser->{strmap}->{$s}->[1];
2072 13         25 foreach my $a (@$arglist) {
2073 4 50       11 unless ($ctx->can_inline($a)) {
2074 0         0 $can = 0;
2075 0         0 last;
2076             }
2077             }
2078 13 50       41 if ($can) {
2079 13 50       54 $ctx->{log}->($ctx, 'inline', $code, "$s [$name] is allowed func") if $ctx->{log};
2080 13         47 return $s;
2081             }
2082             }
2083             }
2084             } elsif ($s =~ /^#fun\d+$/) {
2085 5         12 return $s;
2086             } elsif ($s =~ /^#class\d+$/) {
2087 0         0 return $s;
2088             } elsif (is_strval($s)) {
2089 53 50       173 $ctx->{log}->($ctx, 'inline', $code, "$s is strval") if $ctx->{log};
2090 53         153 return $s;
2091             } elsif (is_array($s)) {
2092 0 0       0 if (PHP::Decode::Op::array_is_const($parser, $s)) {
2093 0 0       0 $ctx->{log}->($ctx, 'inline', $code, "$s is const array") if $ctx->{log};
2094 0         0 return $s;
2095             }
2096             } elsif (is_variable($s)) {
2097 19         52 my ($inst, $instvar) = inst_split($s);
2098              
2099 19 100 66     60 if ($ctx->is_superglobal($s)) {
    50 66        
    100          
2100 7 50       23 $ctx->{log}->($ctx, 'inline', $code, "$s is superglobal") if $ctx->{log};
2101 7         30 return $s;
2102             } elsif (defined $inst && ($inst ne 'GLOBALS')) {
2103 0 0       0 $ctx->{log}->($ctx, 'inline', $code, "$s is global") if $ctx->{log};
2104 0         0 return $s;
2105             } elsif (defined $inst && !($inst =~ /^#inst\d+$/)) {
2106 10 50       29 $ctx->{log}->($ctx, 'inline', $code, "$s is classvar") if $ctx->{log};
2107 10         31 return $s;
2108             }
2109             }
2110 2         14 $ctx->{warn}->($ctx, 'inline', $code, "disallow stmt $s");
2111 2         90 $allow = 0;
2112 2         7 return;
2113 249         1723 });
2114 249         4156 return $allow;
2115             }
2116              
2117             # can_inline_eval is called for the caller context, and the final return
2118             # statement is already removed (if function returns a value).
2119             #
2120             sub can_inline_eval {
2121 45     45 0 109 my ($ctx, $code) = @_;
2122 45         77 my $parser = $ctx->{parser};
2123 45         70 my $allow = 1;
2124              
2125             my $out = $parser->map_stmt($code, sub {
2126 52     52   101 my ($s) = @_;
2127 52 50       135 return $s unless $allow;
2128              
2129 52 100       340 if ($s =~ /^#stmt\d+$/) {
    100          
    100          
    50          
    100          
    50          
    50          
2130 11         28 my $cmd = $parser->{strmap}->{$s}->[0];
2131 11 100       51 if ($cmd eq 'echo') {
    50          
    50          
    50          
2132 9         29 return $s;
2133             } elsif ($cmd eq 'print') {
2134 0         0 return $s;
2135             } elsif ($cmd eq 'return') {
2136 0 0       0 $ctx->{log}->($ctx, 'inline', $code, "detected remaining return $s") if $ctx->{log};
2137             } elsif ($cmd =~ /^(if|while|do|for|foreach|switch)$/) {
2138             #return; # check other statements
2139 2         6 return $s;
2140             }
2141             } elsif ($s =~ /^#blk\d+$/) {
2142 11         26 return; # check block elements
2143             } elsif ($s =~ /^#expr\d+$/) {
2144             # $var =
2145 5         33 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  5         22  
2146 5 50       16 if ($op eq '=') {
2147 5 50       16 if (is_strval($v2)) {
2148 5         10 return $s;
2149             }
2150             }
2151             } elsif ($s =~ /^#call\d+$/) {
2152             # call without eval can not generate 'return '
2153 0         0 my ($_name, $_arglist) = @{$parser->{strmap}->{$s}};
  0         0  
2154 0 0       0 if (!PHP::Decode::Func::func_may_return_string($_name)) {
2155 0         0 return $s;
2156             }
2157             } elsif ($s =~ /^#fun\d+$/) {
2158 6         20 return $s;
2159             } elsif ($s =~ /^#class\d+$/) {
2160 0         0 return $s;
2161             } elsif (is_strval($s)) {
2162 19         49 return $s;
2163             }
2164 0         0 $ctx->{warn}->($ctx, 'inline', $code, "eval disallow stmt $s");
2165 0         0 $allow = 0;
2166 0         0 return;
2167 45         334 });
2168 45         521 return $allow;
2169             }
2170              
2171             # check if function body might return
2172             #
2173             sub _can_return {
2174 203     203   401 my ($info) = @_;
2175              
2176 203 50 66     804 if (exists $info->{returns} || exists $info->{calls}{'eval'} || exists $info->{calls}{'create_function'}) {
      33        
2177 130         380 return 1;
2178             }
2179 73         205 return 0;
2180             }
2181              
2182             sub _find_unresolved_param {
2183 182     182   392 my ($info, $param) = @_;
2184 182         316 my $param_found = 0;
2185              
2186 182         504 for (my $i=0; $i < scalar @$param; $i++) {
2187 122 100       362 if ($param->[$i] =~ /^#ref\d+$/) {
2188 3         16 $param_found = $param->[$i];
2189             }
2190 122 50       399 if (exists $info->{vars}{$param->[$i]}) {
2191 0         0 $param_found = $param->[$i];
2192             }
2193             }
2194 182         383 return $param_found;
2195             }
2196              
2197             sub set_func_params {
2198 205     205 0 471 my ($ctx, $cmd, $arglist, $param) = @_;
2199 205         310 my $parser = $ctx->{parser};
2200              
2201             # optional params ($var = value) are given as #expr
2202             #
2203             # TODO: arrays are passed as value - to pass them per
2204             # reference &$arr params are used.
2205             #
2206 205         305 my %varmap;
2207 205         541 for (my $i=0; $i < scalar @$param; $i++) {
2208 129         212 my $var;
2209             my $val;
2210              
2211 129 100       257 if ($i < scalar @$arglist) {
2212 127         242 $val = $arglist->[$i];
2213             }
2214 129 100       333 if ($param->[$i] =~ /^#expr\d+$/) {
    100          
2215 1         3 my ($op, $v1, $v2) = @{$parser->{strmap}->{$param->[$i]}};
  1         6  
2216 1 50       5 if ($op ne '=') {
2217 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "bad default param (skip): $param->[$i]");
2218 0         0 return;
2219             }
2220 1         2 $var = $v1;
2221              
2222 1 50       4 if (!defined $val) {
2223 1         5 $val = $v2; # set default for optional param
2224             }
2225             } elsif ($param->[$i] =~ /^#ref\d+$/) {
2226 3         11 $var = $parser->{strmap}->{$param->[$i]}->[0];
2227 3 50       11 unless (is_variable($val)) {
2228 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "no ref var (skip): $param->[$i] = $val");
2229 0         0 return;
2230             } else {
2231 3         23 $varmap{ref}{$var} = [$ctx, $val];
2232 3 50       12 $ctx->{log}->($ctx, 'func', $cmd, "$var references $val now") if $ctx->{log};
2233              
2234 3         9 $val = $ctx->exec_statement($val, 1); # don't remove assignments like ($x = #unresolved)
2235             }
2236             } else {
2237 125 100       263 if (!defined $val) {
2238 1         8 $ctx->{warn}->($ctx, 'func', $cmd, "no default param (skip): $param->[$i] (too few params %d want %d)", scalar @$arglist, scalar @$param);
2239 1         51 return;
2240             }
2241 124         200 $var = $param->[$i];
2242             }
2243 128 50       311 if (is_variable($var)) {
2244 128         504 my $info = {vars => {}, calls => {}, stmts => {}};
2245 128         457 $parser->stmt_info($val, $info);
2246              
2247 128 50       361 if (_skipped_call($parser, $val, '(.*)', $info)) {
2248 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "unresolved param (skip): $param->[$i] = $val");
2249 0         0 return;
2250             }
2251 128 50 66     366 if ($ctx->contains_local_var($info)) {
    50 100        
    100          
    100          
2252 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "unresolved local var param (skip): $param->[$i] = $val");
2253 0         0 return;
2254 2         35 } elsif (($val =~ /^#expr\d+$/) && (scalar keys %{$info->{assigns}} > 0)) {
2255 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "unresolved expr param (skip): $param->[$i] = $val");
2256 0         0 return;
2257             } elsif (($val =~ /^#expr\d+$/) && ($parser->{strmap}->{$val}->[0] eq '$')) {
2258 1         10 $ctx->{warn}->($ctx, 'func', $cmd, "unresolved varvar param (skip): $param->[$i] = $val");
2259 1         46 return;
2260 127         339 } elsif (scalar keys %{$info->{vars}} > 0) {
2261 4         28 $val = $ctx->globlify_local_vars($info, $val);
2262 4         12 $varmap{$var} = $val;
2263 4 50       26 $ctx->{log}->($ctx, 'func', $cmd, "globlified param: $var = $val") if $ctx->{log};
2264             } else {
2265 123         297 $varmap{$var} = $val;
2266 123 50       618 $ctx->{log}->($ctx, 'func', $cmd, "param: $var = $val") if $ctx->{log};
2267             }
2268             }
2269             }
2270 203         471 return \%varmap;
2271             }
2272              
2273             # exec_func() returns: ($retval, $code)
2274             #
2275             # If the function returns with 'return', the result is returned only if
2276             # no function call or variable access was skipped.
2277             #
2278             # Return the executed code as the second result param.
2279             # If a function parameters can't be resolved resolved, keep original call.
2280             #
2281             # - call complete:
2282             # ($ret, $code): $ret from func-return statement.
2283             # (#noreturn, $code): return from void-func (substituted later by #null)
2284             #
2285             # For '$code=undef' keep original call-statement.
2286             # Otherwise $code can be inlined by the caller.
2287             # - when the function returns a value, it is not part of the code.
2288             # - when local variables are left, $code is converted to an anonymous function call.
2289             # - when call returns tainted state, set also caller tainted
2290             #
2291             # - call not completly executed:
2292             # (#notaint, $code): return anonymous function for inlining
2293             # (#notaint, undef): keep original call-statement
2294             # undef: keep original call-statement & set tainted
2295             #
2296             # - constructor call:
2297             # (#construct, $code): for constructor call just show executed statements
2298             #
2299             sub _exec_func {
2300 205     205   485 my ($ctx, $cmd, $arglist, $param, $block) = @_;
2301 205         329 my $parser = $ctx->{parser};
2302              
2303             # all variables in functions have local scope except
2304             # $GLOBALS[var] or varibales declared 'global $var'.
2305             #
2306 205         533 my $varmap = $ctx->set_func_params($cmd, $arglist, $param);
2307 205 100       475 if (!defined $varmap) {
2308 2         7 return;
2309             }
2310 203 50       431 $ctx->{log}->($ctx, 'func', $cmd, "START with varmap: [%s]", join(' ', keys %$varmap)) if $ctx->{log};
2311             #$ctx->{log}->($ctx, 'func', $cmd, "%s", $parser->format_stmt($block)) if $ctx->{log};
2312             #$ctx->{log}->($ctx, 'func', $cmd, "GLOBALS %s BLOCK %s", join(' ', keys %{$ctx->{globals}}), $block) if $ctx->{log};
2313              
2314 203         292 my $out;
2315 203         612 my $ctx2 = $ctx->subscope_ctx(varmap => $varmap, infunction => lc($cmd), incall => 1);
2316 203         532 $ctx2->{varhist} = {};
2317              
2318 203         328 my $is_construct;
2319 203         750 my ($inst, $prop) = method_split(lc($cmd));
2320 203 100       531 if (defined $inst) {
2321 54         190 my $method = $ctx->lookup_method_name(lc($cmd)); # lookup instance function
2322 54 100       192 if (defined $method) {
2323 24         49 $cmd = $method;
2324 24         57 $ctx2->{varmap}{'$this'} = $inst; # init $this var for instance
2325 24 100       86 if ($prop eq '__construct') {
    100          
2326 4         22 $is_construct = 1;
2327             } elsif (lc($cmd) eq method_name($prop, $prop)) {
2328 2         7 $is_construct = 1;
2329             }
2330             } else {
2331 30         64 $ctx2->{class_scope} = $inst; # is class call
2332             }
2333             }
2334 203 100       606 $ctx2->{infunction} = ($cmd =~ /^#fun\d+$/) ? '{closure}' : lc($cmd);
2335              
2336 203         527 my $res = $ctx2->exec_statement($block);
2337 203 50       499 if (defined $res) {
2338 203         548 $res = $ctx2->convert_assign_return($res);
2339 203 50       588 $ctx->{log}->($ctx, 'func', $cmd, "res: $res '%s'", $parser->format_stmt($res)) if $ctx->{log};
2340 203 100       530 if (is_block($res)) {
2341 200         321 my ($type, $a) = @{$parser->{strmap}->{$res}};
  200         490  
2342 200         414 $out = $a;
2343             } else {
2344 3         11 $out = [$res];
2345             }
2346             }
2347 203 50       477 if (defined $out) {
2348 203         348 my $unresolved_param;
2349 203         334 my $keep_call = 0;
2350 203         624 my $resinfo = $ctx->get_unresolved_info($cmd, $res);
2351              
2352 203 100       544 if (scalar @$out > 0) {
2353 202         450 my $r = _final_break($parser, $res, '(return)');
2354 202         567 my $f = _skipped_call($parser, $res, '(.*)', $resinfo);
2355 202         555 my $u = $ctx2->unresolvable_var($resinfo); # allow to return superglobal result
2356              
2357 202 100       388 $ctx->{warn}->($ctx, 'func', $cmd, "found remaining [global assigns: %s, local assigns: %s, var: %s, calls: %s (%s)]: %s -> %s", join(' ', keys %{$resinfo->{global_assigns}}), join(' ', keys %{$resinfo->{local_assigns}}), $u ? $u : '-', $f ? $f : '-', join(' ', keys %{$resinfo->{calls}}), $block, $res);
  202 100       518  
  202         678  
  202         1017  
2358              
2359 202         11144 my $res1 = $ctx2->eliminate_local_assigments($resinfo, $res);
2360 202 100 100     323 if ((scalar keys %{$resinfo->{remaining_locals}} == 0) && (scalar keys %{$resinfo->{remaining_statics}} == 0)) {
  202 100       883  
  191         730  
2361 174 100       418 if ($res ne $res1) {
2362 68         111 $res = $res1;
2363             }
2364 174         544 $resinfo = $ctx->get_unresolved_info($cmd, $res);
2365 174         559 $unresolved_param = _find_unresolved_param($resinfo, $param);
2366 28         122 } elsif (scalar keys %{$resinfo->{remaining_statics}} > 0) {
2367 21         40 $keep_call = 1;
2368             } else {
2369 7         29 $unresolved_param = _find_unresolved_param($resinfo, $param);
2370             }
2371              
2372 202 100       543 if ($is_construct) {
2373 6 50       24 unless (_anon_func_call($parser, $res)) {
2374 6         16 $res = _to_code_block($parser, $res);
2375             }
2376 6 50       22 $ctx->{log}->($ctx, 'func', $cmd, "return $res for void construct") if $ctx->{log};
2377 6         60 return ('#construct', $res); # return dummy result & show simplified code for construct
2378             }
2379              
2380             # undefined result
2381             #
2382 196 100 100     783 if (defined $u || defined $f) {
2383 20 100       83 if ($ctx2->{tainted} > $ctx->{tainted}) {
2384 7         32 $ctx->{warn}->($ctx, 'func', $cmd, "not completely executed (and tainted)");
2385 7         293 $ctx->{tainted} = $ctx2->{tainted};
2386             }
2387             }
2388              
2389 196 100       434 if (_can_return($resinfo)) {
2390 130 50       300 if (!defined $r) {
2391 0 0 0     0 if ($ctx->{infunction} && !$ctx->{incall}) {
2392 0 0       0 $ctx->{log}->($ctx, 'func', $cmd, "don't expand subcalls while function is parsed") if $ctx->{log};
2393 0         0 return (undef, $res);
2394             }
2395 0 0       0 $ctx->{log}->($ctx, 'func', $cmd, "has return but no final return -> inline anon func") if $ctx->{log};
2396 0         0 $res = _to_anon_func_call($parser, $res);
2397 0         0 return ('#notaint', $res);
2398             }
2399 130         323 my $arg = $parser->{strmap}->{$r}->[1];
2400 130         460 my $arginfo = {vars => {}, calls => {}, stmts => {}};
2401 130         445 $parser->stmt_info($arg, $arginfo);
2402              
2403 130 100       394 if ($ctx2->contains_local_var($arginfo)) {
2404 4 100 66     18 if ($ctx->{infunction} && !$ctx->{incall}) {
2405 2 50       7 $ctx->{log}->($ctx, 'func', $cmd, "don't expand subcalls while function is parsed") if $ctx->{log};
2406 2         28 return (undef, $res);
2407             }
2408 2 50 33     18 if ($keep_call || $unresolved_param) {
2409 0 0       0 $ctx->{log}->($ctx, 'func', $cmd, "return $arg is local var & unresolved locals -> keep call") if $ctx->{log};
2410 0         0 return ('#notaint', undef);
2411             }
2412 2 50       9 $ctx->{log}->($ctx, 'func', $cmd, "return $arg is local var -> inline anon func") if $ctx->{log};
2413 2         10 $res = _to_anon_func_call($parser, $res);
2414 2         37 return ('#notaint', $res);
2415             }
2416 126         452 $arg = $ctx2->convert_globals_to_caller_ctx($resinfo, $arg, $ctx);
2417              
2418 126         344 my $res1 = _remove_final_statement($parser, '(return)', $res);
2419              
2420 126 100 66     594 if ($keep_call || $unresolved_param) {
2421 7         20 $resinfo = $ctx->get_unresolved_info($cmd, $res1);
2422 7 50       28 if (_can_return($resinfo)) {
2423 0 0       0 $ctx->{log}->($ctx, 'func', $cmd, "has multiple returns & unresolved locals -> keep call") if $ctx->{log};
2424 0         0 return ('#notaint', undef);
2425             } else {
2426 7 50       24 $ctx->{log}->($ctx, 'func', $cmd, "has return $arg & unresolved locals -> keep call") if $ctx->{log};
2427 7         79 return ($arg, undef);
2428             }
2429             }
2430 119 50       345 if ($ctx2->can_inline($res1)) {
2431 119         297 $res1 = $ctx2->convert_globals_to_caller_ctx($resinfo, $res1, $ctx);
2432 119         1339 return ($arg, $res1);
2433             }
2434 0 0       0 $ctx->{log}->($ctx, 'func', $cmd, "has return $arg but can't inline -> inline anon func") if $ctx->{log};
2435 0         0 $res = _to_anon_func_call($parser, $res);
2436 0         0 return ('#notaint', $res);
2437             }
2438             } else {
2439 1         5 $unresolved_param = _find_unresolved_param($resinfo, $param);
2440             }
2441              
2442 67 100       191 if (scalar @$out > 0) {
2443             # If a return was omitted the value NULL will be returned.
2444             # https://php.net/manual/en/functions.returning-values.php
2445             #
2446 66 50       150 $ctx->{log}->($ctx, 'func', $cmd, "has no return - return #null") if $ctx->{log};
2447              
2448 66 100 100     259 if ($keep_call || $unresolved_param) {
2449 12         130 return ('#noreturn', undef);
2450             }
2451 54 100       201 if ($ctx2->can_inline($res)) {
2452 52         188 $res = $ctx2->convert_globals_to_caller_ctx($resinfo, $res, $ctx);
2453 52         512 return ('#noreturn', $res);
2454             }
2455 2         13 $res = _to_anon_func_call($parser, $res);
2456 2         59 return ('#noreturn', $res);
2457             }
2458             }
2459 1         7 return;
2460             }
2461              
2462             sub exec_func {
2463 205     205 0 528 my ($ctx, $cmd, $arglist, $param, $block) = @_;
2464 205         336 my $parser = $ctx->{parser};
2465 205         310 my $ret;
2466             my $code;
2467              
2468 205 100       573 if (exists $parser->{strmap}{_CALL}{$cmd}) {
2469 51         128 $parser->{strmap}{_CALL}{$cmd} += 1;
2470             } else {
2471 154         412 $parser->{strmap}{_CALL}{$cmd} = 1;
2472             }
2473 205         373 my $level = $parser->{strmap}{_CALL}{$cmd};
2474              
2475 205 50       394 if ($level > 4) {
2476 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "max recursion level ($level) reached");
2477             } else {
2478 205         558 ($ret, $code) = $ctx->_exec_func($cmd, $arglist, $param, $block);
2479             }
2480 205         582 $parser->{strmap}{_CALL}{$cmd} -= 1;
2481              
2482 205 100       606 if (defined $ret) {
2483 200         701 return ($ret, $code);
2484             }
2485 5         18 return;
2486             }
2487              
2488             # get elem list for multidimensional array (base elem first)
2489             #
2490             sub _get_elemlist {
2491 167     167   290 my ($parser, $var) = @_;
2492 167         309 my @list = ();
2493              
2494 167         604 while ($var =~ /^#elem\d+$/) {
2495 195         322 my ($v, $i) = @{$parser->{strmap}->{$var}};
  195         482  
2496              
2497 195         441 unshift(@list, $var);
2498 195         503 $var = $v;
2499             }
2500 167         391 return \@list;
2501             }
2502              
2503             # convert elem list to point to new base var
2504             #
2505             sub _update_elemlist {
2506 18     18   76 my ($parser, $var, $elemlist) = @_;
2507 18         37 my @list = ();
2508              
2509 18         43 foreach my $elem (@$elemlist) {
2510 24         36 my ($v, $i) = @{$parser->{strmap}->{$elem}};
  24         62  
2511 24         63 my $next = $parser->setelem($var, $i);
2512 24         56 push(@list, $next);
2513 24         52 $var = $next;
2514             }
2515 18         86 return \@list;
2516             }
2517              
2518             sub resolve_varvar {
2519 55     55 0 123 my ($ctx, $var, $in_block) = @_;
2520 55         108 my $parser = $ctx->{parser};
2521              
2522             # https://www.php.net/manual/en/language.variables.variable.php
2523             #
2524 55 50       163 if ($var =~ /^#expr\d+$/) {
2525 55         87 my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}};
  55         148  
2526              
2527 55 50 66     259 if (($op eq '$') && !defined $v1 && defined $v2) {
      66        
2528 42         125 my $op2 = $ctx->exec_statement($v2, $in_block);
2529 42         150 my $val = $parser->varvar_to_var($op2);
2530 42 100       119 if (defined $val) {
2531 37         107 return $val;
2532             }
2533 5 100       23 if ($v2 ne $op2) {
2534             # simplify expr
2535 2         18 $val = $parser->setexpr($op, undef, $op2);
2536 2         15 return $val;
2537             }
2538             }
2539             }
2540 16         37 return $var;
2541             }
2542              
2543             sub resolve_obj {
2544 65     65 0 148 my ($ctx, $var, $in_block) = @_;
2545 65         105 my $parser = $ctx->{parser};
2546              
2547 65 50       208 if ($var =~ /^#obj\d+$/) {
2548 65         102 my ($o, $m) = @{$parser->{strmap}->{$var}};
  65         160  
2549              
2550 65 50       149 if ($o =~ /^#inst\d+$/) {
2551 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "obj already instanciated $o");
2552             }
2553 65         163 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($o, $in_block);
2554 65         115 my $basestr;
2555 65 100 100     255 if (defined $basevar && !$has_index) {
    50          
2556 50         127 $basestr = $ctx->exec_statement($basevar, $in_block);
2557 50 100       162 if ($basestr ne $basevar) {
2558 29 0       98 $ctx->{log}->($ctx, 'resolve', $var, "obj-var $o basevar $basevar [%s]", defined $basestr ? $basestr : '') if $ctx->{log};
    50          
2559             }
2560             } elsif ($o =~ /^#inst\d+$/) {
2561 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "has inst $o") if $ctx->{log};
2562 0         0 $basestr = $o;
2563             }
2564 65 100       148 if (!defined $basestr) {
2565 15         39 my $inst = $ctx->exec_statement($o);
2566 15 100       47 if ($inst ne $o) {
2567 13 50       39 $ctx->{log}->($ctx, 'resolve', $var, "created $inst") if $ctx->{log};
2568 13         24 $basestr = $inst;
2569             }
2570             }
2571 65 0       148 $ctx->{log}->($ctx, 'resolve', $var, "[$o->$m] -> %s", defined $basestr ? $basestr : '-') if $ctx->{log};
    50          
2572              
2573 65 100 100     341 if (defined $basestr && ($basestr =~ /^#inst\d+$/)) {
2574 40         66 my $inst = $basestr;
2575 40         63 my $sym = $m;
2576              
2577             # $obj->{'a'}() or $obj->{$x}() is allowed
2578             #
2579 40 100 66     91 if (is_block($m) || is_variable($m)) {
2580 1         18 $sym = $ctx->exec_statement($m);
2581             }
2582 40 100 66     89 if (is_strval($sym) && !is_null($sym)) {
2583 1         17 $sym = $parser->{strmap}{$sym};
2584 1 50       7 $ctx->{log}->($ctx, 'resolve', $var, "resolved sym $o :: $m -> $inst :: $sym") if $ctx->{log};
2585             }
2586 40         188 return ($inst, $sym);
2587             }
2588             }
2589 25         93 return;
2590             }
2591              
2592             sub resolve_scope {
2593 49     49 0 103 my ($ctx, $var, $in_block) = @_;
2594 49         85 my $parser = $ctx->{parser};
2595              
2596             # https://php.net/manual/en/language.oop5.paamayim-nekudotayim.php
2597             #
2598 49 50       154 if ($var =~ /^#scope\d+$/) {
2599 49         75 my ($c, $e) = @{$parser->{strmap}->{$var}};
  49         123  
2600 49         92 my $class;
2601             my $scopename;
2602              
2603 49 50       104 if ($c =~ /^#class\d+$/) {
2604 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "scope already resolved $c");
2605 0         0 $class = $c;
2606             } else {
2607 49         78 my $name = $c;
2608 49 100       124 if (!is_symbol($name)) {
2609 1         6 my $s = $ctx->exec_statement($name);
2610 1 50 33     5 if (is_strval($s) && !is_null($s)) {
2611 0         0 $name = $parser->{strmap}->{$s};
2612             } else {
2613 1         3 $name = $s;
2614             }
2615 1 50       4 $ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $c, $s, $name) if $ctx->{log};
2616             }
2617 49 100       151 if ($name eq 'self') {
    50          
2618 3 50       15 if (exists $ctx->{class_scope}) {
2619 3         11 $class = $ctx->getclass($ctx->{class_scope});
2620             } else {
2621 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "self used outside of class scope");
2622             }
2623             } elsif ($name eq 'parent') {
2624 0 0       0 if (exists $ctx->{class_scope}) {
2625 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "parent for class $ctx->{class_scope} not supported");
2626             } else {
2627 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "parent used outside of class scope");
2628             }
2629             } else {
2630 46         103 $scopename = $ctx->add_namespace($name);
2631 46         132 $class = $ctx->getclass($scopename);
2632             }
2633             }
2634 49 100       116 if (defined $class) {
2635 46         60 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  46         128  
2636              
2637 46 100       104 $scopename = $n unless defined $scopename;
2638              
2639 46 100       109 if (is_variable($e)) {
2640 22         58 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($e, $in_block);
2641 22 50 33     62 if (defined $basevar && is_variable($basevar)) {
2642 22 50       45 $ctx->{log}->($ctx, 'resolve', $var, "var %s::%s -> %s::%s", $c, $e, $scopename, $basevar) if $ctx->{log};
2643 22         97 return ($scopename, $basevar);
2644             }
2645             } else {
2646 24         63 my $sym = $e;
2647 24 50       49 if (is_block($e)) {
2648 0         0 $sym = $ctx->exec_statement($e);
2649             }
2650 24 50 33     54 if (is_strval($sym) && !is_null($sym)) {
2651 0         0 $sym = $parser->{strmap}{$sym};
2652 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "sym %s::%s -> %s::%s", $c, $e, $scopename, $sym) if $ctx->{log};
2653             }
2654 24         91 return ($scopename, $sym);
2655             }
2656             }
2657             }
2658 3         10 return;
2659             }
2660              
2661             sub resolve_ns {
2662 11     11 0 20 my ($ctx, $var, $in_block) = @_;
2663 11         16 my $parser = $ctx->{parser};
2664              
2665             # https://php.net/manual/en/language.namespaces.rationale.php
2666             #
2667 11 50       40 if ($var =~ /^#ns\d+$/) {
2668 11         18 my ($n, $e) = @{$parser->{strmap}->{$var}};
  11         24  
2669 11         15 my $ns;
2670              
2671 11 100       32 if (!defined $n) {
2672 7 50       16 $ctx->{log}->($ctx, 'resolve', $var, "toplevel") if $ctx->{log};
2673 7         10 $ns = ''; # toplevel
2674             } else {
2675 4         6 my $name = $n;
2676 4 50       13 if (!is_symbol($name)) {
2677 4         9 my $s = $ctx->exec_statement($name);
2678 4 50 33     10 if (is_strval($s) && !is_null($s)) {
2679 0         0 $name = $parser->{strmap}->{$s};
2680             } else {
2681 4         8 $name = $s;
2682             }
2683 4 50       11 $ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $n, $e, $name) if $ctx->{log};
2684             }
2685 4 50       10 if ($name eq 'namespace') {
2686 0         0 $ns = lc($ctx->{namespace});
2687             } else {
2688 4         23 $ns = $name;
2689             }
2690             }
2691 11         46 return ($ns, $e);
2692             }
2693 0         0 return;
2694             }
2695              
2696             # convert first elem of elem list to variable if possible
2697             #
2698             sub get_baseelem {
2699 164     164 0 315 my ($ctx, $var, $in_block) = @_;
2700 164         304 my $parser = $ctx->{parser};
2701 164         418 my $elemlist = _get_elemlist($parser, $var);
2702              
2703 164 50       586 if ($elemlist->[0] =~ /^#elem\d+$/) {
2704 164         262 my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}};
  164         423  
2705              
2706 164 100 66     678 if (defined $i && ($v !~ /^#elem\d+$/)) {
2707             # allow only to resolve variable recursively
2708             # todo: use resolve_variable() here?
2709             #
2710 140         219 my $val;
2711 140 100       374 if ($v =~ /^#expr\d+$/) {
    100          
2712 2         15 $val = $ctx->resolve_varvar($v, $in_block);
2713 2 50 33     10 if (($val ne $v) && !is_variable($val)) {
2714 0         0 return _update_elemlist($parser, $val, $elemlist);
2715             }
2716             } elsif ($v =~ /^#obj\d+$/) {
2717 4         15 my ($inst, $prop) = $ctx->resolve_obj($v, $in_block);
2718 4 100       18 if (defined $inst) {
2719 2         9 $val = inst_var($inst, '$'.$prop);
2720             }
2721             } else {
2722 134         309 $val = $ctx->exec_statement($v, $in_block);
2723             }
2724 140 100 100     717 if (defined $val && is_variable($val)) {
2725 65         232 my $idx = $ctx->exec_statement($i);
2726 65         278 my $g = $parser->globalvar_to_var($val, $idx);
2727 65 100       283 if (defined $g) {
    100          
2728             # convert resolved basevar $GLOBALS['x'] -> $x,
2729             #
2730 30 100       96 if ($ctx->{infunction}) {
2731 13         37 $g = global_var($g);
2732             }
2733 30         67 shift(@$elemlist);
2734 30 100       70 if (@$elemlist) {
2735 4         23 return _update_elemlist($parser, $g, $elemlist);
2736             } else {
2737 26         105 return [$g];
2738             }
2739             } elsif ($ctx->is_superglobal($val)) {
2740 21         69 return $elemlist;
2741             } else {
2742             # convert resolved baseelem ${$a}['x'] -> $b['x'],
2743             #
2744 14         67 return _update_elemlist($parser, $val, $elemlist);
2745             }
2746             }
2747             }
2748             }
2749 99         239 return $elemlist;
2750             }
2751              
2752             # For undefined multidimensional arrays create_basearray() allocates
2753             # missing intermediate arrays. Also assigns a new array or a copy of
2754             # the existing array via setvar() to basevar.
2755             #
2756             # return: ($var, $val, $basevar);
2757             # - var: the variable part for the topmost element (topmost index ignored)
2758             # - val: the matching (sub)-array for this variable (might be undef)
2759             # - basevar: the base variable of the array.
2760             #
2761             sub create_basearray {
2762 123     123 0 247 my ($ctx, $elemlist, $in_block) = @_;
2763 123         230 my $parser = $ctx->{parser};
2764 123         305 my $superglobals_writable = 1;
2765              
2766 123         209 my $elem = $elemlist->[0];
2767 123         237 my ($v, $i) = @{$parser->{strmap}->{$elem}};
  123         348  
2768 123         291 my $val = $ctx->exec_statement($v, $in_block);
2769 123         255 my $basevar = $v;
2770              
2771 123 100       324 if (is_variable($val)) {
2772             # resolved reference
2773 29 50 66     95 if (!$ctx->is_superglobal($val) || $superglobals_writable) {
2774 29         74 $v = $val;
2775 29         59 $val = undef;
2776             }
2777             }
2778 123 100 100     405 if (defined $val && is_strval($val) && ($parser->get_strval_or_str($val) eq '')) {
      100        
2779             # up to php70 empty strings are treated like an empty array
2780             # https://www.php.net/manual/en/migration71.incompatible.php
2781             #
2782 38 50       125 unless (exists $ctx->{skip}{treat_empty_str_like_empty_array}) {
2783 38         201 $ctx->{warn}->($ctx, 'elem', $elem, "treat empty str $val like empty array");
2784 38         2914 $val = undef;
2785             }
2786             }
2787 123 50 66     433 if (defined $val && is_null($val)) {
2788 0         0 $val = undef;
2789             }
2790 123 100 100     399 if (!defined $val || is_array($val)) {
2791 119 100       251 if (!defined $val) {
2792             # nonexisting array is auto-created
2793             #
2794 67         247 my $arr = $parser->newarr();
2795 67         158 $val = $arr->{name};
2796 67 50       180 $ctx->{log}->($ctx, 'elem', $elem, "create_base autoarr $v: $val") if $ctx->{log};
2797             } else {
2798             # TODO: don't copy array if not displayed since last update
2799             # (track tainted state for each array)
2800             #
2801 52         123 my $arr = $parser->{strmap}{$val};
2802 52         195 $arr = $arr->copy(); # recursive copy
2803 52 50       131 $ctx->{log}->($ctx, 'elem', $elem, "create_base copyarr $v: $val -> $arr->{name}") if $ctx->{log};
2804 52         115 $val = $arr->{name};
2805             }
2806             # don't insert '$x = array()' into block
2807             #
2808 119         341 $ctx->setvar($v, $val, 1);
2809             #$ctx->setvar($v, $val, $in_block);
2810             } else {
2811             # something like #obj?
2812             #
2813 4         9 my $lastelem = $elemlist->[-1];
2814 4         8 my ($lastvar, $lastidx) = @{$parser->{strmap}->{$lastelem}};
  4         22  
2815 4         24 return ($lastvar, $val, $basevar);
2816             }
2817              
2818             # resolve next index
2819             #
2820 119         502 foreach my $nextelem (@$elemlist[1..@$elemlist-1]) {
2821 22         60 my $idx;
2822             my $nextval;
2823 22         42 my $arr = $parser->{strmap}{$val};
2824              
2825 22 50       55 if (defined $i) {
2826 22         81 $idx = $ctx->exec_statement($i, $in_block);
2827 22 100       61 $idx = $parser->setstr('') if is_null($idx); # null maps to '' array index
2828 22         108 my $arrval = $arr->get($idx);
2829 22 100       79 if (defined $arrval) {
2830 4         8 $nextval = $arrval;
2831             }
2832             }
2833 22 100 100     72 if (!defined $nextval || is_array($nextval)) {
2834 21 100       54 if (!defined $nextval) {
2835             # nonexisting intermediate array is auto-created
2836             #
2837 18         45 my $newarr = $parser->newarr();
2838 18 50       70 $ctx->{log}->($ctx, 'elem', $elem, "create_base autoarr $nextelem: = $newarr->{name} [basevar: $basevar]") if $ctx->{log};
2839 18         35 $nextval = $newarr->{name};
2840             }
2841 21 50       87 if (!defined $idx) {
    50          
2842 0         0 $arr->set(undef, $nextval);
2843 0 0       0 $ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[] = %s", $val, $nextval) if $ctx->{log};
2844             } elsif (is_strval($idx)) {
2845 21         75 $arr->set($idx, $nextval);
2846 21 50       82 $ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[%s] = %s", $val, $idx, $nextval) if $ctx->{log};
2847             } else {
2848 0 0       0 $ctx->{log}->($ctx, 'elem', $elem, "create_base set: %s[%s] bad idx", $val, $idx) if $ctx->{log};
2849             }
2850             }
2851 22 50 33     83 if (($elem ne $v) || ($idx ne $i)) {
2852 22         67 $elem = $parser->setelem($v, $idx);
2853             }
2854 22         71 $v = $elem;
2855 22         40 $val = $nextval;
2856 22         32 ($elem, $i) = @{$parser->{strmap}->{$nextelem}};
  22         72  
2857             }
2858 119         421 return ($v, $val, $basevar);
2859             }
2860              
2861             # resolve_variable() returns: ($basevar, $has_idx, [$baseidx])
2862             # - basevar: resolved variable name (a.e: array name)
2863             # - has_idx: is array dereference
2864             # - baseidx: if is array: indexvalue of last index or undef if index is empty
2865             #
2866             sub resolve_variable {
2867 180     180 1 384 my ($ctx, $var, $in_block) = @_;
2868 180         309 my $parser = $ctx->{parser};
2869              
2870             # returns: <$resolved_var>
2871             #
2872 180 50       423 if (!defined $var) {
2873 0         0 $ctx->{warn}->($ctx, 'resolve', '', "");
2874 0         0 return;
2875             }
2876 180 100       393 if (is_variable($var)) {
    50          
    50          
    100          
    50          
2877 124 50       329 if (exists $ctx->{varmap}{ref}{$var}) {
2878 0         0 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  0         0  
2879             # special case for '$var = &$GLOBALS' reference
2880 0 0       0 if ($var1 =~ /^\$GLOBALS$/) {
2881 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "superglobals reference -> $var1") if $ctx->{log};
2882 0         0 return $ctx2->resolve_variable($var1, $in_block);
2883             }
2884             }
2885 124         430 return ($var, 0);
2886             } elsif ($var =~ /^#obj\d+$/) {
2887 0         0 my ($inst, $prop) = $ctx->resolve_obj($var, $in_block);
2888 0 0       0 if (defined $inst) {
2889 0         0 my $instvar = inst_var($inst, '$'.$prop);
2890 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "obj -> $instvar") if $ctx->{log};
2891 0         0 return $ctx->resolve_variable($instvar, $in_block);
2892             }
2893             } elsif ($var =~ /^#scope\d+$/) {
2894 0         0 my ($scope, $val) = $ctx->resolve_scope($var, $in_block);
2895 0 0 0     0 if (defined $scope && is_variable($val)) {
2896 0         0 my $classvar = inst_var($scope, $val);
2897 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "scope -> $classvar") if $ctx->{log};
2898 0         0 return $ctx->resolve_variable($classvar, $in_block);
2899             }
2900             } elsif ($var =~ /^#elem\d+$/) {
2901 16         28 my ($v, $i) = @{$parser->{strmap}->{$var}};
  16         46  
2902              
2903 16 50       43 if (!defined $v) {
2904 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "BAD ELEM");
2905 0         0 return;
2906             }
2907 16 50       42 if (is_strval($v)) {
2908             # #strliteral[#num] -> substring
2909             #
2910 0         0 my $idxstr = $ctx->exec_statement($i);
2911 0 0       0 if (defined $idxstr) {
2912 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> is substring", $v, $idxstr) if $ctx->{log};
2913 0         0 return ($v, 1, $idxstr);
2914             }
2915             }
2916 16 50       44 if (is_array($v)) {
2917             # #arr[#num] -> elem
2918             #
2919 0         0 my $idxstr = $ctx->exec_statement($i);
2920 0 0       0 if (defined $idxstr) {
2921 0 0       0 $ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> is array elem", $v, $idxstr) if $ctx->{log};
2922 0         0 return ($v, 1, $idxstr);
2923             }
2924             }
2925 16         48 my $elemlist = $ctx->get_baseelem($var, $in_block);
2926 16         60 my $basevar = $elemlist->[0];
2927 16         36 my $baseidx;
2928              
2929             # this was a conversion '$GLOBALS[x] -> $x'
2930             #
2931 16 100       95 unless ($basevar =~ /^(\#elem\d+)$/) {
2932 1 50       5 $ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> global %s", $v, $i, $basevar) if $ctx->{log};
2933 1         4 return ($basevar, 0);
2934             }
2935 15         29 ($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}};
  15         57  
2936              
2937 15 0       53 $ctx->{log}->($ctx, 'resolve', $var, "%s[%s] -> %s[%s]", $v, defined $i ? $i : '-', defined $basevar ? $basevar : '-', defined $baseidx ? $baseidx : '-') if $ctx->{log};
    0          
    0          
    50          
2938              
2939 15 50       41 if (defined $basevar) {
2940 15 50       33 if (defined $i) {
2941 15         40 my $idxstr = $ctx->exec_statement($i);
2942 15         102 return ($basevar, 1, $idxstr);
2943             }
2944             }
2945             } elsif ($var =~ /^#expr\d+$/) {
2946 40         113 my $val = $ctx->resolve_varvar($var, $in_block);
2947 40 100 66     145 if (($val ne $var) && !($val =~ /^#expr\d+$/)) {
2948 27         82 return $ctx->resolve_variable($val, $in_block);
2949             }
2950             }
2951 13         27 return;
2952             }
2953              
2954             # resolves variables for function call argument list
2955             # - an optional $prototype-list can be passed to check arguments
2956             #
2957             sub resolve_arglist {
2958 768     768 0 1492 my ($ctx, $arglist, $param, $in_block) = @_;
2959 768         1149 my @args = ();
2960 768         1213 my $arg_changed = 0;
2961 768         1035 my $i = 0;
2962              
2963 768         1463 foreach my $p (@$arglist) {
2964 626 100 100     2612 if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) {
    100 66        
2965             # reference is resolved in exec_func->set_func_params
2966             #
2967 27         82 push(@args, $p);
2968             } elsif (!is_strval($p) || is_const($p)) {
2969 255         727 my $v = $ctx->exec_statement($p, $in_block);
2970              
2971 255         587 push(@args, $v);
2972 255 100       652 if ($v ne $p) {
2973 158         352 $arg_changed = 1;
2974             }
2975             } else {
2976 344         982 push(@args, $p);
2977             }
2978             }
2979 768         2187 return (\@args, $arg_changed);
2980             }
2981              
2982             sub invalidate_arglist_refs {
2983 2     2 0 5 my ($ctx, $arglist, $param, $in_block) = @_;
2984 2         4 my $i = 0;
2985              
2986 2         5 foreach my $p (@$arglist) {
2987 4 100 66     23 if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) {
2988 2 50       9 if (is_variable($p)) {
2989 2         16 $ctx->setvar($p, '#unresolved', $in_block);
2990             }
2991             # todo: elem
2992             }
2993             }
2994 2         4 return;
2995             }
2996              
2997             sub loop_start {
2998 59     59 0 119 my ($parser) = @_;
2999              
3000 59 50       143 unless (exists $parser->{strmap}->{_LOOP}) {
3001 59         148 $parser->{strmap}->{_LOOP} = 0;
3002 59         142 $parser->{strmap}->{_LOOP_LEVEL} = 1;
3003 59         124 return 1;
3004             } else {
3005 0         0 $parser->{strmap}->{_LOOP_LEVEL}++;
3006             }
3007 0         0 return 0;
3008             }
3009              
3010             sub loop_val {
3011 0     0 0 0 my ($parser, $i) = @_;
3012 0         0 return $i + $parser->{strmap}->{_LOOP};
3013             }
3014              
3015             sub loop_level {
3016 42     42 0 71 my ($parser) = @_;
3017 42         144 return $parser->{strmap}->{_LOOP_LEVEL};
3018             }
3019              
3020             sub loop_end {
3021 59     59 0 124 my ($parser, $toploop, $i) = @_;
3022              
3023 59 50       141 if ($toploop) {
3024 59         137 delete $parser->{strmap}->{_LOOP};
3025 59         103 delete $parser->{strmap}->{_LOOP_LEVEL};
3026             } else {
3027 0         0 $parser->{strmap}->{_LOOP} += $i;
3028 0         0 $parser->{strmap}->{_LOOP_LEVEL}--;
3029             }
3030 59         92 return;
3031             }
3032              
3033             sub exec_statement {
3034 8049     8049 1 15156 my ($ctx, $var, $in_block) = @_;
3035 8049         12981 my $parser = $ctx->{parser};
3036              
3037 8049 50       15380 if (!defined $var) {
3038 0         0 $ctx->{warn}->($ctx, 'exec', '', "");
3039 0         0 return $var;
3040             }
3041 8049 100 100     16524 if (is_strval($var) && !is_const($var)) {
3042 1096         3003 return $var;
3043             }
3044 6953 100       14494 if ($var =~ /^#ref\d+$/) {
3045 6         17 return $var;
3046             }
3047 6947 0       13253 $ctx->{log}->($ctx, 'exec', $var, "%s%s", $parser->stmt_str($var), $in_block ? ' (inblock)' : '') if $ctx->{log};
    50          
3048              
3049 6947 100       14585 if (is_variable($var)) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
3050 1588 100       4267 if (exists $ctx->{varmap}{ref}{$var}) {
3051 15         54 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  15         39  
3052             #if (!$ctx->is_superglobal($var1) || ($var1 =~ /^\$GLOBALS$/)) {
3053 15 50       39 $ctx->{log}->($ctx, 'exec', $var, "resolve reference -> $var1") if $ctx->{log};
3054 15         27 $var = $var1;
3055 15         33 $ctx = $ctx2;
3056             #}
3057             }
3058 1588         3766 my $val = $ctx->getvar($var);
3059 1588 100 100     5892 if (defined $val && ($val eq '#unresolved')) {
3060 266 50       627 $ctx->{log}->($ctx, 'exec', $var, "is unresolved") if $ctx->{log};
3061 266         468 $val = undef;
3062             }
3063             #if (defined $val && is_variable($val)) {
3064             # my $vval = $ctx->exec_statement($val);
3065             # $ctx->{log}->($ctx, 'exec', $var, "val $val vval $vval") if $ctx->{log};
3066             # if ($ctx->is_unresolved_assignment($vval)) {
3067             # $val = undef;
3068             # }
3069             #}
3070 1588 100       3295 if (defined $val) {
3071             #unless ($val =~ /^\$GLOBALS$/) {
3072 1031         1776 my $str = $val;
3073 1031 100       2234 if (is_strval($val)) {
    100          
3074 670         1382 $str = $parser->{strmap}{$val};
3075 670 50       1553 $ctx->{log}->($ctx, 'getvar', $var, "-> %s [%s]", $val, $parser->shortstr($str, 60)) if $ctx->{log};
3076             } elsif (is_array($val)) {
3077 309         697 my $arr = $parser->{strmap}{$val};
3078 309         975 my $keys = $arr->get_keys();
3079 309 50       1052 $ctx->{log}->($ctx, 'getvar', $var, "-> %s [size: %d]", $val, scalar @$keys) if $ctx->{log};
3080             } else {
3081 52 50       147 $ctx->{log}->($ctx, 'getvar', $var, "-> %s", $val) if $ctx->{log};
3082             }
3083 1031         2612 return $val;
3084             #} else {
3085             # $ctx->{log}->($ctx, 'exec', $var, "is superglobal") if $ctx->{log};
3086             #}
3087             }
3088 557         1674 return $var;
3089             } elsif (is_const($var)) {
3090 89         259 my $v = $parser->{strmap}->{$var};
3091              
3092             # constant (undefined constants propagate to string)
3093             # constants are always global
3094             #
3095             # - some constants are magic (__LINE__ is handled in parser):
3096             # https://www.php.net/manual/en/language.constants.magic.php
3097             #
3098 89         211 my $nv = $ctx->add_namespace($v);
3099              
3100 89 100 33     743 if (exists $ctx->{defines}{$nv}) {
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
3101 3         18 my $val = $ctx->{defines}{$nv};
3102 3         10 my $str = $val;
3103 3 50       10 $ctx->{log}->($ctx, 'getdef', $var, "%s -> %s [%s]", $nv, $val, $parser->shortstr($str, 60)) if $ctx->{log};
3104 3         9 return $val;
3105             } elsif ($v =~ /^__FUNCTION__$/) {
3106 5 50       24 if ($ctx->{infunction}) {
3107 5         20 my ($class, $prop) = method_split($ctx->{infunction});
3108 5 100       24 $prop = $ctx->{infunction} unless defined $prop;
3109 5         17 my $fun = $ctx->getfun($prop);
3110 5 100       41 if (defined $fun) { # convert name to mixedcase
3111 4         11 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  4         21  
3112 4 100       14 if ($ctx->{namespace}) {
3113 1         7 $f = ns_name($ctx->{namespace}, $f); # keep namespace case here
3114             }
3115 4         12 return $parser->setstr($f);
3116             }
3117             } else {
3118 0         0 return $parser->setstr('');
3119             }
3120             } elsif ($v =~ /^__CLASS__$/) {
3121 1 50       9 if (exists $ctx->{class_scope}) {
3122 1         6 my $class = $ctx->getclass($ctx->{class_scope});
3123 1 50       5 if (defined $class) { # convert name to mixedcase
3124 1         3 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  1         3  
3125 1 50       288 if ($ctx->{namespace}) {
3126 0         0 $n = ns_name($ctx->{namespace}, $n); # keep namespace case here
3127             }
3128 1         12 return $parser->setstr($n);
3129             }
3130             } else {
3131 0         0 return $parser->setstr('');
3132             }
3133             } elsif ($v =~ /^__METHOD__$/) {
3134 4 50       13 if ($ctx->{infunction}) {
3135             # internal method representation matches php class::name
3136 4         12 my $fun = $ctx->getfun($ctx->{infunction});
3137 4 50       14 if (defined $fun) {
3138 4         8 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  4         13  
3139 4         16 my ($classname, $prop) = method_split($ctx->{infunction});
3140 4         6 my $name; # convert name to mixedcase
3141 4 50       12 if (defined $classname) {
3142 4         11 my $class = $ctx->getclass($classname);
3143 4         7 my ($n, $cb, $cp) = @{$parser->{strmap}->{$class}};
  4         22  
3144 4         15 $name = method_name($n, $f);
3145             } else {
3146 0         0 $name = $f;
3147             }
3148 4 50       15 if ($ctx->{namespace}) {
3149 0         0 $name = ns_name($ctx->{namespace}, $name); # keep namespace case here
3150             }
3151 4         15 return $parser->setstr($name);
3152             }
3153             } else {
3154 0         0 return $parser->setstr('');
3155             }
3156             } elsif ($v =~ /^__NAMESPACE__$/) {
3157 1 50       5 if ($ctx->{namespace}) {
3158 1         5 return $parser->setstr($ctx->{namespace});
3159             } else {
3160 0         0 return $parser->setstr('');
3161             }
3162             } elsif ($v =~ /^__DIR__$/) {
3163             # skip
3164             } elsif ($v =~ /^DIRECTORY_SEPARATOR$/) {
3165 0         0 return $parser->setstr('/');
3166             } elsif ($v =~ /^PATH_SEPARATOR$/) {
3167 0         0 return $parser->setstr('/');
3168             } elsif (exists $ctx->{globals} && exists $ctx->{globals}{$v}) {
3169 0         0 my $val = $ctx->{globals}{$v};
3170 0         0 my $str = $val;
3171 0 0       0 if (is_strval($val)) {
3172 0         0 $str = $parser->{strmap}->{$val};
3173             }
3174 0 0       0 $ctx->{log}->($ctx, 'getconst', $var, "%s -> %s [%s]", $v, $val, $parser->shortstr($str, 60)) if $ctx->{log};
3175 0         0 return $val;
3176             } else {
3177 74 100       151 unless ($ctx->{tainted}) {
3178 50         152 my $k = $parser->setstr($v);
3179 50         254 $ctx->{warn}->($ctx, 'exec', $var, "convert undefined const to string: $v -> $k");
3180 50         5020 return $k;
3181             } else {
3182 24         123 $ctx->{warn}->($ctx, 'exec', $var, "don't convert undefined const to string: $v -> tainted");
3183             }
3184             }
3185 26         1639 return $var;
3186             } elsif ($var =~ /^#arr\d+$/) {
3187 201         503 my $arr = $parser->{strmap}{$var};
3188              
3189             # try to simplify array here (if not in function)
3190             #
3191 201 100       526 unless ($ctx->{incall}) {
3192 145 50       353 if (exists $ctx->{simplify}{arr}) {
3193 145         308 my @newkeys;
3194             my %newmap;
3195 145         200 my $changed = 0;
3196 145         458 my $keys = $arr->get_keys();
3197              
3198 145         355 foreach my $k (@$keys) {
3199 205         487 my $val = $arr->val($k);
3200 205 100 100     745 if ((is_int_index($k) || is_strval($k)) && (!defined $val
      66        
      100        
3201             || (defined $val && is_strval($val)))) {
3202 191         401 push(@newkeys, $k);
3203 191         542 $newmap{$k} = $val;
3204             } else {
3205 14         44 my $k2 = $k;
3206 14 100       64 unless (is_int_index($k)) {
3207 9         30 $k2 = $ctx->exec_statement($k);
3208             }
3209 14         61 push(@newkeys, $k2);
3210 14 50       39 if (defined $val) {
3211 14         38 my $v = $ctx->exec_statement($val);
3212 14         62 $newmap{$k2} = $v;
3213             } else {
3214 0         0 $newmap{$k2} = undef;
3215             }
3216 14 100 100     95 if (($k ne $k2) || ($val ne $newmap{$k2})) {
3217 10         29 $changed = 1;
3218             }
3219             }
3220             }
3221 145 100       492 if ($changed) {
3222 10         32 $arr = $parser->newarr();
3223 10         37 foreach my $k (@newkeys) {
3224 12         40 $arr->set($k, $newmap{$k});
3225             }
3226 10 50       67 $ctx->{log}->($ctx, 'exec', $var, "simplify -> $arr->{name}") if $ctx->{log};
3227 10         49 return $arr->{name};
3228             }
3229             }
3230             }
3231 191         508 return $var;
3232             } elsif ($var =~ /^#obj\d+$/) {
3233 22         60 my ($o, $m) = @{$parser->{strmap}->{$var}};
  22         125  
3234              
3235 22         92 my ($inst, $prop) = $ctx->resolve_obj($var, $in_block);
3236 22 100       66 if (defined $inst) {
3237 13         70 my $instvar = inst_var($inst, '$'.$prop);
3238              
3239 13         35 my $basestr = $ctx->getvar($instvar);
3240 13 100 100     59 if (defined $basestr && ($basestr ne '#unresolved')) {
3241 11         36 return $basestr;
3242             }
3243 2 50       21 if ($m ne $prop) {
3244 0         0 my $k = $parser->setobj($o, $prop);
3245 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "simplify partial -> $k") if $ctx->{log};
3246 0         0 return $k;
3247             }
3248             }
3249 11         30 return $var;
3250             } elsif ($var =~ /^#scope\d+$/) {
3251 16         27 my ($c, $e) = @{$parser->{strmap}->{$var}};
  16         77  
3252              
3253 16         46 my ($scope, $val) = $ctx->resolve_scope($var, $in_block);
3254 16 50       46 if (defined $scope) {
3255 16 100       38 if (is_variable($val)) {
    50          
3256 13         43 my $classvar = inst_var($scope, $val);
3257              
3258 13         38 my $basestr = $ctx->getvar($classvar);
3259 13 100 100     58 if (defined $basestr && ($basestr ne '#unresolved')) {
3260 2         7 return $basestr;
3261             }
3262 11         36 return $classvar;
3263             } elsif (is_symbol($val)) {
3264 3         9 my $name = method_name($scope, $val);
3265              
3266 3 50       12 if (exists $ctx->{defines}{$name}) {
3267 3         7 my $const = $ctx->{defines}{$name};
3268 3 50       10 $ctx->{log}->($ctx, 'exec', $var, "lookup const %s -> %s", $name, $const) if $ctx->{log};
3269 3         8 return $const;
3270             }
3271 0         0 return $name;
3272             }
3273 0 0       0 if ($c ne $scope) {
3274 0 0 0     0 if ($ctx->{incall} && ($c =~ /^(self|parent)$/)) {
3275 0         0 $ctx->{warn}->($ctx, 'exec', $var, "simplify $c -> $scope in function");
3276             }
3277             # only simplified call, no result
3278 0         0 my $k = $parser->setscope($scope, $e);
3279 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "simplify partial -> $k") if $ctx->{log};
3280 0         0 return $k;
3281             }
3282             }
3283 0         0 return $var;
3284             } elsif ($var =~ /^#ns\d+$/) {
3285 9         20 my ($n, $e) = @{$parser->{strmap}->{$var}};
  9         35  
3286              
3287 9         33 my ($ns, $val) = $ctx->resolve_ns($var, $in_block);
3288 9 50       20 if (defined $ns) {
3289 9 50       40 if ($val =~ /^#class\d+$/) {
    50          
    100          
    50          
    50          
3290             } elsif ($val =~ /^#fun\d+$/) {
3291             } elsif (is_const($val)) {
3292 4         14 my $str = $parser->get_strval($val);
3293 4         27 my $name = ns_name(lc($ns), $str);
3294 4         17 my ($sym) = $name =~ /^\\(.*)$/; # remove toplevel
3295              
3296 4 50 33     21 if (defined $sym && exists $ctx->{defines}{$sym}) {
3297 4         12 my $const = $ctx->{defines}{$sym};
3298 4 50       12 $ctx->{log}->($ctx, 'exec', $var, "lookup const %s -> %s", $name, $const) if $ctx->{log};
3299 4         13 return $const;
3300             }
3301 0         0 return $name;
3302             } elsif (is_strval($val)) {
3303 0         0 my $str = $parser->get_strval($val);
3304 0         0 my $name = ns_name(lc($ns), $str);
3305 0         0 return $name;
3306             } elsif (is_symbol($val)) {
3307 5         52 my $name = ns_name(lc($ns), $val);
3308 5         18 my ($sym) = $name =~ /^\/(.*)$/;
3309 5         16 return $name;
3310             }
3311             }
3312 0         0 return $var;
3313             } elsif ($var =~ /^#elem\d+$/) {
3314 363         662 my ($v, $i) = @{$parser->{strmap}->{$var}};
  363         1240  
3315 363         672 my $basevar = $v;
3316 363         1679 my $basestr = $ctx->exec_statement($v, $in_block);
3317 363         747 my $idxstr = $i;
3318              
3319 363 100       995 if (is_null($basestr)) {
3320 18         39 $basestr = undef;
3321             }
3322 363 50       788 if (defined $i) {
3323 363 100 100     772 if (!is_strval($i) || is_const($i)) {
3324 163         428 $idxstr = $ctx->exec_statement($i);
3325             }
3326 363 100       923 if (defined $basestr) {
3327 345         1024 my $g = $parser->globalvar_to_var($basestr, $idxstr);
3328 345 100       902 if (defined $g) {
    100          
    100          
    100          
3329 63 100       188 if ($ctx->{infunction}) {
3330 24         69 $g = global_var($g);
3331             }
3332 63         173 $basestr = $ctx->getvar($g);
3333              
3334 63 0       243 $ctx->{log}->($ctx, 'exec', $var, "getelem %s -> %s (%s)", $parser->stmt_str($var), $g, defined $basestr ? $basestr : '-') if $ctx->{log};
    50          
3335              
3336 63 100 100     257 if (defined $basestr && ($basestr eq '#unresolved')) {
3337 9         21 $basestr = undef;
3338             }
3339 63 100       166 if (defined $basestr) {
3340 40         107 return $ctx->exec_statement($basestr);
3341             }
3342 23         100 return $g; # return simplified global var
3343             } elsif ($ctx->is_superglobal($basestr)) {
3344 51         147 $basevar = $basestr;
3345 51         145 my $val = $ctx->getvar($basestr);
3346 51 50       213 if (defined $val) {
3347 0         0 $basestr = $val;
3348             }
3349             } elsif (is_variable($basestr)) {
3350 19 100       83 if ($basestr eq $basevar) { # getvar() failed
3351 9         26 $basestr = $ctx->getvar($basevar);
3352             } else {
3353 10         20 $basevar = $basestr;
3354             }
3355             } elsif ($basestr =~ /^#elem\d+$/) {
3356 7         28 $basevar = $basestr;
3357             }
3358             }
3359             }
3360 300 0       758 $ctx->{log}->($ctx, 'exec', $var, "getelem %s -> %s[%s] (%s)", $parser->stmt_str($var), $basevar, defined $idxstr ? $idxstr : '-', defined $basestr ? $basestr : '-') if $ctx->{log};
    0          
    50          
3361              
3362 300 100 100     1764 if (defined $basestr && ($basestr eq '#unresolved')) {
    100 100        
    100 66        
    100 66        
      33        
      100        
      66        
      66        
      33        
      66        
3363 7 50       34 $ctx->{warn}->($ctx, 'exec', $var, "getelem %s[%s] is unresolved", $basevar, defined $i ? $i : '');
3364             } elsif (defined $basestr && is_strval($basestr) && !is_null($basestr) && defined $idxstr && is_strval($idxstr)) { # TODO: is_numeric() for undefined vars?
3365 31         86 my $baseval = $parser->get_strval($basestr);
3366 31         80 my $pos = $parser->get_strval($idxstr);
3367              
3368             # todo: $pos might be non-numeric array-key here
3369             #
3370 31 50       145 if ($pos =~ /^[\d\.]+$/) {
3371 31         76 $pos = int($pos);
3372 31 100       74 if ($pos >= length($baseval)) {
3373             # array out of range maps to empty string
3374             # todo: support string access via brackets: $str{4}
3375             #
3376 3         25 $ctx->{warn}->($ctx, 'exec', $var, "get array index out of range %d (%d): %s", $pos, length($baseval), $baseval);
3377             # just allow off-by-one errors for now to avoid endless loops
3378             #
3379 3 50       294 if ($pos == length($baseval)) {
3380 3         20 my $ch = '';
3381 3         14 return $parser->setstr($ch);
3382             }
3383             } else {
3384 28         70 my $ch = substr($baseval, $pos, 1);
3385 28         79 my $k = $parser->setstr($ch);
3386 28 50       99 $ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s", $basestr, $pos, $ch) if $ctx->{log};
3387 28         96 return $k;
3388             }
3389             }
3390             } elsif (defined $basestr && is_array($basestr) && defined $idxstr) {
3391 169         401 my $arr = $parser->{strmap}{$basestr};
3392 169 100       391 $idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index
3393 169         533 my $arrval = $arr->get($idxstr);
3394 169 100       746 if (defined $arrval) {
3395 135 50       287 $ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s[%s]", $basevar, $idxstr, $basestr, $arrval) if $ctx->{log};
3396 135         369 return $arrval;
3397             }
3398             } elsif (!(exists $ctx->{skip}{null}) && !defined $basestr && (!$ctx->is_superglobal($basevar) || ($basevar =~ /^\$GLOBALS$/))) {
3399 20 100       68 unless ($ctx->{tainted}) {
3400 18 50       111 $ctx->{warn}->($ctx, 'exec', $var, "getelem %s[%s] not found -> #null", $basevar, defined $i ? $i : '');
3401 18         2018 return '#null';
3402             }
3403             }
3404             # simplify elem expression
3405             # (don't simplify $GLOBAL[..] references when parsing function)
3406             #
3407 116 50       831 if (exists $ctx->{simplify}{elem}) {
3408 116 50       234 if (defined $i) {
3409 116 100 100     476 if (($v ne $basevar) || ($i ne $idxstr)) {
3410 36         117 my $k = $parser->setelem($basevar, $idxstr);
3411 36 50       137 $ctx->{log}->($ctx, 'exec', $var, "simplify %s -> %s[%s]", $parser->stmt_str($var), $basevar, $idxstr) if $ctx->{log};
3412 36         126 return $k;
3413             }
3414             }
3415             }
3416 80         251 return $var;
3417             } elsif ($var =~ /^#expr\d+$/) {
3418 1618         2503 my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}};
  1618         4967  
3419 1618         2721 my $op2;
3420              
3421 1618 100 66     4739 if (($op eq '=') && defined $v2) {
3422 1030         1691 my $vv1 = $v1;
3423              
3424 1030 100       2035 if ($v1 =~ /^#obj\d+$/) {
3425 11         53 my ($inst, $prop) = $ctx->resolve_obj($v1, $in_block);
3426 11 100       32 if (defined $inst) {
3427 7         58 my $instvar = inst_var($inst, '$'.$prop);
3428 7 50       33 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to instvar $instvar") if $ctx->{log};
3429 7         16 $vv1 = $instvar;
3430             }
3431             }
3432 1030 100       1950 if ($v1 =~ /^#scope\d+$/) {
3433 9         26 my ($scope, $val) = $ctx->resolve_scope($v1, $in_block);
3434 9 50 33     34 if (defined $scope && is_variable($val)) {
3435 9         29 my $classvar = inst_var($scope, $val);
3436 9 50       28 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to classvar $classvar") if $ctx->{log};
3437 9         16 $vv1 = $classvar;
3438             }
3439             }
3440 1030 100       1886 if ($v1 =~ /^#expr\d+$/) {
3441             # calc variable name (a.e: ${ $var })
3442             #
3443 13         46 my $basevar = $ctx->resolve_varvar($v1, $in_block);
3444 13 100 66     62 if (defined $basevar && ($basevar ne $v1)) {
3445 10 50       39 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to varvar $basevar") if $ctx->{log};
3446 10         18 $vv1 = $basevar;
3447             }
3448             }
3449             # don't simplify #obj variable to $#inst\d+$var
3450             #
3451 1030 100       2286 my $vv1_sim = is_instvar($vv1) ? $v1 : $vv1;
3452              
3453 1030 50       1964 if (defined $v2) {
3454             # always track variables here for statements like '$a = $b = 1'
3455             #
3456 1030         2674 $op2 = $ctx->exec_statement($v2);
3457             }
3458 1030 100       2344 if (is_variable($vv1)) {
    100          
    100          
3459 865 100 66     5575 if (defined $op2 && ($op2 =~ /^#ref\d+$/)) {
    100 66        
    100 66        
    100          
    100          
3460 6         20 my $v = $parser->{strmap}->{$op2}->[0];
3461              
3462             # reference operator sets variable alias
3463             # (-> undo alias by unset($vv1) or by assignment of another reference)
3464             #
3465 6         25 $ctx->{varmap}{ref}{$vv1} = [$ctx, $v];
3466 6 50       21 $ctx->{log}->($ctx, 'setref', $vv1, "references $v now") if $ctx->{log};
3467             } elsif (defined $v2 && ($v2 =~ /^\$GLOBALS$/)) {
3468             # $var = $GLOBALS assignment is always equal to reference (but not superglobals)
3469             # https://php.net/manual/en/reserved.variables.globals.php
3470             #
3471 3         37 $ctx->{varmap}{ref}{$vv1} = [$ctx, $v2];
3472 3 50       22 $ctx->{log}->($ctx, 'setref', $vv1, "implicitly references GLOBALS now") if $ctx->{log};
3473             } elsif (defined $v2 && $ctx->is_superglobal($v2)) {
3474             # other superglobal assignments work only on a copy of the array
3475             # - returns 1: $_POST['a']=1; $x=$_POST; echo $x['a'];
3476             # - returns null: $x=$_POST; $_POST['a']=1; echo $x['a'];
3477             # - returns 1: $x=$_POST; $x['a']=1; echo $x['a'];
3478             # - returns null: $x=$_POST; $x['a']=1; echo $_POST['a'];
3479             # - returns null: $x["a"]="b"; $x=$_POST; echo $_POST["a"];
3480             # but normal reference work:
3481             # - returns 1 $x=&$_POST; $x["a"]=1; echo $_POST["a"];
3482             #
3483             # Note: The resulting code should track superglobal derefences,
3484             # so handle them like $GLOBALS for now.
3485             #
3486 5         14 my $a = $ctx->getvar($v2);
3487 5 100 66     39 if (defined $a && is_array($a)) {
3488 1         6 my $arr = $parser->{strmap}{$a};
3489 1         6 $arr = $arr->copy();
3490 1         4 my $a2 = $arr->{name};
3491 1 50       5 $ctx->{log}->($ctx, 'setref', $vv1, "copy defined superglobal $v2 -> $a") if $ctx->{log};
3492 1         5 $ctx->setvar($vv1, $a2, $in_block);
3493 1         5 return $parser->setexpr('=', $vv1_sim, $a2);
3494             } else {
3495             #$ctx->setvar($vv1, $v2, $in_block);
3496 4         18 $ctx->setvar($vv1, '#unresolved', $in_block);
3497 4         10 $op2 = $v2;
3498 4 50       30 $ctx->{log}->($ctx, 'setref', $vv1, "keep undefined superglobal $v2") if $ctx->{log};
3499             }
3500             } elsif ($ctx->is_unresolved_assignment($op2)) {
3501             # mark variable as unresolved if rhs is not resolvable
3502             #
3503 133         435 $ctx->setvar($vv1, '#unresolved', $in_block);
3504 133 100 66     499 if ($in_block || !exists $ctx->{varhist}) {
3505 120 50       326 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved") if $ctx->{log};
3506 120 100 100     465 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3507 25         107 return $parser->setexpr('=', $vv1_sim, $op2);
3508             }
3509 95         308 return $var;
3510             }
3511 13 50       41 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved [TRACK]") if $ctx->{log};
3512 13         48 $ctx->track_assignment($vv1, $op2);
3513 13         63 return $vv1;
3514             } elsif (is_block($op2)) {
3515             # this might be a create_function() assignment returning a
3516             # block with multiple elements.
3517             # convert '$var = { #fun; #stmt }' to '{ $var = #fun; #stmt }'
3518             #
3519 1         4 my ($type, $a) = @{$parser->{strmap}->{$op2}};
  1         7  
3520 1 50       7 if (scalar @$a > 0) {
3521 1         8 $ctx->setvar($vv1, $a->[0], $in_block);
3522 1         6 my $k = $parser->setexpr('=', $vv1_sim, $a->[0]);
3523 1         14 my $b = $parser->setblk('flat', [$k, @$a[1..@$a-1]]);
3524 1 50       5 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> converted to block $k") if $ctx->{log};
3525 1         7 return $b;
3526             } else {
3527 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "assign to var %s = %s -> %s (block)", $vv1, $v2, $op2) if $ctx->{log};
3528 0         0 $ctx->setvar($vv1, $op2, $in_block);
3529             }
3530             } else {
3531 717 50       1636 $ctx->{log}->($ctx, 'exec', $var, "assign to var %s = %s -> %s", $vv1, $v2, $op2) if $ctx->{log};
3532 717         1833 $ctx->setvar($vv1, $op2, $in_block);
3533             }
3534 730 100       1516 if ($in_block) {
3535 669 100 100     2351 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3536 218         672 return $parser->setexpr('=', $vv1_sim, $op2);
3537             }
3538             } else {
3539 61         219 return $op2;
3540             }
3541             } elsif ($v1 =~ /^#elem\d+$/) {
3542 148         268 my ($v, $i) = @{$parser->{strmap}->{$v1}};
  148         485  
3543 148         446 my $elemlist = $ctx->get_baseelem($v1, $in_block);
3544 148         298 my $basevar = $elemlist->[0];
3545 148         690 my $basestr;
3546             my $baseidx;
3547 148         0 my $idxstr;
3548 148         0 my $has_index;
3549 148         0 my $parent;
3550              
3551 148 100       528 if ($basevar =~ /^(\#elem\d+)$/) {
3552 123         194 ($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}};
  123         363  
3553 123         386 ($parent, $basestr, $basevar) = $ctx->create_basearray($elemlist, $in_block);
3554 123         237 $has_index = 1;
3555             } else {
3556 25         50 $has_index = 0; # conversion '$GLOBALS[x] -> $x'
3557 25         45 $parent = $basevar;
3558 25         66 $basestr = $ctx->exec_statement($basevar, $in_block);
3559             }
3560            
3561 148 100 66     556 if (defined $basestr && is_null($basestr)) {
3562 10         24 $basestr = undef;
3563             }
3564 148 50 66     582 if (defined $basestr && ($basestr eq '#unresolved')) {
3565 0         0 $basestr = undef;
3566             }
3567 148 100       293 if (defined $i) {
3568 123         303 $idxstr = $ctx->exec_statement($i);
3569             }
3570              
3571 148 50       475 if (defined $basevar) {
3572 148 0       404 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 %s (%s[%s]) = %s (%s) -> resolved elem-parent: %s elem-val: %s", $parser->stmt_str($v1), $basevar, defined $idxstr ? $idxstr : '-', $v2, $op2, defined $parent ? $parent : '-', defined $basestr ? $basestr : '-') if $ctx->{log};
    0          
    0          
    50          
3573              
3574 148 100 66     619 if (!$has_index) {
    100 66        
    100 66        
      66        
3575 25 100       83 if ($ctx->is_unresolved_assignment($op2)) {
3576 5         18 $ctx->setvar($basevar, "#unresolved", $in_block);
3577             } else {
3578 20         73 $ctx->setvar($basevar, $op2, $in_block);
3579             }
3580 25         140 return $parser->setexpr('=', $basevar, $op2);
3581             } elsif (defined $basestr && is_strval($basestr) && !is_null($basestr) && defined $idxstr) {
3582 3 50       21 if (is_strval($op2)) {
3583             # also allowed to change chars past end of string
3584             # (changing an empty '' string should silently allocate
3585             # an array variable)
3586             # https://php.net/manual/en/language.types.string.php
3587             #
3588 3         12 my $str = $parser->{strmap}->{$basestr};
3589 3         8 my $pos = $parser->{strmap}->{$idxstr};
3590 3         7 my $ch = $parser->{strmap}->{$op2};
3591              
3592             # todo: $pos might be non-numeric array-key here
3593             #
3594 3         14 eval { substr($str, $pos, 1) = $ch; };
  3         12  
3595 3 50       8 if ($@) {
3596 0         0 $ctx->{warn}->($ctx, 'exec', $var, "assign to elem $v1: bad set substr(%s, %s, 1) = %s", $str, $pos, $ch);
3597             }
3598 3         8 my $k = $parser->setstr($str);
3599 3         12 $ctx->setvar($v, $k, $in_block);
3600              
3601 3 50       18 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1: setstr %s [%s] (%s, %s) = %s -> %s", $basevar, $parent, $pos, $ch, $str, $k) if $ctx->{log};
3602 3         14 return $parser->setexpr('=', $v, $k);
3603             }
3604             } elsif (!defined $basestr || is_array($basestr)) {
3605 118 50       254 if (defined $basestr) {
3606 118         247 my $arr = $parser->{strmap}{$basestr};
3607 118 100       337 if (!defined $idxstr) {
    100          
3608             # $arr[] = val - appends at end of array
3609             #
3610 25 100       72 if ($ctx->is_unresolved_assignment($op2)) {
3611             # mark variable as unresolved if rhs is not resolvable
3612             #
3613 4         14 $ctx->setvar($basevar, '#unresolved', $in_block);
3614 4         33 $arr->set(undef, $v2);
3615 4 50       16 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[] = %s -> #unresolved", $v, $op2) if $ctx->{log};
3616             } else {
3617 21         107 $arr->set(undef, $op2);
3618 21 50       79 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[] = %s", $v, $op2) if $ctx->{log};
3619             }
3620             } elsif (is_strval($idxstr)) {
3621 92         218 my $key = $idxstr;
3622 92 100       252 if ($ctx->is_unresolved_assignment($op2)) {
    100          
3623 7         32 $ctx->setvar($basevar, '#unresolved', $in_block);
3624 7         41 $arr->set($key, $v2);
3625 7 50       35 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[%s] = %s -> #unresolved", $v, $idxstr, $v2) if $ctx->{log};
3626             } elsif (is_null($idxstr)) {
3627 5         18 $key = $parser->setstr(''); # null maps to '' array index
3628 5         21 $arr->set($key, $op2);
3629 5 50       18 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[null] = %s", $v, $op2) if $ctx->{log};
3630             } else {
3631 80         328 $arr->set($key, $op2);
3632 80 50       342 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[%s] = %s", $v, $idxstr, $op2) if $ctx->{log};
3633             }
3634             }
3635             } else {
3636 0 0       0 if ($ctx->is_unresolved_assignment($op2)) {
3637 0         0 $ctx->setvar($basevar, '#unresolved', $in_block);
3638             }
3639             }
3640              
3641             # keep the index-syntax instead of an array assignment.
3642             # -> $x['a']['b'] = 'foo' versus $x['a'] = array('b' => 'foo')
3643             #
3644 118 50       374 if (exists $ctx->{simplify}{expr}) {
3645 118         224 my $op1 = $v1;
3646 118 100 100     566 if (($v ne $parent) || (defined $idxstr && ($i ne $idxstr))) {
      100        
3647             # don't simplify obj-var to inst-var here
3648             #
3649 42 100 100     114 if (!is_instvar($parent) && !is_instvar($basevar)) {
3650 40         159 $op1 = $parser->setelem($parent, $idxstr);
3651             }
3652             }
3653 118 100 66     347 if ($in_block || !exists $ctx->{varhist}) {
3654 108 100 100     369 if (($v1 ne $op1) || ($v2 ne $op2)) {
3655 61         175 my $k = $parser->setexpr('=', $op1, $op2);
3656 61 50       157 $ctx->{log}->($ctx, 'exec', $var, "simplify assign to elem $v1 %s ($op1) = $v2 ($op2) -> $k (stmt)", $parser->stmt_str($v1)) if $ctx->{log};
3657 61         259 return $k;
3658             }
3659 47         195 return $var;
3660             }
3661              
3662             # track elem assignments in expressions
3663             #
3664 10 100 66     40 if (($v1 ne $op1) || ($v2 ne $op2)) {
3665 3 50       15 $ctx->{log}->($ctx, 'exec', $var, "simplify assign to elem $v1 %s ($op1) = $v2 -> $op2 [TRACK]", $parser->stmt_str($v1)) if $ctx->{log};
3666             } else {
3667 7 50       20 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 = $v2 -> $v2 [TRACK]") if $ctx->{log};
3668             }
3669 10         36 $ctx->track_assignment($op1, $op2);
3670              
3671 10 100 66     38 if (is_strval($op2) || is_array($op2)) {
3672 9         43 return $op2;
3673             }
3674 1         5 return $op1;
3675             }
3676 0         0 return $var;
3677             }
3678             }
3679 2         14 $ctx->{warn}->($ctx, 'exec', $var, "assign to elem $v1: %s not found", $parser->stmt_str($v1));
3680             } elsif ($v1 =~ /^#arr\d+$/) {
3681             # list($a,$b) = array(..)
3682             #
3683 8         23 my $arr_d = $parser->{strmap}{$v1};
3684 8         24 my $keys_d = $arr_d->get_keys();
3685              
3686 8         35 my $arr_s;
3687 8 100       28 if (is_array($op2)) {
    100          
3688 6         22 $arr_s = $parser->{strmap}{$op2};
3689             } elsif (is_strval($op2)) {
3690             # string or null list assignment sets all values to null
3691 1         4 $arr_s = $parser->newarr();
3692             }
3693 8 100       37 if (defined $arr_s) {
3694 7         16 my $keys_s = $arr_s->get_keys();
3695 7         32 my $newarr = $parser->newarr();
3696 7         34 foreach my $k (@$keys_d) {
3697 15         49 my $dst = $arr_d->val($k);
3698 15 100       48 next if (!defined $dst);
3699 14         45 my $src = $arr_s->get($k);
3700 14 100       45 if (defined $src) {
3701 12 100       33 if (is_variable($dst)) {
    50          
3702 10 50       29 if ($ctx->is_unresolved_assignment($src)) {
3703 0         0 $ctx->setvar($dst, '#unresolved', $in_block);
3704 0         0 $ctx->{warn}->($ctx, 'exec', $var, "set array key $k ($dst) is unref");
3705             } else {
3706 10         40 $ctx->setvar($dst, $src, $in_block);
3707             }
3708             } elsif ($dst =~ /^#elem\d+$/) {
3709 2         10 my ($v, $i) = @{$parser->{strmap}{$dst}};
  2         10  
3710 2 50       7 $ctx->{log}->($ctx, 'exec', $var, "assign to array $v1 = $op2 -> key $k ($dst) is elem") if $ctx->{log};
3711              
3712 2         7 my $sub = $parser->setexpr('=', $dst, $src);
3713 2         12 my $had_assigns = $ctx->have_assignments();
3714 2         9 $src = $ctx->exec_statement($sub);
3715 2 50       18 if (!$had_assigns) {
3716             # remove any pending assignments, to avoid variable
3717             # insertion for the 'sub'-assignmenmt.
3718             # The full array assignment is inserted after the loop
3719             #
3720 2         112 $ctx->discard_pending_assignments();
3721             }
3722             }
3723 12         43 $newarr->set($k, $src);
3724             }
3725             }
3726 7 100 66     57 if ($in_block || !exists $ctx->{varhist}) {
3727 4 50       18 if (($v2 ne $op2)) {
3728 0         0 my $k = $parser->setexpr('=', $v1, $op2);
3729 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "simplify assign to array $v1 = $v2 ($op2) -> $k") if $ctx->{log};
3730 0         0 return $k;
3731             }
3732 4         20 return $var;
3733             }
3734 3         15 return $newarr->{name};
3735             }
3736             }
3737 463 50       1245 if (exists $ctx->{simplify}{expr}) {
3738 463 100       1011 if ($v1 =~ /^#elem\d+$/) {
3739 2         8 $vv1 = $ctx->exec_statement($v1, $in_block);
3740 2 50       7 if (!$ctx->is_superglobal($vv1)) {
3741 2 50 33     6 if (!is_variable($vv1) && !($vv1 =~ /^#elem\d+$/)) {
3742 0         0 $vv1 = $v1;
3743             }
3744             }
3745 2         6 $vv1_sim = $vv1;
3746             }
3747              
3748 463 100 100     1503 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3749             # simplify expr
3750             #
3751 4         20 my $k = $parser->setexpr('=', $vv1_sim, $op2);
3752 4 50       18 $ctx->{log}->($ctx, 'exec', $var, "simplify assign to $v1 ($vv1_sim) = $v2 ($op2) -> $k") if $ctx->{log};
3753 4         11 return $k;
3754             }
3755             }
3756 459         1259 return $var;
3757             }
3758 588         1087 my $op1;
3759              
3760 588 100       1159 if (defined $v1) {
3761 447 50       996 if ($v1 =~ /^#stmt\d+$/) {
3762 0         0 $ctx->{warn}->($ctx, 'exec', $var, "first op $v1 is no expr");
3763 0         0 $op1 = $v1;
3764             } else {
3765 447         1492 $op1 = $ctx->exec_statement($v1, $in_block);
3766             }
3767             }
3768 588 100 66     3450 if (!defined $v1 && defined $v2 && ($op eq 'new')) {
    100 100        
    100 66        
    100 66        
      100        
      66        
3769 39 50       140 if ($v2 =~ /^#call\d+$/) {
3770 39         72 my ($name0, $arglist) = @{$parser->{strmap}->{$v2}};
  39         108  
3771              
3772             # new class()
3773             # - class properties are initialized when exec(#class) is called
3774             #
3775 39         135 my ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block);
3776 39         113 my $name = lc($name0);
3777              
3778 39         91 $name = $ctx->add_namespace($name);
3779              
3780 39         111 my $class = $ctx->getclass($name);
3781 39 100 100     174 if (defined $class && exists $ctx->{varmap}{inst}{$name}) {
3782 34         71 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  34         99  
3783 34         433 my $ctx2 = $ctx;
3784              
3785 34 50       83 $ctx->{log}->($ctx, 'new', $v2, "found class $class") if $ctx->{log};
3786              
3787             # create class instance
3788             #
3789 34         51 my $c2 = $v2;
3790 34 100       71 if ($arg_changed) {
3791 1 50       4 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  1         9  
3792 1         5 $c2 = $parser->setcall($name0, \@argssim);
3793             }
3794 34         114 my $inst = $parser->setinst($class, $c2, $ctx2);
3795 34         73 $ctx2->{varmap}{inst}{$inst} = {}; # init instance var map
3796              
3797 34 50       77 $ctx->{log}->($ctx, 'new', $v2, "clone inst vars [%s]", join(', ', keys %{$ctx2->{varmap}{inst}{$name}})) if $ctx->{log};
  0         0  
3798              
3799             # initialize instance vars with class properties
3800             #
3801 34         53 my %varmap = %{$ctx->{varmap}};
  34         198  
3802 34         70 $ctx2->{varmap}{inst}{$inst} = {%{$ctx2->{varmap}{inst}{$name}}}; # copy class var map
  34         116  
3803              
3804             # initialize instance methods class functions
3805             #
3806 34         50 my ($type, $memlist) = @{$parser->{strmap}->{$b}};
  34         92  
3807 34         105 foreach my $m (@$memlist) {
3808 59 100       187 if ($m =~ /^#fun\d+$/) {
3809 26         58 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$m}};
  26         74  
3810 26 50 33     95 if (defined $f && is_symbol($f)) {
3811 26         89 my $instvar = method_name($inst, lc($f)); # inst var default is class func
3812 26         72 my $classfunc = method_name($name, lc($f));
3813 26         100 $ctx2->{varmap}{inst}{$inst}{lc($f)} = $classfunc;
3814 26 50       82 $ctx->{log}->($ctx, 'new', $v2, "init inst func $instvar -> $classfunc") if $ctx->{log};
3815             }
3816             }
3817             }
3818              
3819             # constructor returns void
3820             #
3821 34         82 my $init = method_name($inst, '__construct');
3822 34         84 my $f = $ctx2->getfun($init);
3823 34 100       109 if (!defined $f) {
3824             # try old-style constructor (prior php80)
3825 30         67 my $init2 = method_name($inst, $name);
3826 30         60 $f = $ctx2->getfun($init2);
3827 30 100       90 if (defined $f) {
3828 2 50       9 $ctx->{log}->($ctx, 'new', $v2, "found oldstyle constructor $name") if $ctx->{log};
3829 2         7 $init = $init2;
3830             }
3831             }
3832 34 100       69 if (defined $f) {
3833 6         26 my $c = $parser->setcall($init, $arglist);
3834 6         29 my $k = $ctx2->exec_statement($c);
3835             # ignore void result
3836             }
3837 34         177 return $inst;
3838             }
3839 5 50       20 unless ($ctx->{incall}) {
3840 5 50       29 if (exists $ctx->{simplify}{stmt}) {
3841 5 50       20 if ($arg_changed) {
3842 0 0       0 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  0         0  
3843 0         0 my $c2 = $parser->setcall($name0, \@argssim);
3844 0 0       0 if ($v2 ne $c2) {
3845 0         0 my $k = $parser->setexpr('new', undef, $c2);
3846 0 0       0 $ctx->{log}->($ctx, 'new', $v2, "simplify -> $k") if $ctx->{log};
3847 0         0 return $k;
3848             }
3849             }
3850             }
3851             }
3852             }
3853             } elsif (!defined $v1 && defined $v2) {
3854 102         463 $op2 = $ctx->exec_statement($v2, $in_block);
3855              
3856 102 100 100     553 if ($op eq '$') {
    100 100        
3857 48         176 my $var1 = $parser->varvar_to_var($op2);
3858 48 100       147 if (defined $var1) {
3859 42         107 return $ctx->exec_statement($var1);
3860             }
3861 6 50       30 if (exists $ctx->{simplify}{expr}) {
3862 6 100 66     21 if (is_variable($op2) && ($v2 ne $op2)) {
3863             # simplify expr
3864             #
3865 5         38 my $k = $parser->setexpr($op, undef, $op2);
3866 5 50       32 $ctx->{log}->($ctx, 'exec', $var, "simplify varvar $v2 ($op2) -> $k") if $ctx->{log};
3867 5         17 return $k;
3868             }
3869             }
3870             } elsif ((($op eq '--') || ($op eq '++')) && is_variable($v2)) {
3871             # ++$var
3872             # --$var
3873             #
3874 19 100       52 if (is_strval($op2)) {
3875 18         77 my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op2);
3876              
3877 18 50       52 if (defined $val) {
3878 18 50       44 $ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op, $op2, $val, $result) if $ctx->{log};
3879              
3880 18         47 my $k = $parser->setexpr('=', $v2, $val);
3881 18         59 my $res = $ctx->exec_statement($k, $in_block);
3882 18         55 return $res;
3883             }
3884             } else {
3885             # remove from varmap to avoid later simplification
3886             #
3887 1         4 $ctx->setvar($v2, '#unresolved', $in_block);
3888             }
3889             } else {
3890 35 100 100     114 if (is_strval($op2) || is_array($op2)) {
3891 21         87 my ($k, $result) = PHP::Decode::Op::unary($parser, $op, $op2);
3892 21 50       53 if (defined $k) {
3893 21 50       58 $ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op, $op2, $k, $result) if $ctx->{log};
3894 21         63 return $k;
3895             } else {
3896 0         0 $ctx->{warn}->($ctx, 'exec', $var, "%s %s -> failed", $op, $op2);
3897             }
3898             }
3899             }
3900 16 50       92 if (exists $ctx->{simplify}{expr}) {
3901 16 50       52 if (is_instvar($op2)) {
3902 0         0 $op2 = $v2;
3903             }
3904 16 100       79 if ($v2 ne $op2) {
3905             # simplify expr
3906             #
3907 8         52 my $k = $parser->setexpr($op, undef, $op2);
3908 8 50       37 $ctx->{log}->($ctx, 'exec', $var, "simplify unary $var: $op $v2 ($op2) -> $k") if $ctx->{log};
3909 8         23 return $k;
3910             }
3911             }
3912             } elsif (defined $v1 && is_strval($op1) && !defined $v2) {
3913             # $var++
3914             # $var--
3915             #
3916 49 50       120 if (is_strval($op1)) {
3917 49         198 my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op1);
3918 49 50       131 if (defined $val) {
3919 49 50       134 $ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op1, $op, $val, $result) if $ctx->{log};
3920              
3921 49         146 my $k = $parser->setexpr('=', $v1, $val);
3922 49         180 my $res = $ctx->exec_statement($k, $in_block);
3923              
3924             # if assignment is tracked, return old value instead
3925             # of new value here.
3926             #
3927 49 100 66     324 if (defined $res && ($res !~ /^#expr\d+$/)) {
3928 27         47 $res = $op1;
3929             }
3930 49         171 return $res;
3931             }
3932             } else {
3933             # remove from varmap to avoid later simplification
3934             #
3935 0         0 $ctx->setvar($v1, '#unresolved', $in_block);
3936             }
3937             } elsif (defined $v1 && defined $v2) {
3938 384 50       766 if ($v1 =~ /^#stmt\d+$/) {
3939 0         0 $ctx->{warn}->($ctx, 'exec', $var, "second op $v2 is no expr");
3940 0         0 $op2 = $v2;
3941             } else {
3942 384 100 66     3162 if (!$in_block && (($op eq '||') || ($op eq 'or') || ($op eq '&&') || ($op eq 'and') || ($op eq '?') || ($op eq ':'))) {
      66        
3943 23 50       81 $ctx->{log}->($ctx, 'exec', $var, "set in_block for lazy or ordered evaluation") if $ctx->{log};
3944 23         40 $in_block = 1;
3945             }
3946 384         832 $op2 = $ctx->exec_statement($v2, $in_block);
3947             }
3948              
3949 384 100 100     985 if ((is_strval($op1) || is_array($op1)) && (is_strval($op2) || is_array($op2))) {
    100 100        
    50 100        
    50 33        
    50 33        
    100 66        
      100        
3950 254 100 66     983 if (($op ne '?') && ($op ne ':')) {
3951 242         837 my ($k, $result) = PHP::Decode::Op::binary($parser, $op1, $op, $op2);
3952 242 100       487 if (defined $k) {
3953 241 50       627 $ctx->{log}->($ctx, 'exec', $var, "%s %s %s -> %s", $op1, $op, $op2, $k) if $ctx->{log};
3954 241         698 return $k;
3955             } else {
3956 1         8 $ctx->{warn}->($ctx, 'exec', $var, "%s %s %s -> failed", $op1, $op, $op2);
3957             }
3958             }
3959             } elsif ($op eq '?') {
3960 15 50 66     35 if ((is_strval($op1) || is_array($op1)) && ($op2 =~ /^#expr\d+$/) && ($parser->{strmap}->{$op2}->[0] eq ':')) {
      66        
      66        
3961             # ternary: $expr1 ? $expr2 : $expr3
3962             # represented as [$op1 ? [$op2 : $op3]]
3963             #
3964 7         22 my $val = $parser->{strmap}{$op1};
3965 7 50       17 if (is_array($op1)) {
3966 0         0 my $arr = $parser->{strmap}{$op1};
3967 0         0 $val = !$arr->empty();
3968             }
3969 7         13 my $k;
3970 7 100       15 if ($val) {
3971 5         16 $k = $ctx->exec_statement($parser->{strmap}->{$op2}->[1]);
3972             } else {
3973 2         8 $k = $ctx->exec_statement($parser->{strmap}->{$op2}->[2]);
3974             }
3975 7         20 return $k;
3976             }
3977             } elsif (($op eq '===') && ($op1 eq '#null')) {
3978 0         0 my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null', [$op2]);
3979 0 0       0 if (defined $k) {
3980 0         0 return $k;
3981             }
3982             } elsif (($op eq '===') && ($op2 eq '#null')) {
3983 0         0 my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null', [$op1]);
3984 0 0       0 if (defined $k) {
3985 0         0 return $k;
3986             }
3987             } elsif (($op eq '==') && ($op1 eq '#null')) {
3988 0         0 my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null_weak', [$op2]);
3989 0 0       0 if (defined $k) {
3990 0         0 return $k;
3991             }
3992             } elsif (($op eq '==') && ($op2 eq '#null')) {
3993 1         6 my $k = PHP::Decode::Func::exec_cmd($ctx, 'is_null_weak', [$op1]);
3994 1 50       4 if (defined $k) {
3995 0         0 return $k;
3996             }
3997             }
3998              
3999 136 50       398 if (exists $ctx->{simplify}{expr}) {
4000 136 50       286 if (is_instvar($op1)) {
4001 0         0 $op1 = $v1;
4002             }
4003 136 50       262 if (is_instvar($op2)) {
4004 0         0 $op2 = $v2;
4005             }
4006 136 100 100     520 if (($v1 ne $op1) || ($v2 ne $op2)) {
4007             # simplify expr (no variable setting must occur)
4008             #
4009 40         138 my $k = $parser->setexpr($op, $op1, $op2);
4010 40 50       125 $ctx->{log}->($ctx, 'exec', $var, "simplify binary %s (%s) %s %s (%s) -> %s", $v1, $op1, $op, $v2, $op2, $k) if $ctx->{log};
4011 40         126 return $k;
4012             }
4013             }
4014             }
4015 123         365 return $var;
4016             } elsif ($var =~ /^#call\d+$/) {
4017 733         1235 my ($name, $arglist) = @{$parser->{strmap}->{$var}};
  733         2262  
4018 733         1317 my $cmd = $name;
4019 733         1238 my $cmdsim = $name;
4020              
4021 733 100 100     1564 if (is_variable($name) || ($name =~ /^#elem\d+$/) || ($name =~ /^#expr\d+$/) || ($name =~ /^#stmt\d+$/) || is_block($name)) {
    100 100        
    100 66        
    100 100        
    100          
4022 26         73 my $s = $ctx->exec_statement($name);
4023 26 100       156 if ($s =~ /^#fun\d+$/) {
    100          
4024 8         17 $cmd = $s;
4025 8         15 $cmdsim = $s;
4026             } elsif (!is_null($s)) {
4027 16 100       56 if (is_strval($s)) {
4028 13         35 $cmd = $parser->{strmap}->{$s};
4029             } else {
4030 3         14 $cmd = $s;
4031             }
4032 16         34 $cmdsim = $cmd;
4033             }
4034 26 50       76 $ctx->{log}->($ctx, 'exec', $var, "map %s (%s) -> %s", $name, $s, $cmd) if $ctx->{log};
4035             } elsif ($name =~ /^#obj\d+$/) {
4036 28         136 my ($inst, $prop) = $ctx->resolve_obj($name);
4037 28 100       82 if (defined $inst) {
4038 18 50       45 if (is_symbol($prop)) {
4039 18         41 $cmd = method_name($inst, $prop);
4040             } else {
4041 0         0 my ($o, $m) = @{$parser->{strmap}->{$name}};
  0         0  
4042 0 0       0 if ($m ne $prop) {
4043 0         0 $cmdsim = $parser->setobj($o, $prop);
4044 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "obj simplify partial $name: -> $cmdsim") if $ctx->{log};
4045             }
4046             }
4047             }
4048 28 50       86 $ctx->{log}->($ctx, 'exec', $var, "map obj %s -> %s", $name, $cmd) if $ctx->{log};
4049             } elsif ($name =~ /^#scope\d+$/) {
4050 24         96 my ($scope, $val) = $ctx->resolve_scope($name);
4051 24 100       72 if (defined $scope) {
4052 21 50       60 if (is_symbol($val)) {
4053 21         68 $cmd = method_name($scope, $val);
4054 21         43 $cmdsim = $cmd;
4055             }
4056             }
4057 24 50       77 $ctx->{log}->($ctx, 'exec', $var, "map scope %s -> %s", $name, $cmd) if $ctx->{log};
4058             } elsif ($name =~ /^#ns\d+$/) {
4059 2         6 my ($ns, $val) = $ctx->resolve_ns($name);
4060 2 50       15 if (defined $ns) {
4061 2         8 $cmd = $parser->ns_to_str($name);
4062 2         13 $cmdsim = $cmd;
4063             }
4064 2 50       21 $ctx->{log}->($ctx, 'exec', $var, "map ns %s -> %s", $name, $cmd) if $ctx->{log};
4065             } elsif (is_symbol($name)) {
4066 635         1011 $cmd = $name;
4067 635         881 $cmdsim = $cmd;
4068             }
4069              
4070             # function passed by name, by reference or anonymous function
4071             #
4072 733         1395 my $fun;
4073 733 100       1760 $fun = $cmd if ($cmd =~ /^#fun\d+$/);
4074 733 100       1504 unless (defined $fun) {
4075 722         1724 my $ncmd = $ctx->add_namespace($cmd);
4076 722         1586 $fun = $ctx->getfun($ncmd);
4077 722 100       1403 if (defined $fun) {
4078 198         353 $cmd = $ncmd;
4079             }
4080             }
4081 733 100       1356 if (defined $fun) {
4082 209         586 my $cmd1 = _is_wrapped_call($parser, $fun);
4083 209 100       456 if (defined $cmd1) {
4084 4 50       12 $ctx->{log}->($ctx, 'exec', $var, "map wrapped %s -> %s", $cmd, $cmd1) if $ctx->{log};
4085 4         8 $cmd = $cmd1;
4086 4         7 $cmdsim = $cmd1;
4087 4         10 $fun = $ctx->getfun($cmd);
4088             }
4089             }
4090              
4091 733         1458 my $args = [];
4092 733         1156 my $arg_changed = 0;
4093              
4094 733 100 66     3330 if (defined $fun) {
    100 66        
    100          
4095 205 50       472 unless (exists $ctx->{skip}{call}) {
4096 205         297 my ($_name, $param, $block, $p) = @{$parser->{strmap}->{$fun}};
  205         573  
4097              
4098 205         560 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, $param, $in_block);
4099              
4100 205         640 my ($key, $code);
4101 205 50       553 if (exists $ctx->{with}{translate}) {
4102 0         0 my $perl = $parser->translate_func($fun, undef, 0);
4103 0 0       0 if (defined $perl) {
4104 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "translated $fun -> $perl") if $ctx->{log};
4105 0         0 my $sub = eval($perl);
4106 0 0       0 if ($@) {
4107 0         0 $ctx->{warn}->($ctx, 'exec', $var, "eval $fun failed: $@");
4108             } else {
4109 0 0 0     0 if ((scalar @$args == 1) && is_strval($args->[0])) {
4110 0         0 my $val = $parser->{strmap}->{$args->[0]};
4111 0         0 my $res = eval { &$sub($val) };
  0         0  
4112 0 0       0 if ($@) {
4113 0         0 $ctx->{warn}->($ctx, 'exec', $var, "eval $fun ERR: %s", $@);
4114             } else {
4115 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "eval $fun => %s", defined $res ? $res : 'undef') if $ctx->{log};
    0          
4116 0 0       0 if (defined $res) {
4117             #if ($res =~ /^[0-9][0-9\.]+$/) {
4118 0 0       0 if ($res =~ /^[0-9]+$/) {
4119 0         0 $key = $parser->setnum($res);
4120             } else {
4121 0         0 $key = $parser->setstr($res);
4122             }
4123 0         0 $code = '';
4124             }
4125             }
4126             }
4127             }
4128             }
4129             }
4130 205 50       442 unless (defined $key) {
4131 205         518 ($key, $code) = $ctx->exec_func($cmd, $args, $param, $block);
4132             }
4133 205 100       565 if (!defined $key) {
4134 5 50       30 my $info = $ctx->get_unresolved_info($cmd, defined $code ? $code : $block);
4135              
4136 5 50       36 unless (keys %{$info->{unresolved}}) {
  5         23  
4137 5 50       19 $ctx->{warn}->($ctx, 'func', $cmd, "%s executed (but no additional taint) (globals[%s])", defined $code ? 'partially' : 'not', join(' ', keys %{$info->{global_assigns}}));
  5         32  
4138 5         225 $ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]);
  5         41  
4139 5         26 $key = '#notaint';
4140             } else {
4141 0 0       0 $ctx->{warn}->($ctx, 'func', $cmd, "%s executed (unresolved[%s] globals[%s])", defined $code ? 'partially' : 'not', join(' ', keys %{$info->{unresolved}}), join(' ', keys %{$info->{global_assigns}}));
  0         0  
  0         0  
4142             }
4143             }
4144 205 50       440 if (defined $key) {
4145             # register exposed funcs
4146             #
4147 205 100       372 if (defined $code) {
4148 181 100       536 if (is_block($code)) {
4149 169         248 my ($type, $a) = @{$parser->{strmap}->{$code}};
  169         534  
4150 169         431 register_funcs($a, $ctx, $parser);
4151             } else {
4152 12         44 register_funcs([$code], $ctx, $parser);
4153             }
4154             }
4155 205 100       513 if ($key ne '#construct') {
4156 199         335 my $name_changed = 0;
4157 199 100       405 if ($cmd ne $name) {
4158             # expand anonymous function if not variable in #call
4159             #
4160 56 100 100     252 if (($cmd =~ /^#fun\d+$/) && is_variable($name)) {
    50          
4161 6         18 $cmd = $name;
4162             } elsif (is_instvar($cmd)) {
4163             # don't simplify obj-var to inst-var here
4164 0         0 $cmd = $name;
4165             } else {
4166 50         97 $name_changed = 1;
4167             }
4168             }
4169              
4170             # insert simplified or anonymous function
4171             # (but keep calls in lazy evaluated expressions like '$x || f()')
4172             #
4173 199         290 my $c;
4174 199         496 my $v = '$'.'eval'.'$'.$cmd;
4175             #my $v = '$'.'call'.'$'.$cmd;
4176 199 100 100     760 if (defined $code && !$in_block) {
4177 173         346 $c = $code;
4178             } else {
4179 26 100 100     150 if ($name_changed || $arg_changed) {
4180 13 50       57 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  8         54  
4181 13         48 $c = $parser->setcall($cmdsim, \@argssim);
4182             } else {
4183 13         34 $c = $var;
4184             }
4185             }
4186 199 100       505 if ($key eq '#notaint') {
    100          
4187 7         26 $key = $c;
4188             } elsif ($in_block) {
4189 4 50 33     12 if ((is_strval($key) || is_array($key) || _anon_func_call($parser, $key)) && defined $code && $parser->is_empty_block($code)) {
      33        
      33        
4190             # keep simple key & ignore call if no code to inline is left
4191 0 0       0 $ctx->{log}->($ctx, 'exec', $var, "%s(%s) -> keep key $key and ignore empty code $code", $cmd, join(' , ', @$arglist)) if $ctx->{log};
4192             } else {
4193 4         9 $key = $c;
4194             }
4195             } else {
4196 188         581 $ctx->track_assignment($v, $c);
4197              
4198             # void functions return 'null'. If null is not assigned,
4199             # it will be removed in later flatten_block() calls.
4200             #
4201 188 100       499 if ($key eq '#noreturn') {
4202 62         121 $key = '#null';
4203             }
4204             }
4205             }
4206 205 100       428 if ($key eq '#construct') {
4207             # insert simplified anonymous function here
4208             #
4209 6         20 my $methodname = $ctx->lookup_method_name($cmd);
4210 6 50       23 if (defined $methodname) {
4211 6         18 my ($classname, $prop) = method_split($methodname);
4212 6         16 my $f;
4213 6 50       16 unless ($f = _anon_func_call($parser, $code)) {
4214 6         22 $f = $parser->setfun(undef, [], $code);
4215             }
4216 6         33 my $v = '$__'.$classname.'_'.'__construct';
4217 6         21 $ctx->track_assignment($v, $f); # always track this variable
4218             }
4219             }
4220 205 0       459 $ctx->{log}->($ctx, 'exec', $var, "%s(%s) -> %s [%s]", $cmd, join(' , ', @$arglist), $key, defined $code ? $code : '-') if $ctx->{log};
    50          
4221 205         727 return $key;
4222             } else {
4223 0         0 $ctx->set_tainted($var);
4224 0         0 $ctx->invalidate_arglist_refs($arglist, $param, $in_block);
4225             }
4226             } else {
4227 0         0 $ctx->set_tainted($var);
4228             }
4229             } elsif ((lc($cmd) eq 'eval') && (scalar @$arglist == 1)) {
4230 56         191 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block);
4231              
4232             # linenum restarts with line 1 for each eval() and is increased
4233             # for each newline in evalstring (verified with php).
4234             # (the __FILE__ content keeps the same)
4235             #
4236 56         175 my $oldline = $parser->{strmap}->{'__LINE__'};
4237 56         113 $parser->{strmap}->{'__LINE__'} = 1;
4238 56         155 my $parser2 = $parser->subparser();
4239 56         170 my $ctx2 = $ctx->subctx(parser => $parser2, varhist => {});
4240 56         185 my $blk = $ctx2->parse_eval($args->[0]);
4241 56         116 my $key;
4242 56 100       160 if (defined $blk) { # might be non-string
4243 48         182 $key = $ctx2->exec_eval($blk);
4244             }
4245 56         130 $parser->{strmap}->{'__LINE__'} = $oldline;
4246              
4247 56 100       146 if (defined $key) {
4248 48         102 my $result = $parser->{strmap}->{$key};
4249              
4250             # eval returns concatted list of statements (as example a single #str)
4251             #
4252 48 50       119 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) -> %s", $cmd, $arglist->[0], $key) if $ctx->{log};
4253              
4254 48 100       109 if (is_block($key)) {
4255 13         40 my ($type, $a) = @{$parser->{strmap}->{$key}};
  13         54  
4256 13         44 register_funcs($a, $ctx, $parser);
4257             } else {
4258 35         139 register_funcs([$key], $ctx, $parser);
4259             }
4260              
4261 48         128 my @seq = ();
4262 48         170 $parser->flatten_block($key, \@seq);
4263 48         162 my $r = _final_break($parser, $key, '(return)');
4264 48 100       116 if (defined $r) {
4265 3         6 my $arg = $parser->{strmap}->{$r}->[1];
4266              
4267 3         13 my $r2 = pop(@seq); # remove return statement from block
4268 3 50       7 if ($r ne $r2) {
4269 0         0 $ctx->{warn}->($ctx, 'eval', $var, "%s return mismatch $r != $r2", $parser->stmt_str($var));
4270             }
4271 3 100       8 if (scalar @seq > 0) {
4272             # insert simplified block without return here
4273 1         7 my $b = $parser->setblk('flat', [@seq]);
4274 1         10 my $v = '$eval$'.$var;
4275 1         8 $ctx->track_assignment($v, $b); # track special $eval variable
4276 1 50       6 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns block %s [TRACK]", $cmd, $arglist->[0], $b) if $ctx->{log};
4277             } else {
4278 2 50       6 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns %s", $cmd, $arglist->[0], $r) if $ctx->{log};
4279             }
4280 3         22 return $arg;
4281             }
4282              
4283             # keep eval() around unresolved assignments for output
4284             # (can't use $ctx->can_inline($key) here - local vars are valid).
4285             #
4286 45         141 my $resolved_eval = $ctx->can_inline_eval($key);
4287              
4288 45 50 33     132 if (!$resolved_eval && (scalar @seq == 1)) {
4289 0         0 my $k = $parser->setcall('eval', [$key]);
4290 0 0       0 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) keep eval around return -> %s", $cmd, $arglist->[0], $key) if $ctx->{log};
4291 0         0 return $k;
4292             }
4293              
4294 45 50       105 if ($key ne '#null') {
4295 45         122 my $v = '$eval$x'.$var;
4296 45         138 $ctx->track_assignment($v, $key); # track special $eval variable
4297 45 50       110 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) track last %s", $cmd, $arglist->[0], $key) if $ctx->{log};
4298             #$key = $parser->setblk('flat', []);
4299 45         88 $key = '#null';
4300             }
4301 45         304 return $key;
4302             }
4303 8 50       28 if (exists $ctx->{simplify}{call}) {
4304 8 100       37 if ($args->[0] =~ /^#call\d+$/) {
4305             # call without eval can not generate 'return '
4306 3         9 my $name = $parser->{strmap}->{$args->[0]}->[0];
4307              
4308 3 100       12 if (!PHP::Decode::Func::func_may_return_string($name)) {
4309 1         4 my $v = '$eval$x'.$var;
4310 1         5 $ctx->track_assignment($v, $args->[0]); # track special $eval variable
4311 1 50       4 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) track call $args->[0]", $cmd, $arglist->[0]) if $ctx->{log};
4312 1         7 return '#null';
4313             }
4314             }
4315             }
4316 7         23 $ctx->set_tainted($var); # eval() might always change variables
4317             } elsif (($cmd eq 'assert') && (scalar @$arglist == 1)) {
4318 4         28 my $val = $arglist->[0];
4319 4         16 my $key = $ctx->exec_statement($val);
4320              
4321 4 50       21 if (is_strval($key)) {
4322 4         18 my $e = $parser->setcall('eval', [$val]);
4323 4         13 $key = $ctx->exec_statement($e);
4324             }
4325 4         18 return $key;
4326             } else {
4327 468 100       1248 if ($cmd =~ /^\\(.*)$/) {
4328 1         6 $cmd = $1; # remove absolute namespace
4329             }
4330 468         1423 my $f = PHP::Decode::Func::get_php_func($cmd);
4331              
4332 468 100 100     1727 if (defined $f && exists $f->{param}) {
4333 24         73 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, $f->{param}, $in_block);
4334             } else {
4335 444         1333 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block);
4336             }
4337 468         1594 my $key = PHP::Decode::Func::exec_cmd($ctx, $cmd, $args);
4338 468 100       987 if (defined $key) {
4339 187 50       462 $ctx->{log}->($ctx, 'cmd', $var, "%s(%s) -> %s = %s", $cmd, join(' , ', @$args), $key, $parser->shortstr($parser->get_strval_or_str($key), 60)) if $ctx->{log};
4340              
4341 187 100       446 if ($key eq '#noreturn') {
4342 3         6 $key = $var;
4343 3 50 33     17 if (($name ne $cmdsim) || $arg_changed) {
4344 0 0       0 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  0         0  
4345 0         0 $key = $parser->setcall($cmdsim, \@argssim);
4346 0 0       0 $ctx->{log}->($ctx, 'cmd', $var, "simplify %s -> %s = %s(%s)", $parser->stmt_str($var), $key, $cmdsim, join(' , ', @argssim)) if $ctx->{log};
4347             }
4348             }
4349 187         700 return $key;
4350             }
4351 281 100       608 if (defined $f) {
4352 55 100       196 if (exists $f->{param}) {
4353 2         10 $ctx->invalidate_arglist_refs($arglist, $f->{param}, $in_block);
4354             }
4355             } else {
4356 226         1208 $ctx->{warn}->($ctx, 'cmd', $var, "not found %s(%s)", $cmd, join(', ', @$arglist));
4357             }
4358 281 100       18766 if (PHP::Decode::Func::func_may_call_callbacks($cmd)) {
4359 229         816 $ctx->set_tainted($var);
4360             }
4361             }
4362             # simplify function params for failed call
4363             #
4364 288 50       753 if (exists $ctx->{simplify}{call}) {
4365 288 50       674 if (is_instvar($cmdsim)) {
4366 0         0 $cmdsim = $name;
4367             }
4368 288 100       1023 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  161         852  
4369              
4370 288 100 100     1298 if (($name ne $cmdsim) || $arg_changed) {
4371 69         305 my $k = $parser->setcall($cmdsim, \@argssim);
4372 69         358 $ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s) -> %s %s", $cmd, join(', ', @$arglist), $k, $parser->stmt_str($k));
4373 69         3809 return $k;
4374             }
4375             }
4376 219         1099 $ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s)", $cmd, join(', ', @$arglist));
4377 219         13832 return $var;
4378             } elsif ($var =~ /^#blk\d+$/) {
4379 1299         2088 my ($type, $arglist) = @{$parser->{strmap}->{$var}};
  1299         3623  
4380 1299         2528 my @args = ();
4381 1299         2027 my $changed = 0;
4382 1299         2458 foreach my $p (@$arglist) {
4383 2138         3373 my $keep_assign = 0;
4384              
4385 2138 100 100     7490 if (($type ne 'brace') && ($type ne 'expr')) {
4386 2018         3969 my ($rhs, $lhs) = _var_assignment($parser, $p);
4387 2018 100 100     5411 if (defined $rhs || _is_increment_op($parser, $p)) {
4388 810 50       1804 $ctx->{log}->($ctx, 'exec', $var, "keep assignment $p intact -> set in_block") if $ctx->{log};
4389 810         1526 $keep_assign = 1;
4390             }
4391             }
4392 2138 100       6221 my $v = $ctx->exec_statement($p, $keep_assign ? 1 : $in_block);
4393 2138 50       4767 unless (defined $v) {
4394 0         0 last;
4395             }
4396              
4397             # insert assignments only in code blocks. Assigments
4398             # in expressions are inserted into the next outer block.
4399             #
4400 2138 100 100     6937 if (($type ne 'brace') && ($type ne 'expr')) {
4401 2018         4908 my $v1 = $ctx->insert_assignments($v);
4402 2018 100       4261 if ($v1 ne $v) {
4403 141 50       459 if (exists $ctx->{with}{optimize_block_vars}) {
4404 0         0 my @seq = ();
4405 0         0 $parser->flatten_block($v1, \@seq);
4406 0         0 $ctx->optimize_loop_var_list('exec', $var, \@args, \@seq);
4407             } else {
4408 141         372 $parser->flatten_block($v1, \@args);
4409             }
4410 141         284 $changed = 1;
4411             } else {
4412 1877         5212 $parser->flatten_block($v, \@args);
4413             }
4414             } else {
4415 120         391 $parser->flatten_block($v, \@args);
4416             }
4417 2138 100       4275 if ($p ne $v) {
4418 1027         1641 $changed = 1;
4419             }
4420 2138         4315 my $f = _final_break($parser, $v, '(break|continue|return)');
4421 2138 100       5317 if (defined $f) {
4422 256 100       658 if (scalar @args < scalar @$arglist) {
4423 9         19 $changed = 1;
4424             }
4425 256         539 last;
4426             }
4427             }
4428             # evaluate block to string or anonymous func if possible
4429             #
4430 1299 100 100     4187 if (scalar @args == 1 && (is_strval($args[0]) || ($args[0] =~ /^#fun\d+$/))) {
      100        
4431 92 50       290 $ctx->{log}->($ctx, 'exec', $var, "reduce: $arglist->[0] -> $args[0]") if $ctx->{log};
4432 92         259 return $args[0];
4433             }
4434 1207 100       2496 if ($changed) {
4435 743         1854 $var = $parser->setblk($type, \@args);
4436             }
4437 1207         3825 return $var;
4438             } elsif ($var =~ /^#stmt\d+$/) {
4439 710         1919 my $cmd = $parser->{strmap}->{$var}->[0];
4440              
4441 710 100       4530 if ($cmd eq 'echo') {
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
4442 184         380 my $arglist = $parser->{strmap}->{$var}->[1];
4443 184         379 my @param = ();
4444 184         296 my $all_str = 1;
4445 184         290 my $changed = 0;
4446              
4447 184         381 foreach my $p (@$arglist) {
4448 193 100 100     389 if (!is_strval($p) || is_const($p)) {
4449 107         459 my $v = $ctx->exec_statement($p);
4450 107         290 push(@param, $v);
4451 107 100       264 if ($v ne $p) {
4452 88         181 $changed = 1;
4453             }
4454 107 100       249 unless (is_strval($v)) {
4455 31         119 $all_str = 0;
4456             }
4457             } else {
4458 86         270 push(@param, $p);
4459             }
4460             }
4461             # keep consts in simplified statement
4462             #
4463 184 100 100     542 my @paramsim = map { (is_const($arglist->[$_]) && !$parser->is_magic_const($arglist->[$_]) && !exists $ctx->{defines}{$parser->{strmap}{$arglist->[$_]}}) ? $arglist->[$_] : $param[$_] } 0..$#param;
  193         499  
4464              
4465 184         481 my $v = $parser->{strmap}->{$var};
4466              
4467             # echo echoes also non-quoted arguments (undefined constants propagate to string)
4468             # (keep them separated here if not all arguments could get resolved)
4469             #
4470 184 100 100     743 if ($all_str && (scalar @param > 1)) {
4471 4         30 my $res = join('', map { $parser->{strmap}->{$_} } @param);
  12         37  
4472 4         25 my $k = $parser->setstr($res);
4473 4         28 @param = ($k);
4474 4         10 $changed = 1;
4475             }
4476 184 100       496 unless ($ctx->{skipundef}) {
4477 119 100 66     540 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
4478 117 100       309 if (exists $ctx->{globals}{stdout}{ob}) {
4479 1         2 push(@{$ctx->{globals}{stdout}{ob}}, @param);
  1         13  
4480             } else {
4481 116         196 push(@{$ctx->{globals}{stdout}{buf}}, @param);
  116         426  
4482             }
4483             }
4484             }
4485 184 50       453 if (exists $ctx->{simplify}{stmt}) {
4486 184 100       367 if ($changed) {
4487 84 100       217 if (scalar @paramsim > 1) {
4488 5         22 merge_str_list(\@paramsim, $parser);
4489             }
4490 84         330 my $k = $parser->setstmt(['echo', \@paramsim]);
4491 84 50       238 $ctx->{log}->($ctx, 'echo', $var, "simplify -> $k") if $ctx->{log};
4492 84         272 return $k;
4493             }
4494             }
4495 100         319 return $var;
4496             } elsif ($cmd eq 'print') {
4497 0         0 my $arg = $parser->{strmap}->{$var}->[1];
4498 0         0 my $v = $ctx->exec_statement($arg);
4499              
4500 0 0       0 unless ($ctx->{skipundef}) {
4501 0 0 0     0 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
4502 0 0       0 if (exists $ctx->{globals}{stdout}{ob}) {
4503 0         0 push(@{$ctx->{globals}{stdout}{ob}}, $v);
  0         0  
4504             } else {
4505 0         0 push(@{$ctx->{globals}{stdout}{buf}}, $v);
  0         0  
4506             }
4507             }
4508             }
4509 0 0       0 if (exists $ctx->{simplify}{stmt}) {
4510 0 0       0 if ($v ne $arg) {
4511 0         0 my $k = $parser->setstmt(['print', $v]);
4512 0 0       0 $ctx->{log}->($ctx, 'print', $var, "simplify -> $k") if $ctx->{log};
4513 0         0 return $k;
4514             }
4515             }
4516 0         0 return $var;
4517             } elsif ($cmd eq 'global') {
4518 10         45 my $arglist = $parser->{strmap}->{$var}->[1];
4519 10         23 my @param = ();
4520              
4521 10         25 foreach my $v (@$arglist) {
4522 10 50       25 if (is_variable($v)) {
4523 10 50       30 if ($ctx->is_superglobal($v)) {
4524 0 0       0 $ctx->{log}->($ctx, 'global', $var, "ignore global superglobal $v") if $ctx->{log};
4525             } else {
4526 10         36 $ctx->{varmap}{global}{$v} = 1;
4527 10 50       36 $ctx->{log}->($ctx, 'global', $var, "set func var $v global") if $ctx->{log};
4528             }
4529             }
4530             }
4531 10         27 return $var;
4532             } elsif ($cmd eq 'static') {
4533 15         35 my $arglist = $parser->{strmap}->{$var}->[1];
4534 15         28 my @param = ();
4535              
4536 15         36 foreach my $v (@$arglist) {
4537 15 100       62 if (is_variable($v)) {
    50          
4538 10 50       66 if ($ctx->is_superglobal($v)) {
4539 0 0       0 $ctx->{log}->($ctx, 'static', $var, "ignore static superglobal $v") if $ctx->{log};
4540             } else {
4541 10 100       52 if ($ctx->{infunction}) {
    50          
4542 3 100       16 unless (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v}) {
4543 1         4 $ctx->{varmap}{static}{$ctx->{infunction}}{$v} = undef;
4544 1 50       4 $ctx->{log}->($ctx, 'static', $var, "set static func var $v") if $ctx->{log};
4545             }
4546             } elsif (exists $ctx->{class_scope}) {
4547 7 50       29 unless (exists $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v}) {
4548 7         22 $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v} = undef;
4549 7 50       27 $ctx->{log}->($ctx, 'static', $var, "set static class var $v") if $ctx->{log};
4550             }
4551             } else {
4552 0 0       0 $ctx->{log}->($ctx, 'static', $var, "ignore toplevel static var $v") if $ctx->{log};
4553             }
4554             }
4555             } elsif ($v =~ /^#expr\d+$/) {
4556 5         11 my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}};
  5         14  
4557 5 50       14 if ($op eq '=') {
4558 5 50       17 if ($ctx->is_superglobal($v1)) {
4559 0 0       0 $ctx->{log}->($ctx, 'static', $var, "ignore static superglobal $v1") if $ctx->{log};
4560             } else {
4561 5 100       19 if ($ctx->{infunction}) {
    50          
4562 3 100       14 unless (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v1}) {
4563 1         4 $ctx->{varmap}{static}{$ctx->{infunction}}{$v1} = $v2;
4564 1 50       6 $ctx->{log}->($ctx, 'static', $var, "set static func var $v1 = $v2") if $ctx->{log};
4565             }
4566             } elsif (exists $ctx->{class_scope}) {
4567 2 50       10 unless (exists $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v1}) {
4568 2         6 $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v1} = $v2;
4569 2 50       8 $ctx->{log}->($ctx, 'static', $var, "set static class var $v1 = $v2") if $ctx->{log};
4570             }
4571             } else {
4572 0 0       0 $ctx->{log}->($ctx, 'static', $var, "ignore toplevel static var $v1") if $ctx->{log};
4573             }
4574             }
4575             } else {
4576 0         0 $ctx->{warn}->($ctx, 'static', $var, "bad init $v");
4577             }
4578             } else {
4579 0         0 my $k = $ctx->exec_statement($v, 1);
4580             }
4581             }
4582 15         46 return $var;
4583             } elsif ($cmd eq 'const') {
4584 9         36 my $arglist = $parser->{strmap}->{$var}->[1];
4585 9         20 my @param = ();
4586              
4587 9         23 foreach my $v (@$arglist) {
4588 9 50       35 if ($v =~ /^#expr\d+$/) {
4589 9         13 my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}};
  9         33  
4590              
4591 9 50       27 if ($op eq '=') {
4592 9 50       33 unless (is_const($v1)) {
    50          
4593 0 0       0 $ctx->{warn}->($ctx, 'const', $var, "ignore non-const const $v1") if $ctx->{log};
4594 0         0 } elsif ($ctx->{infunction}) {
4595 0 0       0 $ctx->{warn}->($ctx, 'const', $var, "ignore in-function const $v1") if $ctx->{log};
4596             } else {
4597 9         22 my $name = $parser->{strmap}{$v1}; # consts are case-sensitive
4598 9         20 my $op2 = $ctx->exec_statement($v2, 1); # should be constant expression
4599              
4600 9 100       56 if (exists $ctx->{class_scope}) {
4601 4         23 $name = method_name($ctx->{class_scope}, $name);
4602             }
4603 9 100       25 if ($ctx->{namespace}) {
4604 4         20 $name = ns_name(lc($ctx->{namespace}), $name);
4605             }
4606 9         49 $ctx->{defines}{$name} = $op2;
4607 9 50       37 $ctx->{log}->($ctx, 'const', $var, "set const $name = $op2") if $ctx->{log};
4608             }
4609             } else {
4610 0         0 $ctx->{warn}->($ctx, 'const', $var, "bad const expr $v");
4611             }
4612             } else {
4613 0         0 $ctx->{warn}->($ctx, 'const', $var, "bad const statement $v");
4614             }
4615             }
4616 9         27 return $var;
4617             } elsif ($cmd eq 'return') {
4618 254         586 my $arg = $parser->{strmap}->{$var}->[1];
4619 254         576 my $res = $ctx->exec_statement($arg);
4620 254 100 66     1087 if (defined $res && ($arg ne $res)) {
4621 107         439 my $k = $parser->setstmt(['return', $res]);
4622 107         334 return $k;
4623             }
4624 147         381 return $var;
4625             } elsif ($cmd eq 'unset') {
4626             # https://www.php.net/manual/en/function.unset.php
4627             #
4628 5         11 my $arglist = $parser->{strmap}->{$var}->[1];
4629 5         12 my @param = ();
4630 5         7 my $all_var = 1;
4631 5         10 my $changed = 0;
4632              
4633 5         12 foreach my $p (@$arglist) {
4634 5 100       12 if (is_variable($p)) {
    50          
4635 1 50       5 if (exists $ctx->{varmap}{$p}) {
4636 1 50       5 $ctx->{log}->($ctx, 'unset', $var, "unset $p") if $ctx->{log};
4637             } else {
4638 0 0       0 $ctx->{log}->($ctx, 'unset', $var, "unset undefined $p") if $ctx->{log};
4639             }
4640 1         5 $ctx->setvar($p, '#null', 1);
4641 1         3 push(@param, $p);
4642 1         3 next;
4643             } elsif ($p =~ /^(\#elem\d+)$/) {
4644             # todo: suppport multi dimensional
4645             #
4646 4         9 my ($v, $i) = @{$parser->{strmap}->{$p}};
  4         13  
4647 4         13 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($p, 0);
4648 4 50       13 if (defined $basevar) {
4649 4 100       9 if ($has_index) {
4650 3         10 my $basestr = $ctx->exec_statement($basevar, 0);
4651 3 100 66     17 if (defined $basestr && is_array($basestr) && defined $idxstr) {
      66        
4652 2         5 my $arr = $parser->{strmap}->{$basestr};
4653 2 50       10 $idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index
4654 2         16 my $arrval = $arr->get($idxstr);
4655 2 50       8 if (defined $arrval) {
4656 2         5 my $idxval = $arr->get_index($idxstr);
4657 2 50       8 $ctx->{log}->($ctx, 'unset', $var, "unset elem $p: %s %s[%s]", $basevar, $basestr, $idxstr) if $ctx->{log};
4658 2         7 my $arr2 = $arr->copy();
4659 2         18 $arr2->delete($idxval);
4660 2         60 $ctx->setvar($basevar, $arr2->{name}, 1);
4661             }
4662             } else {
4663 1 50       6 $ctx->{log}->($ctx, 'unset', $var, "unset undefined elem $p") if $ctx->{log};
4664             }
4665             } else {
4666 1 50       4 if (exists $ctx->{varmap}{$basevar}) {
4667 0 0       0 $ctx->{log}->($ctx, 'unset', $var, "unset global $p: $basevar") if $ctx->{log};
4668             } else {
4669 1 50       4 $ctx->{log}->($ctx, 'unset', $var, "unset undefined global $p: $basevar") if $ctx->{log};
4670             }
4671 1         4 $ctx->setvar($basevar, '#null', 1);
4672 1         3 push(@param, $basevar);
4673 1         2 $changed = 1;
4674 1         3 next;
4675             }
4676             }
4677             } else {
4678 0         0 $ctx->{warn}->($ctx, 'unset', $var, "$p not found");
4679             }
4680 3         11 my $v = $ctx->exec_statement($p);
4681 3         5 push(@param, $v);
4682 3 100       9 if ($v ne $p) {
4683 1         3 $changed = 1;
4684             }
4685 3         7 $all_var = 0;
4686             }
4687             #unless ($all_var) {
4688             # $ctx->set_tainted($var);
4689             #}
4690 5 50       14 if (exists $ctx->{simplify}{stmt}) {
4691 5 100       12 if ($changed) {
4692 2         9 my $k = $parser->setstmt(['unset', \@param]);
4693 2 50       19 $ctx->{log}->($ctx, 'unset', $var, "simplify -> $k") if $ctx->{log};
4694 2         9 return $k;
4695             }
4696             }
4697 3         10 return $var;
4698             } elsif ($cmd eq 'break') {
4699 2         7 return $var;
4700             } elsif ($cmd eq 'continue') {
4701 0         0 return $var;
4702             } elsif ($cmd eq 'namespace') {
4703 10         16 my ($arg, $block) = @{$parser->{strmap}->{$var}}[1..2];
  10         27  
4704              
4705 10         42 $ctx->{namespace} = $arg; # always use case in-sensitive later
4706              
4707 10 100       24 if (defined $block) {
4708 2         18 my $block1 = $ctx->exec_statement($block);
4709 2 100       10 if ($block1 ne $block) {
4710 1         28 my $k = $parser->setstmt(['namespace', $arg, $block1]);
4711 1         7 return $k;
4712             }
4713             }
4714 9         25 return $var;
4715             } elsif ($cmd =~ /^(include|include_once|require|require_once)$/) {
4716 0         0 my $arg = $parser->{strmap}->{$var}->[1];
4717 0         0 my $v = $ctx->exec_statement($arg);
4718              
4719 0         0 $ctx->set_tainted($var);
4720              
4721 0 0       0 if (exists $ctx->{simplify}{stmt}) {
4722 0 0       0 if ($v ne $arg) {
4723 0         0 my $k = $parser->setstmt([$cmd, $v]);
4724 0 0       0 $ctx->{log}->($ctx, $cmd, $var, "simplify -> $k") if $ctx->{log};
4725 0         0 return $k;
4726             }
4727             }
4728 0         0 return $var;
4729             } elsif ($cmd eq 'if') {
4730 150         267 my ($expr, $then, $else) = @{$parser->{strmap}->{$var}}[1..3];
  150         611  
4731              
4732 150         441 my $cond = $ctx->exec_statement($expr);
4733              
4734             # insert possible assignment from expr
4735             #
4736 150         460 my $fin = $ctx->insert_assignments(undef);
4737              
4738 150 0       438 $ctx->{log}->($ctx, 'if', $var, "expr %s -> %s", $expr, defined $cond ? $cond : '') if $ctx->{log};
    50          
4739 150 100 100     601 if (defined $cond && (is_strval($cond) || is_array($cond))) {
      66        
4740 48         112 my $res;
4741              
4742 48         137 my $val = $parser->{strmap}{$cond};
4743 48 100       126 if (is_array($cond)) {
4744 1         3 my $arr = $parser->{strmap}{$cond};
4745 1         6 $val = !$arr->empty();
4746             }
4747 48 100       153 if ($val) {
    100          
4748 25         67 $res = $ctx->exec_statement($then);
4749 25         109 $res = $parser->flatten_block_if_single($res);
4750             } elsif (defined $else) {
4751 11         35 $res = $ctx->exec_statement($else);
4752 11         38 $res = $parser->flatten_block_if_single($res);
4753             } else {
4754 12         45 $res = $parser->setblk('flat', []);
4755             }
4756              
4757             # convert std blocks to flat
4758             #
4759 48         135 my @seq = ();
4760 48 100       210 $parser->flatten_block($fin, \@seq) if defined $fin;
4761 48         210 $parser->flatten_block($res, \@seq);
4762 48 100       288 if (scalar @seq > 1) {
    100          
4763 4         22 $res = $parser->setblk('flat', [@seq]);
4764             } elsif (scalar @seq > 0) {
4765 32         69 $res = $seq[0];
4766             }
4767 48         155 return $res;
4768             }
4769              
4770             # simplify if
4771             #
4772             # invalidate undefined variables first to avoid '#null' compares
4773             #
4774 102         240 my $var0 = $var;
4775 102 100       270 if ($expr ne $cond) {
4776             # use cond with removed assignments
4777 44         188 $var0 = $parser->setstmt(['if', $cond, $then, $else]);
4778             }
4779 102         328 my $info = $ctx->get_unresolved_info($var, $var0);
4780 102         425 $ctx->invalidate_undefined_vars($info, 'if', $var);
4781              
4782             # run with unresolved vars to simplify then/else and
4783             # unresolve changed variables afterwards again.
4784             #
4785 102         354 my $ctx_t = $ctx->clone();
4786 102         177 my $ctx_e;
4787 102         285 my $then1 = $ctx_t->exec_statement($then);
4788 102         235 my $else1;
4789 102 100       302 if (defined $else) {
4790 14         57 $ctx_e = $ctx->clone();
4791 14         110 $else1 = $ctx_e->exec_statement($else);
4792             }
4793 102         402 $ctx->update_unresolved($ctx_t);
4794 102 100       297 if (defined $else) {
4795 14         39 $ctx->update_unresolved($ctx_e);
4796             }
4797 102 50       203 if (is_instvar($cond)) {
4798 0         0 $cond = $expr;
4799             }
4800 102 100 100     605 if (($cond ne $expr) || ($then ne $then1) || (defined $else && ($else ne $else1))) {
      100        
      100        
4801             # put braces around simplified then/else blocks,
4802             # but no brace around 'else if'.
4803             #
4804 72 100 100     247 if (($then ne $then1) && !is_block($then1)) {
4805 2         16 $then1 = $parser->setblk('std', [$then1]);
4806             }
4807 72 50 100     203 if (defined $else && ($else ne $else1) && !is_block($else1)) {
      66        
4808 0         0 $else1 = $parser->setblk('std', [$else1]);
4809             }
4810 72         285 my $k = $parser->setstmt(['if', $cond, $then1, $else1]);
4811 72 50       216 $ctx->{log}->($ctx, 'if', $var, "simplify -> $k") if $ctx->{log};
4812 72         167 $var = $k;
4813             }
4814 102 100       254 if (defined $fin) {
4815 8         17 my @seq = ();
4816 8         27 $parser->flatten_block($fin, \@seq);
4817 8         17 push(@seq, $var);
4818 8 50       20 if (scalar @seq > 1) {
    0          
4819 8         27 $var = $parser->setblk('std', [@seq]);
4820             } elsif (scalar @seq > 0) {
4821 0         0 $var = $seq[0];
4822             }
4823             }
4824 102         1081 return $var;
4825             } elsif ($cmd eq 'while') {
4826 10         18 my ($expr, $block) = @{$parser->{strmap}->{$var}}[1..2];
  10         38  
4827              
4828             # - expr is recalculated on each loop
4829             # (can't pre-simplify expressions like '$i < 7' or '--$x' -> 'num' or
4830             # assignments, because this will lead to wrong code like 'while (1)')
4831             #
4832 10 50       42 unless (exists $ctx->{skip}{loop}) {
4833 10         26 my $orgloop = $parser->format_stmt($var);
4834 10         38 my $toploop = loop_start($parser);
4835 10         21 my $i = 0;
4836 10         13 my $res;
4837 10         25 my @seq = ();
4838              
4839 10         14 while (1) {
4840 18         52 my $cond = $ctx->exec_statement($expr);
4841              
4842 18 100 100     68 if (($i == 0) && (is_strval($cond) || (is_array($cond)))) {
      100        
4843             # optimze 'while(0) { ... }' cases away
4844             #
4845 6         24 my $val = $parser->{strmap}->{$cond};
4846 6 100       30 if (is_array($cond)) {
4847 1         7 my $arr = $parser->{strmap}{$cond};
4848 1         8 $val = !$arr->empty();
4849             }
4850 6 50       44 if (!$val) {
4851 0         0 $res = $parser->setblk('flat', []);
4852 0         0 loop_end($parser, $toploop, $i);
4853 0         0 return $res;
4854             }
4855             }
4856 18 50       44 $ctx->{log}->($ctx, 'while', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
4857 18 100 100     41 if (is_strval($cond) || is_array($cond)) {
    50          
4858 14         30 my $val = $parser->{strmap}->{$cond};
4859 14 100       43 if (is_array($cond)) {
4860 2         9 my $arr = $parser->{strmap}{$cond};
4861 2         401 $val = !$arr->empty();
4862             }
4863 14 100       69 if (!$val) {
4864             # loop might never execute
4865 3 50       17 unless (defined $res) {
4866 0 0       0 $ctx->{log}->($ctx, 'while', $var, "%d: block never executed", $i) if $ctx->{log};
4867 0         0 $res = $parser->setblk('flat', []);
4868             }
4869 3         7 last;
4870             }
4871             } elsif ($i == 0) {
4872             # can't resolve expression - just return full while()-statement
4873 4         17 $ctx->{warn}->($ctx, 'while', $var, "initial bad cond %s -> %s", $expr, $cond);
4874 4         169 last;
4875             } else {
4876 0         0 $ctx->{warn}->($ctx, 'while', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond);
4877 0         0 $res = undef;
4878 0         0 last;
4879             }
4880             # need to keep assignments in block here
4881             #
4882 11         30 $res = $ctx->exec_statement($block);
4883 11 50       37 unless (defined $res) {
4884 0         0 last;
4885             }
4886 11         52 my $info = {vars => {}, calls => {}, stmts => {}};
4887 11         38 $parser->stmt_info($res, $info);
4888 11         338 my $r = _final_break($parser, $res, '(break)');
4889 11         41 my $u = $ctx->unresolvable_var($info);
4890 11         27 my $f = _skipped_call($parser, $res, '(.*)', $info);
4891 11 50 33     53 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      66        
      33        
4892 2 50       12 $ctx->{warn}->($ctx, 'while', $var, "skip loop after %d interations: found remaining call[%s]: %s -> %s", $i, defined $f ? $f : $u, $block, $res);
4893 2         97 $res = undef;
4894 2         12 last;
4895             }
4896 9 50       24 $ctx->{log}->($ctx, 'while', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log};
4897 9 100       20 if (defined $r) {
4898 1 50       4 $ctx->{log}->($ctx, 'while', $var, "%d: block break: %s", $i, $res) if $ctx->{log};
4899 1         5 last;
4900             }
4901 8         26 my $fin = $ctx->insert_assignments(undef);
4902              
4903 8         19 my @list = ();
4904 8 50       20 if (defined $fin) {
4905 0         0 $parser->flatten_block($fin, \@list);
4906             }
4907 8         29 $parser->flatten_block($res, \@list);
4908 8         41 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
4909              
4910 8 50       29 if ($i >= $ctx->{max_loop_while}) {
4911 0         0 $ctx->{warn}->($ctx, 'while', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i));
4912 0         0 last;
4913             }
4914 8 50 33     23 if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) {
4915 0         0 $ctx->{warn}->($ctx, 'while', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i));
4916 0         0 last;
4917             }
4918 8 50 33     26 if (($i >= $ctx->{max_loop_const}) && is_strval($expr)) {
4919             # stop 'while(true)' and similay cases
4920 0         0 $ctx->{warn}->($ctx, 'while', $var, "stop loop after %d const iterations: $res [$expr]", $i);
4921 0         0 last;
4922             }
4923 8         31 $i++;
4924             }
4925 10         33 loop_end($parser, $toploop, $i);
4926              
4927 10 100       27 if (defined $res) {
4928             # insert final loop var value
4929             #
4930 4         14 my $fin = $ctx->insert_assignments(undef);
4931 4 100       15 if (defined $fin) {
4932 1         4 my @list = ();
4933 1         7 $parser->flatten_block($fin, \@list);
4934 1         12 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
4935             }
4936 4 100       17 if (scalar @seq > 1) {
    50          
4937 2         9 $res = $parser->setblk('std', [@seq]);
4938             } elsif (scalar @seq > 0) {
4939 2         4 $res = $seq[0];
4940             }
4941 4 50       11 $ctx->{log}->($ctx, 'while', $var, "optimized '%s' -> $res '%s'", $orgloop, $parser->format_stmt($res)) if $ctx->{log};
4942 4         16 return $res;
4943             }
4944             }
4945              
4946 6 50       23 if (exists $ctx->{simplify}{stmt}) {
4947 6 50       18 $ctx->{log}->($ctx, 'while', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log};
4948              
4949             # when not executed, invalidate loop variables and keep original statement
4950             # - assignments might be used in next loop, so these vars are #unresolved
4951             # - more vars might be changed if there are unresolvable left-hand-sides
4952             # of assignments or calls, so invalidate remaining variables used in loop.
4953             #
4954 6         20 my $info = $ctx->get_unresolved_info($var, $var);
4955 6         20 $ctx->invalidate_vars($info, 'while', $var);
4956 6         18 $ctx->discard_pending_assignments(); # remove any pending assignments (from 'cond')
4957              
4958             # run with unresolved vars to simplify block and
4959             # unresolve changed variables afterwards again.
4960             #
4961 6         15 my $ctx_e = $ctx->clone();
4962 6         20 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
4963 6         17 $ctx->update_unresolved($ctx_e);
4964              
4965 6         14 my $ctx_b = $ctx->clone();
4966 6         18 my $block0 = $ctx_b->exec_statement($block);
4967 6         23 $ctx->update_unresolved($ctx_b);
4968              
4969 6 50       14 if (is_instvar($expr0)) {
4970 0         0 $expr0 = $expr;
4971             }
4972 6 50 33     80 if (($expr ne $expr0) || ($block ne $block0)) {
4973 0         0 my $k = $parser->setstmt(['while', $expr0, $block0]);
4974 0         0 return $k;
4975             }
4976             }
4977 6         17 return $var;
4978             } elsif ($cmd eq 'do') {
4979 7         20 my ($expr, $block) = @{$parser->{strmap}->{$var}}[1..2];
  7         26  
4980              
4981             # - block is executed at least once
4982             # (does optimze 'do { ... } while(0)' cases)
4983             #
4984 7         26 my $orgloop = $parser->format_stmt($var);
4985 7         16 my @seq = ();
4986              
4987 7         22 my $res = $ctx->exec_statement($block);
4988 7 50       31 if (defined $res) {
4989 7         16 my @list = ();
4990 7         23 $parser->flatten_block($res, \@list);
4991 7         46 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
4992             }
4993 7 50       30 unless (exists $ctx->{skip}{loop}) {
4994 7         42 my $i = 0;
4995 7         37 my $toploop = loop_start($parser);
4996              
4997 7         22 while (defined $res) {
4998 11         33 my $cond = $ctx->exec_statement($expr);
4999              
5000 11 50       42 $ctx->{log}->($ctx, 'do', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
5001 11 100 66     29 if (is_strval($cond) || is_array($cond)) {
    50          
5002 10         27 my $val = $parser->{strmap}{$cond};
5003 10 50       23 if (is_array($cond)) {
5004 0         0 my $arr = $parser->{strmap}{$cond};
5005 0         0 $val = !$arr->empty();
5006             }
5007 10 100       30 if (!$val) {
5008 6         18 last;
5009             }
5010             } elsif ($i == 0) {
5011             # can't resolve expression - just return full do()-statement
5012 1         7 $ctx->{warn}->($ctx, 'do', $var, "initial bad cond %s -> %s", $expr, $cond);
5013 1         18 $res = undef;
5014 1         3 last;
5015             } else {
5016 0         0 $ctx->{warn}->($ctx, 'do', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond);
5017             #$res = $parser->setblk('flat', []);
5018 0         0 $res = undef;
5019 0         0 last;
5020             }
5021 4         21 $res = $ctx->exec_statement($block);
5022 4 50       12 unless (defined $res) {
5023 0         0 last;
5024             }
5025 4         18 my $info = {vars => {}, calls => {}, stmts => {}};
5026 4         14 $parser->stmt_info($res, $info);
5027 4         20 my $r = _final_break($parser, $res, '(break)');
5028 4         13 my $u = $ctx->unresolvable_var($info);
5029 4         14 my $f = _skipped_call($parser, $res, '(.*)', $info);
5030 4 0 0     19 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      33        
      33        
5031 0 0       0 $ctx->{warn}->($ctx, 'do', $var, "skip loop after %d interations: found remaining call[%s]: %s -> %s", $i, defined $f ? $f : $u, $block, $res);
5032 0         0 $res = undef;
5033 0         0 last;
5034             }
5035 4 50       13 $ctx->{log}->($ctx, 'do', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log};
5036 4 50       10 if (defined $r) {
5037 0 0       0 $ctx->{log}->($ctx, 'do', $var, "%d: block break: %s", $i, $res) if $ctx->{log};
5038 0         0 last;
5039             }
5040 4         12 my $fin = $ctx->insert_assignments(undef);
5041              
5042 4         9 my @list = ();
5043 4 50       11 if (defined $fin) {
5044 0         0 $parser->flatten_block($fin, \@list);
5045             }
5046 4         15 $parser->flatten_block($res, \@list);
5047 4         16 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5048              
5049 4 50       22 if ($i >= $ctx->{max_loop}) {
5050 0         0 $ctx->{warn}->($ctx, 'do', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i));
5051 0         0 last;
5052             }
5053 4 50 33     10 if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) {
5054 0         0 $ctx->{warn}->($ctx, 'do', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i));
5055 0         0 last;
5056             }
5057 4 50 33     11 if (($i >= $ctx->{max_loop_const}) && is_strval($expr)) {
5058             # stop 'while(true)' and similay cases
5059 0         0 $ctx->{warn}->($ctx, 'do', $var, "stop loop after %d const iterations: $res [$expr]", $i);
5060 0         0 last;
5061             }
5062 4         19 $i++;
5063             }
5064 7         33 loop_end($parser, $toploop, $i);
5065             }
5066 7 100       30 if (defined $res) {
5067             # insert final loop var value
5068             #
5069 6         18 my $fin = $ctx->insert_assignments(undef);
5070 6 100       24 if (defined $fin) {
5071 1         4 my @list = ();
5072 1         7 $parser->flatten_block($fin, \@list);
5073 1         11 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5074             }
5075 6 100       31 if (scalar @seq > 1) {
    50          
5076 2         9 $res = $parser->setblk('std', [@seq]);
5077             } elsif (scalar @seq > 0) {
5078 4         8 $res = $seq[0];
5079             }
5080 6 50       20 $ctx->{log}->($ctx, 'do', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5081 6         17 return $res;
5082             }
5083              
5084 1 50       9 if (exists $ctx->{simplify}{stmt}) {
5085 1 50       4 $ctx->{log}->($ctx, 'do', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log};
5086              
5087             # when not executed, invalidate loop variables and keep original statement
5088             # - assignments might be used in next loop, so these vars are #unresolved
5089             # - more vars might be changed if there are unresolvable left-hand-sides
5090             # of assignments or calls, so invalidate remaining variables used in loop.
5091             #
5092 1         4 my $info = $ctx->get_unresolved_info($var, $var);
5093 1         5 $ctx->invalidate_vars($info, 'do', $var);
5094 1         5 $ctx->discard_pending_assignments(); # remove any pending assignments (from block)
5095              
5096             # run with unresolved vars to simplify block and
5097             # unresolve changed variables afterwards again.
5098             #
5099 1         4 my $ctx_b = $ctx->clone();
5100 1         4 my $block0 = $ctx_b->exec_statement($block);
5101 1         20 $ctx->update_unresolved($ctx_b);
5102              
5103 1         3 my $ctx_e = $ctx->clone();
5104 1         7 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
5105 1         5 $ctx->update_unresolved($ctx_e);
5106              
5107 1 50       16 if (is_instvar($expr0)) {
5108 0         0 $expr0 = $expr;
5109             }
5110 1 50 33     30 if (($expr ne $expr0) || ($block ne $block0)) {
5111 0         0 my $k = $parser->setstmt(['do', $expr0, $block0]);
5112 0         0 return $k;
5113             }
5114             }
5115 1         5 return $var;
5116             } elsif ($cmd eq 'for') {
5117 23         50 my ($pre, $expr, $post, $block) = @{$parser->{strmap}->{$var}}[1..4];
  23         78  
5118              
5119             # - pre is executed just once at the start of foreach
5120             # - expr & post are recalculated on each loop
5121             #
5122 23         62 my $pre0 = $ctx->exec_statement($pre, 1);
5123              
5124 23 50       95 unless (exists $ctx->{skip}{loop}) {
5125 23         77 my $orgloop = $parser->format_stmt($var);
5126 23         72 my $toploop = loop_start($parser);
5127 23         35 my $i = 0;
5128 23         43 my $res;
5129 23         52 my @seq = ();
5130              
5131             # add initial variable assignments to result list
5132             #
5133 23         38 my @list = ();
5134 23         78 $parser->flatten_block($pre0, \@list);
5135 23         114 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5136              
5137 23         32 while (1) {
5138 53         128 my $cond = $ctx->exec_statement($expr);
5139              
5140 53 50       119 $ctx->{log}->($ctx, 'for', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
5141 53 100       153 if ($parser->is_empty_block($cond)) {
5142 2         5 $cond = '#null'; # null statements are eliminated in block execution
5143             }
5144 53 100 66     104 if (is_strval($cond) || is_array($cond)) {
    50          
5145 48         115 my $val = $parser->{strmap}{$cond};
5146 48 50       136 if (is_array($cond)) {
5147 0         0 my $arr = $parser->{strmap}{$cond};
5148 0         0 $val = !$arr->empty();
5149             }
5150 48 100       115 if (!$val) {
5151             # loop might never execute
5152 15 100       43 unless (defined $res) {
5153 3 50       18 $ctx->{log}->($ctx, 'for', $var, "%d: block $block never executed", $i) if $ctx->{log};
5154 3         17 $res = $parser->setblk('flat', []);
5155             }
5156 15         44 last;
5157             }
5158             } elsif ($i == 0) {
5159             # can't resolve expression - just return full for()-statement
5160 5         15 last;
5161             } else {
5162 0         0 $ctx->{warn}->($ctx, 'for', $var, "bad cond after %d iterations %s -> %s", $i, $expr, $cond);
5163             #$res = $parser->setblk('flat', []);
5164 0         0 $res = undef;
5165 0         0 last;
5166             }
5167 33         89 $res = $ctx->exec_statement($block);
5168 33 50       85 unless (defined $res) {
5169 0         0 last;
5170             }
5171 33         144 my $info = {vars => {}, calls => {}, stmts => {}};
5172 33         117 $parser->stmt_info($res, $info);
5173 33         76 my $r = _final_break($parser, $res, '(break)');
5174 33         91 my $u = $ctx->unresolvable_var($info);
5175 33         76 my $f = _skipped_call($parser, $res, '(.*)', $info);
5176 33 50 0     155 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      33        
      66        
5177 3 50       30 $ctx->{warn}->($ctx, 'for', $var, "skip loop after %d interations: found remaining call[%s]: '%s' %s -> %s", $i, defined $f ? $f : $u, $orgloop, $block, $res);
5178 3         229 $res = undef;
5179 3         16 last;
5180             }
5181 30 50       66 $ctx->{log}->($ctx, 'for', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log};
5182 30 50       117 if (defined $r) {
5183 0 0       0 $ctx->{log}->($ctx, 'for', $var, "%d: block break: %s", $i, $res) if $ctx->{log};
5184 0         0 last;
5185             }
5186             # recalculate post on each loop
5187             #
5188 30         81 my $fin = $ctx->insert_assignments(undef);
5189              
5190 30         84 my @list = ();
5191 30 50       61 if (defined $fin) {
5192 0         0 $parser->flatten_block($fin, \@list);
5193             }
5194 30         101 $parser->flatten_block($res, \@list);
5195 30         103 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5196              
5197 30         96 my $post0 = $ctx->exec_statement($post);
5198 30 50       78 $ctx->{log}->($ctx, 'for', $var, "%d: post result: %s -> %s", $i, $post, $post0) if $ctx->{log};
5199              
5200 30 50       76 if ($i >= $ctx->{max_loop}) {
5201 0         0 $ctx->{warn}->($ctx, 'for', $var, "stop loop after %d [%d] iterations: $res [$expr]", $i, loop_val($parser, $i));
5202 0         0 last;
5203             }
5204 30 50 33     69 if ((loop_level($parser) > 1) && (loop_val($parser, $i) >= (2 * $ctx->{max_loop}))) {
5205 0         0 $ctx->{warn}->($ctx, 'for', $var, "stop loop after %d nested iterations: $res [$expr]", loop_val($parser, $i));
5206 0         0 last;
5207             }
5208 30         124 $i++;
5209             }
5210 23         87 loop_end($parser, $toploop, $i);
5211              
5212 23 100       86 if (defined $res) {
5213             # insert final loop var value
5214             #
5215 15         46 my $fin = $ctx->insert_assignments(undef);
5216 15 100       74 if (defined $fin) {
5217 14         22 my @list = ();
5218 14         46 $parser->flatten_block($fin, \@list);
5219 14         43 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5220             }
5221             # todo: can getting very long statement list here for seq - just return values from last loop
5222             #
5223 15 100       51 if (scalar @seq > 1) {
    50          
5224 14         56 $res = $parser->setblk('std', [@seq]);
5225             } elsif (scalar @seq > 0) {
5226 1         19 $res = $seq[0];
5227             }
5228 15 50       43 $ctx->{log}->($ctx, 'for', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5229 15         55 return $res;
5230             }
5231             }
5232              
5233 8 50       39 if (exists $ctx->{simplify}{stmt}) {
5234 8 50       37 $ctx->{log}->($ctx, 'for', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log};
5235              
5236             # when not executed, invalidate loop variables and keep original statement
5237             # - key/value change for each loop, so they are #unresolved
5238             # - assignments might be used in next loop, so these vars are #unresolved
5239             # - more vars might be changed if there are unresolvable left-hand-sides
5240             # of assignments or calls, so invalidate remaining variables used in loop.
5241             #
5242 8         22 my $var0 = $var;
5243 8 50       22 if ($pre ne $pre0) {
5244 0         0 $var0 = $parser->setstmt(['for', $pre0, $expr, $post, $block]);
5245             }
5246 8         34 my $info = $ctx->get_unresolved_info($var, $var0);
5247 8         63 $ctx->invalidate_vars($info, 'for', $var);
5248 8         44 $ctx->discard_pending_assignments(); # remove any pending assignments (from 'cond')
5249              
5250             # run with unresolved vars to simplify block and
5251             # unresolve changed variables afterwards again.
5252             #
5253 8         23 my $ctx_e = $ctx->clone();
5254 8         81 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
5255 8         48 $ctx->update_unresolved($ctx_e);
5256              
5257 8         29 my $ctx_b = $ctx->clone();
5258 8         46 my $block0 = $ctx_b->exec_statement($block);
5259 8         58 $ctx->update_unresolved($ctx_b);
5260              
5261 8         24 my $ctx_p = $ctx->clone();
5262 8         29 my $post0 = $ctx_p->exec_statement($post, 1); # keep assignments inline
5263 8         54 $ctx->update_unresolved($ctx_p);
5264              
5265 8 50       36 if (is_instvar($expr0)) {
5266 0         0 $expr0 = $expr;
5267             }
5268 8 100 33     175 if (($pre ne $pre0) || ($expr ne $expr0) || ($post ne $post0) || ($block ne $block0)) {
      33        
      66        
5269 1         15 my $k = $parser->setstmt(['for', $pre0, $expr0, $post0, $block0]);
5270 1         16 return $k;
5271             }
5272             }
5273 7         28 return $var;
5274             } elsif ($cmd eq 'foreach') {
5275 19         50 my ($expr, $key, $value, $block) = @{$parser->{strmap}->{$var}}[1..4];
  19         73  
5276 19         40 my $valvar;
5277             my $keyvar;
5278              
5279             # - expr is executed just once at the start of foreach
5280             # - key and value are recalculated on each loop
5281             # - TODO: reference on value var
5282             #
5283 19         49 my $expr0 = $ctx->exec_statement($expr);
5284              
5285 19 100       69 if (defined $key) {
5286 13         44 my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block);
5287 13 50       62 $keyvar = defined $_basevar2 ? $_basevar2 : $key;
5288             }
5289 19         60 my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block);
5290 19 50       56 $valvar = defined $_basevar ? $_basevar : $value;
5291              
5292             # loop should be unrolled only after variables are available
5293 19 50       61 unless (exists $ctx->{skip}{loop}) {
5294 19         64 my $orgloop = $parser->format_stmt($var);
5295 19         76 my $toploop = loop_start($parser);
5296 19         42 my $i = 0;
5297 19         28 my $res;
5298 19         32 my @seq = ();
5299              
5300 19 100       56 if (is_array($expr0)) {
5301             #my ($a2, $array2) = $parser->copyarr($expr0); # copy if value not reference
5302             #$expr0 = $a2;
5303 11         36 my $arr = $parser->{strmap}{$expr0};
5304 11         35 my $keys = $arr->get_keys();
5305              
5306             # loop might never execute
5307 11 50 33     67 if ((scalar @$keys == 0) && !$ctx->{tainted}) {
5308 0 0       0 $ctx->{log}->($ctx, 'foreach', $var, "block $block never executed") if $ctx->{log};
5309 0         0 $res = $parser->setblk('flat', []);
5310             }
5311 11         28 foreach my $k (@$keys) {
5312 23 50 66     94 if (defined $key && defined $keyvar && is_variable($keyvar)) {
      66        
5313 17 50       44 if (is_int_index($k)) {
5314 17         58 my $kstr = $parser->setnum($k);
5315 17         47 $ctx->{varmap}{$keyvar} = $kstr;
5316             } else {
5317 0         0 $ctx->{varmap}{$keyvar} = $k;
5318             }
5319             }
5320 23 50 33     73 if (defined $valvar && is_variable($valvar)) {
5321 23         71 my $arrval = $arr->val($k);
5322 23         61 $ctx->{varmap}{$valvar} = $arrval;
5323             }
5324 23         55 $res = $ctx->exec_statement($block);
5325 23 50       75 unless (defined $res) {
5326 0         0 last;
5327             }
5328 23         116 my $info = {vars => {}, calls => {}, stmts => {}};
5329 23         87 $parser->stmt_info($res, $info);
5330 23         56 my $r = _final_break($parser, $res, '(break)');
5331 23         60 my $u = $ctx->unresolvable_var($info);
5332 23         57 my $f = _skipped_call($parser, $res, '(.*)', $info);
5333 23 50 33     94 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      66        
      66        
5334 2 50       14 $ctx->{warn}->($ctx, 'foreach', $var, "skip loop after %d interations (key %s): found remaining call[%s]: %s -> %s", $i, $k, defined $f ? $f : $u, $block, $res);
5335 2         98 $res = undef;
5336 2         16 last;
5337             }
5338 21 50       44 if (defined $r) {
5339 0 0       0 $ctx->{log}->($ctx, 'foreach', $var, "%s: block break: %s", $k, $res) if $ctx->{log};
5340 0         0 last;
5341             }
5342 21         55 my $fin = $ctx->insert_assignments(undef);
5343              
5344 21         43 my @list = ();
5345 21 50       41 if (defined $fin) {
5346 0         0 $parser->flatten_block($fin, \@list);
5347             }
5348 21         66 $parser->flatten_block($res, \@list);
5349 21         71 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5350              
5351             # recalculate key & value on each loop
5352             #
5353 21 100 66     131 if (defined $key && defined $keyvar && ($keyvar ne $key)) {
      100        
5354 9         25 my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block);
5355 9 50       30 $keyvar = defined $_basevar2 ? $_basevar2 : $key;
5356             }
5357 21 100 66     69 if (defined $valvar && ($valvar ne $value)) {
5358 11         27 my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block);
5359 11 50       29 $valvar = defined $_basevar ? $_basevar : $value;
5360             }
5361 21         91 $i++;
5362             }
5363             } else {
5364 8 50       29 $ctx->{log}->($ctx, 'foreach', $var, "can't handle expr: %s (%s)", $expr, $expr0) if $ctx->{log};
5365             }
5366 19         78 loop_end($parser, $toploop, $i);
5367              
5368 19 100       48 if (defined $res) {
5369             # insert final loop var value
5370             #
5371 9         29 my $fin = $ctx->insert_assignments(undef);
5372 9 50       27 if (defined $fin) {
5373 0         0 my @list = ();
5374 0         0 $parser->flatten_block($fin, \@list);
5375 0         0 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5376             }
5377             # todo: can getting very long statement list here for seq - just return values from last loop
5378             #
5379 9 100       28 if (scalar @seq > 1) {
    50          
5380 6         32 $res = $parser->setblk('std', [@seq]);
5381             } elsif (scalar @seq > 0) {
5382 3         8 $res = $seq[0];
5383             }
5384 9 50       33 $ctx->{log}->($ctx, 'foreach', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5385 9         40 return $res;
5386             }
5387             }
5388              
5389 10 50       32 if (exists $ctx->{simplify}{stmt}) {
5390 10 50       24 $ctx->{log}->($ctx, 'foreach', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log};
5391              
5392             # when not executed, invalidate loop variables and keep original statement
5393             # - key/value change for each loop, so they are #unresolved
5394             # - assignments might be used in next loop, so these vars are #unresolved
5395             # - more vars might be changed if there are unresolvable left-hand-sides
5396             # of assignments or calls, so invalidate remaining variables used in loop.
5397             #
5398 10         22 my $var0 = $var;
5399 10 100       28 if ($expr ne $expr0) {
5400             # use expr with removed assignments
5401 4         21 $var0 = $parser->setstmt(['foreach', $expr0, $key, $value, $block]);
5402             }
5403 10         35 my $info = $ctx->get_unresolved_info($var, $var0);
5404 10         49 $ctx->invalidate_vars($info, 'foreach', $var);
5405              
5406             # run with unresolved vars to simplify block and
5407             # unresolve changed variables afterwards again.
5408             #
5409 10         28 my $ctx_b = $ctx->clone();
5410 10         43 my $block0 = $ctx_b->exec_statement($block);
5411 10         51 $ctx->update_unresolved($ctx_b);
5412              
5413 10 50 100     115 if (($expr ne $expr0) || ($block ne $block0) || (defined $valvar && ($value ne $valvar)) || (defined $key && defined $keyvar && ($key ne $keyvar))) {
      33        
      66        
      66        
      66        
      33        
5414             # simplify elem expression
5415             #
5416 8         42 my $k = $parser->setstmt(['foreach', $expr0, $keyvar, $valvar, $block0]);
5417 8 50       36 $ctx->{log}->($ctx, 'foreach', $var, "simplify -> $k") if $ctx->{log};
5418 8         99 return $k;
5419             }
5420             }
5421 2         8 return $var;
5422             } elsif ($cmd eq 'switch') {
5423 9         19 my ($expr, $cases) = @{$parser->{strmap}->{$var}}[1..2];
  9         30  
5424 9         31 my $op1 = $ctx->exec_statement($expr);
5425              
5426             # insert possible assignment from expr
5427             #
5428 9         30 my $fin = $ctx->insert_assignments(undef);
5429              
5430 9 100       43 if (is_strval($op1)) {
5431 3         7 my $found;
5432 3         9 my @seq = ();
5433              
5434 3 50       9 $parser->flatten_block($fin, \@seq) if defined $fin;
5435 3         6 $fin = undef;
5436              
5437 3         15 for (my $i=0; $i < scalar @$cases; $i++) {
5438 5         13 my $e = $cases->[$i];
5439 5         10 my $c = $e->[0];
5440 5 50       10 if (defined $c) {
5441 5         14 my $op2 = $ctx->exec_statement($c);
5442 5 50       30 if (is_strval($op2)) {
5443 5         25 my ($val, $result) = PHP::Decode::Op::binary($parser, $op1, '==', $op2);
5444 5 100 66     28 if (defined $result && $result) {
5445 3         6 $found = $i;
5446 3         6 last;
5447             }
5448             } else {
5449 0         0 $ctx->{warn}->($ctx, 'switch', $var, "bad cond %s == %s -> %s", $op1, $c, $op2);
5450 0         0 $found = -1;
5451 0         0 last;
5452             }
5453             }
5454             }
5455 3 50       11 if (!defined $found) {
5456             # process 'default:'
5457             #
5458 0         0 for (my $i=0; $i < scalar @$cases; $i++) {
5459 0         0 my $e = $cases->[$i];
5460 0         0 my $c = $e->[0];
5461 0 0       0 if (!defined $c) {
5462 0         0 $found = $i;
5463 0         0 last;
5464             }
5465             }
5466             }
5467 3 50 33     16 if (defined $found && ($found >= 0)) {
5468 3         10 for (my $i=$found; $i < scalar @$cases; $i++) {
5469 4         8 my $e = $cases->[$i];
5470 4         5 my $b = $e->[1];
5471 4         11 my $res = $ctx->exec_statement($b);
5472 4 50       11 unless (defined $res) {
5473 0         0 last;
5474             }
5475 4         7 my @list = ();
5476 4         7 my $f = _final_break($parser, $res, '(break|continue|return)');
5477 4 100       13 if (defined $f) {
5478 1         5 $res = _remove_final_statement($parser, '(break|continue)', $res);
5479             }
5480 4         14 $parser->flatten_block($res, \@list);
5481 4         28 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5482 4 100       13 if (defined $f) {
5483 1         3 last;
5484             }
5485             }
5486             # convert std blocks to flat
5487             #
5488 3         6 my $res;
5489 3 50       12 if (scalar @seq > 1) {
    50          
5490 0         0 $res = $parser->setblk('flat', [@seq]);
5491             } elsif (scalar @seq > 0) {
5492 3         7 $res = $seq[0];
5493             } else {
5494 0         0 $res = $parser->setblk('flat', []);
5495             }
5496 3         9 return $res;
5497             }
5498             }
5499              
5500 6 50       43 if (exists $ctx->{simplify}{stmt}) {
5501 6 50       24 $ctx->{log}->($ctx, 'switch', $var, "simplify start %s", $parser->stmt_str($var)) if $ctx->{log};
5502              
5503             # invalidate variables first to avoid '#null' compares
5504             # - since there are 'fallthrough' dependencies between
5505             # case blocks, all variables need to be invalidated.
5506             #
5507 6         15 my $var0 = $var;
5508 6 50       18 if ($expr ne $op1) {
5509             # use cond with removed assignments
5510 0         0 $var0 = $parser->setstmt(['switch', $op1, $cases]);
5511             }
5512 6         18 my $info = $ctx->get_unresolved_info($var, $var0);
5513             #$ctx->invalidate_undefined_vars($info, 'switch', $var);
5514 6         54 $ctx->invalidate_vars($info, 'switch', $var);
5515              
5516             # run with unresolved vars to simplify then/else and
5517             # unresolve changed variables afterwards again.
5518             #
5519 6         21 my @cnew = ();
5520 6         14 my @cctx = ();
5521 6         10 my $changed = 0;
5522 6         27 for (my $i=0; $i < scalar @$cases; $i++) {
5523 8         19 my $e = $cases->[$i];
5524 8         12 my $c = $e->[0];
5525 8         18 my $b = $e->[1];
5526 8         15 my $c0 = $c;
5527              
5528 8         39 $cctx[$i] = $ctx->clone();
5529 8 50       36 if (defined $c) {
5530 8         37 $c0 = $cctx[$i]->exec_statement($c);
5531             }
5532 8         47 my $b0 = $cctx[$i]->exec_statement($b);
5533              
5534 8 100 66     63 if ((defined $c0 && ($c0 ne $c)) || ($b0 ne $b)) {
      66        
5535 2         4 $changed = 1;
5536             }
5537 8         38 push (@cnew, [$c0, $b0]);
5538             }
5539 6         27 for (my $i=0; $i < scalar @$cases; $i++) {
5540 8         33 $ctx->update_unresolved($cctx[$i]);
5541             }
5542              
5543 6 100 66     38 if (($expr ne $op1) || $changed) {
5544 2         11 my $k = $parser->setstmt(['switch', $op1, \@cnew]);
5545 2 50       10 $ctx->{log}->($ctx, 'switch', $var, "simplify -> $k") if $ctx->{log};
5546 2         4 $var = $k;
5547 2         21 return $k;
5548             }
5549 4 50       49 if (defined $fin) {
5550 0         0 my @seq = ();
5551 0         0 $parser->flatten_block($fin, \@seq);
5552 0         0 push(@seq, $var);
5553 0 0       0 if (scalar @seq > 1) {
    0          
5554 0         0 $var = $parser->setblk('std', [@seq]);
5555             } elsif (scalar @seq > 0) {
5556 0         0 $var = $seq[0];
5557             }
5558             }
5559             }
5560 4         12 return $var;
5561             }
5562             } elsif ($var =~ /^#fun\d+$/) {
5563 242         436 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$var}};
  242         751  
5564              
5565             # read with temporary varmap to simplify local variables
5566             # (this should just run once per func)
5567             # (keep globals in functions untouched until function is called)
5568             #
5569 242 100       834 my $name = defined $f ? (exists $ctx->{class_scope} ? method_name($ctx->{class_scope}, lc($f)) : lc($f)) : '{closure}';
    100          
5570 242         630 my $ctx2 = $ctx->simplification_ctx(infunction => $name);
5571              
5572             # invalidate function params for simplification
5573             #
5574 242 100       822 if (scalar @$a > 0) {
5575 106         334 foreach my $v (@$a) {
5576 111 100       398 if (is_variable($v)) {
    100          
    50          
5577 107         379 $ctx2->setvar($v, "#unresolved", 0);
5578             } elsif ($v =~ /^#expr\d+$/) {
5579 2         4 my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}};
  2         9  
5580 2 50 33     14 if (($op eq '=') && is_variable($v1)) {
5581 2         7 $ctx2->setvar($v1, "#unresolved", 0);
5582             }
5583             } elsif ($v =~ /^#ref\d+$/) {
5584 2         8 my $r = $parser->{strmap}->{$v}->[0];
5585 2 50       7 if (is_variable($r)) {
5586 2         17 $ctx2->setvar($r, "#unresolved", 0);
5587             }
5588             }
5589             }
5590             }
5591 242         607 my $b2 = $ctx2->exec_statement($b);
5592              
5593 242 100       960 if (!is_block($b2)) {
5594 2         9 $b2 = $parser->setblk('std', [$b2]);
5595             }
5596              
5597             # copy static function variables into live context
5598             #
5599 242         359 foreach my $sf (keys %{$ctx2->{varmap}{static}}) {
  242         918  
5600 169         315 foreach my $sv (keys %{$ctx2->{varmap}{static}{$sf}}) {
  169         589  
5601 2         9 $ctx->{varmap}{static}{$sf}{$sv} = $ctx2->{varmap}{static}{$sf}{$sv};
5602 2 50       8 $ctx->{log}->($ctx, 'exec', $var, "register static var $sv in func $sf") if $ctx->{log};
5603             }
5604             }
5605 242 100       591 if ($b2 ne $b) {
5606 70         274 my $k = $parser->setfun($f, $a, $b2, $p);
5607 70 100       204 if (defined $f) {
5608 69         195 $ctx->registerfun($f, $k);
5609             }
5610 70         540 return $k;
5611             }
5612 172 100 100     870 if (defined $f && !$ctx->getfun($f)) {
5613             # allow local functions also for block simplify
5614             #
5615 18 50       104 $ctx->{log}->($ctx, 'exec', $var, "register local func $var [$f]") if $ctx->{log};
5616 18         49 $ctx->registerfun($f, $var);
5617             }
5618             } elsif ($var =~ /^#class\d+$/) {
5619 56         84 my ($c, $b, $p) = @{$parser->{strmap}->{$var}};
  56         173  
5620 56         88 my ($type, $arglist) = @{$parser->{strmap}->{$b}};
  56         144  
5621 56 50       123 my $name = defined $c ? $c : 'class@anonymous';
5622              
5623 56         175 $ctx->{varmap}{inst}{lc($c)} = {}; # init class var map
5624              
5625             # init class properties here
5626             # https://www.php.net/manual/en/language.oop5.properties.php
5627             #
5628 56         105 my @args = ();
5629 56         98 my $changed = 0;
5630 56         105 foreach my $a (@$arglist) {
5631 94 100       372 if ($a =~ /^#fun\d+$/) {
    100          
    100          
5632             # function bodies are replaced inplace
5633 47         180 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5634 47         165 my $f = $ctx2->exec_statement($a, 1);
5635 47         115 push(@args, $f);
5636 47 100       219 if ($f ne $a) {
5637 16         77 $changed = 1;
5638             }
5639             } elsif (($a =~ /^#expr\d+$/)) {
5640 9         15 my ($op, $o1, $o2) = @{$parser->{strmap}->{$a}};
  9         29  
5641 9         39 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5642 9 50       41 if ($op eq '=') {
5643 9         33 my $k = $ctx2->exec_statement($a, 1);
5644 9         60 push(@args, $k);
5645             }
5646             } elsif ($a =~ /^#stmt\d+$/) {
5647 13         34 my $cmd = $parser->{strmap}->{$a}->[0];
5648 13         49 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5649 13 100       56 if ($cmd eq 'static') {
    50          
5650 9         34 my $k = $ctx2->exec_statement($a, 1);
5651 9         52 push(@args, $k);
5652             } elsif ($cmd eq 'const') {
5653 4         23 my $k = $ctx2->exec_statement($a, 1);
5654 4         29 push(@args, $k);
5655             }
5656             } else {
5657 25         52 push(@args, $a);
5658             }
5659             }
5660 56 100       120 if ($changed) {
5661 13         50 my $b2 = $parser->setblk('std', \@args);
5662 13         74 my $k = $parser->setclass($c, $b2, $p);
5663 13         43 $ctx->registerclass($c, $k);
5664 13         38 return $k;
5665             }
5666 43 100 66     150 if (defined $c && !$ctx->getclass($c)) {
5667 2 50       11 $ctx->{log}->($ctx, 'exec', $var, "register local class $var [$c]") if $ctx->{log};
5668 2         11 $ctx->registerclass($c, $var);
5669             }
5670             } else {
5671 1         6 $ctx->{warn}->($ctx, 'exec', $var, "skip");
5672             }
5673 219         546 return $var;
5674             }
5675              
5676             # track variable assignments in expressions (optionally reinsert them later)
5677             #
5678             sub track_assignment {
5679 456     456 0 951 my ($ctx, $var, $val) = @_;
5680              
5681 456         1471 $ctx->{varhist}{$var} = [$val, $histidx++];
5682 456         853 return;
5683             }
5684              
5685             sub discard_pending_assignments {
5686 17     17 0 41 my ($ctx) = @_;
5687 17         47 $ctx->{varhist} = {};
5688 17         63 return;
5689             }
5690              
5691             sub have_assignments {
5692 2     2 0 6 my ($ctx) = @_;
5693              
5694 2 50       4 if (scalar keys %{$ctx->{varhist}} > 0) {
  2         8  
5695 0         0 return 1;
5696             }
5697 2         5 return 0;
5698             }
5699              
5700             sub insert_assignments {
5701 3058     3058 0 5840 my ($ctx, $stmt) = @_;
5702 3058         5009 my $parser = $ctx->{parser};
5703              
5704 3058 100       4322 if (scalar keys %{$ctx->{varhist}} > 0) {
  3058         9262  
5705             # add assignments in exec-order
5706             #
5707 395         813 my @blk = ();
5708 395         729 my @ass = ();
5709 395         677 foreach my $v (sort { $ctx->{varhist}{$a}->[1] <=> $ctx->{varhist}{$b}->[1] } keys %{$ctx->{varhist}}) {
  24         122  
  395         1467  
5710 417 0       966 $ctx->{log}->($ctx, 'assign', defined $stmt ? $stmt : '[]', "$v = $ctx->{varhist}{$v}->[0]") if $ctx->{log};
    50          
5711              
5712 417 100       1008 if ($ctx->{varhist}{$v}->[0] ne '#unresolved') {
5713 305         431 my $e;
5714 305 100       1033 if ($v =~ /^\$eval\$/) {
5715             # eval blocks are inserted at front before assignments
5716             #
5717 218         468 $e = $ctx->{varhist}{$v}->[0]; # eval block
5718 218 100       608 if (is_block($e)) {
5719 157         459 $parser->flatten_block($e, \@blk);
5720             } else {
5721 61         178 push(@blk, $e);
5722             }
5723             } else {
5724             # assignments are inserted at front
5725             #
5726 87         342 $e = $parser->setexpr('=', $v, $ctx->{varhist}{$v}->[0]);
5727 87         261 push(@ass, $e);
5728             }
5729             }
5730             }
5731 395 100 100     1678 if ((scalar @ass > 0) || (scalar @blk > 0)) {
5732 193 100       422 if (defined $stmt) {
5733 165         466 $parser->flatten_block($stmt, \@ass);
5734             }
5735 193         707 $stmt = $parser->setblk('flat', [@blk, @ass]);
5736             }
5737             }
5738 3058         8283 $ctx->{varhist} = {};
5739 3058         5823 return $stmt;
5740             }
5741              
5742             1;
5743              
5744             __END__