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   139388 use strict;
  4         26  
  4         137  
7 4     4   32 use warnings;
  4         7  
  4         131  
8 4     4   23 use Carp 'croak';
  4         8  
  4         204  
9 4     4   872 use PHP::Decode::Array qw(is_int_index);
  4         14  
  4         232  
10 4     4   1772 use PHP::Decode::Parser qw(:all);
  4         13  
  4         857  
11 4     4   3362 use PHP::Decode::Func;
  4         21  
  4         379  
12              
13             our $VERSION = '0.301';
14              
15             # avoid 'Deep recursion' warnings for depth > 100
16             #
17 4     4   29 no warnings 'recursion';
  4         9  
  4         210246  
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 8628 my ($class, %args) = @_;
59 1524         2939 my %varmap;
60 1524 50       3896 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         25453 superglobal => \%superglobal,
79             %args, # might override preceding keys
80             }, $class;
81              
82 1524         7242 $self->{max_loop_const} = $self->{max_loop};
83 1524         3314 $self->{max_loop_while} = 10 * $self->{max_loop};
84 1524         2662 $self->{max_repeat} = $self->{max_loop};
85              
86 1524 100       4864 $self->{varmap}{inst} = {} unless exists $self->{varmap}{inst};
87 1524 100       3529 $self->{varmap}{fun} = {} unless exists $self->{varmap}{fun};
88 1524 100       3400 $self->{varmap}{class} = {} unless exists $self->{varmap}{class};
89 1524 100       3417 $self->{varmap}{static} = {} unless exists $self->{varmap}{static};
90 1524 100       4461 $self->{varmap}{stdout} = { buf => [] } unless exists $self->{varmap}{stdout};
91              
92 1524 0 33     3574 $self->_setup_env($self->{with}{getenv}) if exists $self->{with}{getenv} && $self->{toplevel};
93              
94 1524         5079 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 2608 my ($ctx, %args) = @_;
101              
102 801 100       1995 $args{globals} = $ctx->{globals} unless exists $args{globals};
103 801 100       1691 $args{varmap} = $ctx->{varmap} unless exists $args{varmap};
104 801 100       1965 $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       4985 exists $ctx->{class_scope} ? (class_scope => $ctx->{class_scope}) : (),
    100          
121             %args);
122              
123 801         2597 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 362 my ($ctx) = @_;
133 172         305 my %varmap = %{$ctx->{varmap}};
  172         1345  
134 172 100       602 my $globals = $ctx->{infunction} ? {%{$ctx->{globals}}} : \%varmap;
  64         263  
135              
136 172         659 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 827 my ($ctx, %args) = @_;
143              
144 242         584 $args{globals} = {};
145 242         589 $args{varmap} = {};
146 242         417 $args{varhist} = {};
147 242         416 $args{skipundef} = 1; # skip undefined variables
148 242         397 $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       658 if (exists $ctx->{globals}{fun}) {
157 232 50       489 if (exists $ctx->{varmap}{fun}) {
158 232         320 $args{globals}{fun} = {%{$ctx->{globals}{fun}}, %{$ctx->{varmap}{fun}}};
  232         765  
  232         857  
159             } else {
160 0         0 $args{globals}{fun} = {%{$ctx->{globals}{fun}}};
  0         0  
161             }
162             }
163 242 100       640 if (exists $ctx->{globals}{class}) {
164 229 50       525 if (exists $ctx->{varmap}{class}) {
165 229         330 $args{globals}{class} = {%{$ctx->{globals}{class}}, %{$ctx->{varmap}{class}}};
  229         532  
  229         638  
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       623 if (exists $ctx->{varmap}{global}) {
173 8         16 $args{varmap}{global} = {%{$ctx->{varmap}{global}}};
  8         24  
174             }
175 242         867 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 1091 my ($ctx, %args) = @_;
182 272 50       820 my $varmap = $args{varmap} or croak __PACKAGE__ . " expects varmap";
183              
184 272         507 $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       592 if (exists $ctx->{varmap}{'$this'}) {
190 1         4 $args{varmap}{'$this'} = $ctx->{varmap}{'$this'};
191             }
192 272 50       635 if (exists $ctx->{varmap}{inst}) {
193 272         645 $args{varmap}{inst} = $ctx->{varmap}{inst};
194             }
195 272 50       636 if (exists $ctx->{varmap}{fun}) {
196 272         526 $args{varmap}{fun} = $ctx->{varmap}{fun};
197             }
198 272 50       650 if (exists $ctx->{varmap}{class}) {
199 272         528 $args{varmap}{class} = $ctx->{varmap}{class};
200             }
201 272 50       592 if (exists $ctx->{varmap}{static}) {
202 272         546 $args{varmap}{static} = $ctx->{varmap}{static};
203             }
204 272         941 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         3 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       4 if (scalar @$args >= 1) {
271             # string handler ( string $buffer [, int $phase ] )
272             #
273 1         3 my $handler = $$args[0];
274 1         5 my $name = $parser->get_strval($$args[0]);
275 1 50 33     10 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       4 if (defined $fun) {
281 1         3 my ($_name, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  1         4  
282 1         5 my $f = $parser->setfun(undef, $a, $b);
283 1         4 my $v = '$ob_'.$name;
284 1         3 $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         4 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 4 my ($ctx, $cmd, $args) = @_;
313 1         4 my $parser = $ctx->{parser};
314              
315 1 50 33     7 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
316 1 50       3 if (exists $ctx->{globals}{stdout}{handler}) {
317 1 50       6 unless ($ctx->{infunction}) {
318 1         3 my @r;
319 1         2 my $handler = $ctx->{globals}{stdout}{handler};
320 1         3 my @ob = @{$ctx->{globals}{stdout}{ob}};
  1         4  
321 1         3 delete $ctx->{globals}{stdout}{handler};
322 1         3 delete $ctx->{globals}{stdout}{ob};
323 1 50       5 $ctx->{log}->($ctx, 'cmd', $cmd, "(handler: $handler) [%s]", join(' ', @ob)) if $ctx->{log};
324 1         5 merge_str_list(\@ob, $parser);
325 1         7 while (my $s = shift @ob) {
326 1 50 33     5 if (is_strval($s) && ($handler ne '#null')) {
327 1         5 my $h = $parser->setcall($handler, [$s]);
328 1         4 my $k = $ctx->exec_statement($h);
329              
330 1 50       6 if (defined $k) {
331 1         7 push(@r, $h);
332             }
333             } else {
334 0         0 push(@{$ctx->{globals}{stdout}{buf}}, $s);
  0         0  
335             }
336             }
337 1 50       4 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 1884 my ($list, $ctx, $parser) = @_;
376              
377 1013         1948 foreach my $k (@$list) {
378 1536 100 100     7008 if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) {
    100          
    100          
379 10         68 my ($arg, $block) = @{$parser->{strmap}->{$k}}[1..2];
  10         32  
380 10         27 $ctx->{namespace} = $arg; # always use case in-sensitive later
381             } elsif ($k =~ /^#fun\d+$/) {
382 175         312 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$k}};
  175         512  
383 175 100       467 if (defined $f) {
384 164         428 $ctx->registerfun($f, $k);
385             }
386             } elsif ($k =~ /^#class\d+$/) {
387 53         94 my ($c, $b, $p) = @{$parser->{strmap}->{$k}};
  53         148  
388 53         86 my ($type, $arglist) = @{$parser->{strmap}->{$b}};
  53         129  
389              
390 53         95 foreach my $a (@$arglist) {
391 89 100       236 if ($a =~ /^#fun\d+$/) {
392 45         114 my $f = $parser->{strmap}->{$a}->[0];
393 45 50       98 if (defined $f) {
394 45 50       105 my $name = defined $c ? $c : 'class@anonymous';
395 45         156 my $ctx2 = $ctx->subctx(class_scope => lc($name), infunction => 0);
396 45         159 $ctx2->registerfun($f, $a);
397             }
398             }
399             }
400 53 50       123 if (defined $c) {
401 53         136 $ctx->registerclass($c, $k);
402             }
403             }
404             }
405 1013         1952 return;
406             }
407              
408             sub _move_funcs_to_start {
409 784     784   1346 my ($parser, $stmt) = @_;
410 784         1138 my @funcs = ();
411 784         1108 my @code = ();
412 784         1080 my @block = ();
413            
414 784 100       1993 if (is_block($stmt)) {
415 457         627 my ($type, $a) = @{$parser->{strmap}{$stmt}};
  457         1183  
416              
417 457         1239 foreach my $k (@$a) {
418 1090 100 100     4349 if (($k =~ /^#stmt\d+$/) && ($parser->{strmap}{$k}[0] eq 'namespace')) {
    100          
419 10         20 push(@block, @funcs);
420 10         14 push(@block, @code);
421 10         14 push(@block, $k);
422 10         14 @funcs = ();
423 10         16 @code = ();
424             } elsif ($k =~ /^#(fun|class)\d+$/) {
425 184         480 push(@funcs, $k);
426             } else {
427 896         1840 push(@code, $k);
428             }
429             }
430 457         731 push(@block, @funcs);
431 457         884 push(@block, @code);
432 457 100       1156 if (scalar @block == 1) {
433 1         4 return $block[0];
434             }
435 456         1594 my $s = $parser->setblk('flat', [@block]);
436 456         1465 return $s;
437             }
438 327         750 return $stmt;
439             }
440              
441             sub parse_eval {
442 792     792 1 1528 my ($ctx, $arg) = @_;
443 792         1310 my $parser = $ctx->{parser};
444              
445 792         2095 my $s = $parser->get_strval($arg);
446 792 100       1868 if (defined $s) {
447 784 50       1899 $ctx->{log}->($ctx, 'eval', $arg, "%s", $parser->shortstr($s, 400)) if $ctx->{log};
448              
449 784 100       2116 $parser->{strmap}->{'__FILE__'} = $s if $ctx->{toplevel}; # for fopen('__FILE__')
450              
451             # (1) tokenize input file
452             #
453 784         3374 my $quote = $parser->tokenize_line($s, $ctx->{quote});
454 784 50       2269 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         1421 my $tok = $parser->{tok};
459              
460             #$ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", $parser->shortstr(join(' ', @$tok), 200)) if $ctx->{log};
461 784 50       1609 $ctx->{log}->($ctx, 'eval', $arg, "tokens: %s", join(' ', @$tok)) if $ctx->{log};
462              
463             # (2) parse tokens to statements
464             #
465 784         2099 my $out = $parser->read_code($tok);
466              
467 784 50       1808 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         2666 return $out; # empty block if token list is empty
472             }
473 8         16 return;
474             }
475              
476             sub exec_eval {
477 784     784 1 2118 my ($ctx, $arg) = @_;
478 784         1552 my $parser = $ctx->{parser};
479              
480 784 50       1577 if (defined $arg) {
    0          
481 784         1247 my @funcs = ();
482 784         1133 my @code = ();
483              
484 784         1359 $ctx->{tainted} = 0;
485              
486             # rearrange tokens
487             #
488 784         1815 my $out = _move_funcs_to_start($parser, $arg);
489 784 100       1728 if (is_block($out)) {
490 456         652 my ($type, $a) = @{$parser->{strmap}->{$out}};
  456         1023  
491 456         1126 @funcs = @$a;
492             } else {
493 328         689 @funcs = ($out);
494             }
495              
496             # (3) exec statements
497             #
498 784         2338 register_funcs(\@funcs, $ctx, $parser);
499 784 50       1855 $ctx->{log}->($ctx, 'eval', $arg, "parsed: $out") if $ctx->{log};
500 784 100       1721 my $in_block = is_block($out) ? 0 : 1;
501 784         1989 my $stmt = $ctx->exec_statement($out, $in_block);
502              
503 784 50       1846 $ctx->{log}->($ctx, 'eval', $arg, "statement: $stmt") if $ctx->{log};
504              
505             # (4) insert remaining assignments at front of block
506             #
507 784         1673 $stmt = $ctx->insert_assignments($stmt);
508              
509             # (5) flush output buffer
510             #
511 784 50 66     3138 if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) {
512 722 100       1707 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         5 my $e = $parser->setcall('ob_end_flush', []);
517 1         4 my $k = $ctx->exec_statement($e);
518              
519 1         3 my @seq = ();
520 1         19 $parser->flatten_block($stmt, \@seq);
521 1         6 $stmt = $parser->setblk('flat', [@seq, $k]);
522             }
523             }
524              
525             # (6) log stdout
526             #
527 784 50 66     2551 if ($ctx->{toplevel} && exists $ctx->{varmap}{stdout}) {
528 722 100       1013 if (@{$ctx->{varmap}{stdout}{buf}}) {
  722         1724  
529 96         155 my @stdout = @{$ctx->{varmap}{stdout}{buf}};
  96         232  
530 96         188 my $v = '$STDOUT';
531 96         138 my $k;
532 96         324 merge_str_list(\@stdout, $parser);
533 96         256 while (my $s = shift @stdout) {
534 97 100       205 if (defined $k) {
535 1         4 $k = $parser->setexpr('.', $k, $s);
536             } else {
537 96         236 $k = $s;
538             }
539             }
540 96 50       240 unless (exists $ctx->{skip}{stdout}) {
541 96         276 my $e = $parser->setexpr('=', $v, $k);
542 96         195 my @seq = ();
543 96         322 $parser->flatten_block($stmt, \@seq);
544 96         427 $stmt = $parser->setblk('flat', [@seq, $e]);
545             }
546             }
547             }
548              
549             # (7) flatten block if necessary
550             #
551 784 100       1956 if (is_block($stmt)) {
552 519         797 my ($type, $a) = @{$parser->{strmap}->{$stmt}};
  519         1382  
553 519 100       1300 if ($type ne 'flat') {
554 12         30 my @seq = ();
555 12         44 $parser->flatten_block($stmt, \@seq);
556 12 50       48 if (scalar @seq > 1) {
    0          
557 12         43 $stmt = $parser->setblk('flat', [@seq]);
558             } elsif (scalar @seq > 0) {
559 0         0 $stmt = $seq[0];
560             }
561             }
562             }
563 784         1217 my $outlist;
564 784 100 50     1990 $outlist = join(' ', @{$ctx->{varmap}{stdout}{buf}}) if (exists $ctx->{varmap}{stdout} && scalar @{$ctx->{varmap}{stdout}{buf}});
  104         316  
  784         2295  
565 784 0       1553 $ctx->{log}->($ctx, 'eval', $arg, "got: $stmt%s", defined $outlist ? ' ('.$outlist.')' : '') if $ctx->{log};
    50          
566 784         3160 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 1699 my ($s, $parser) = @_;
578            
579 859 100       2059 if ($s =~ /^#elem\d+$/) {
580 17         40 my ($v, $i) = @{$parser->{strmap}->{$s}};
  17         63  
581 17 50       50 if (defined $v) {
582 17 100       48 if (!is_variable($v)) {
583 4         20 return 0;
584             }
585             }
586 13 50       44 if (defined $i) {
587 13 100       40 if (!is_strval($i)) {
588 2         11 return 0;
589             }
590             }
591 11         58 return 1;
592             }
593 842         3562 return 0;
594             }
595              
596             # check if elem is anonymous function call, and return it
597             #
598             sub _anon_func_call {
599 20     20   53 my ($parser, $s) = @_;
600              
601 20 50       65 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         65 return;
611             }
612              
613             # check if expression in block contains a local variable
614             #
615             sub contains_local_var {
616 258     258 0 460 my ($ctx, $info) = @_;
617              
618 258         355 foreach my $var (keys %{$info->{vars}}) {
  258         639  
619 11 100       43 next if $ctx->is_superglobal($var);
620 4 50       20 next if $ctx->is_global_var($var);
621              
622 4         12 return 1;
623             }
624 254         1066 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 2014 my ($ctx, $info) = @_;
631              
632 1121         1607 foreach my $var (keys %{$info->{vars}}) {
  1121         2661  
633 194 100       834 next if $ctx->is_superglobal($var);
634              
635 188         611 my $val = $ctx->getvar($var, 1);
636 188 100       771 if (!defined $val) {
    100          
637 6         24 return $var;
638             } elsif ($val eq '#unresolved') {
639 15         44 return $var;
640             }
641             }
642 1100         3372 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 198 my ($seq, $parser) = @_;
669 102         173 my @list = ();
670              
671 102         288 while (my $s = shift @$seq) {
672 106 100 100     275 if (is_strval($s) && !is_const($s)) {
673 99         166 my $i;
674 99         282 for ($i=0; $i < scalar @$seq; $i++) {
675 29 100 100     82 last unless (is_strval($seq->[$i]) && !is_const($seq->[$i]));
676             }
677 99 100       488 if ($i > 0) {
    100          
    100          
678 17         58 my @list = ($s, splice(@$seq, 0, $i));
679 17         43 my $str = join('', map { $parser->{strmap}->{$_} } @list);
  43         130  
680 17         71 $s = $parser->setstr($str);
681             } elsif ($s =~ /^#(const|num)\d+$/) {
682 17         51 my $str = $parser->{strmap}->{$s};
683 17         58 $s = $parser->setstr($str);
684             } elsif (is_null($s)) {
685 1         7 $s = $parser->setstr('');
686             }
687             }
688 106         369 push(@list, $s);
689             }
690 102         201 @$seq = @list;
691 102         251 return;
692             }
693              
694             # return flat block or single statement
695             #
696             sub _flat_block_or_single {
697 128     128   285 my ($parser, $seq) = @_;
698              
699 128 100       338 if (scalar @$seq == 1) {
700 12         76 return $seq->[0];
701             }
702 116         410 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   27 my ($parser, $s) = @_;
709              
710 10 50       38 if (is_block($s)) {
711 10         24 my ($type, $a) = @{$parser->{strmap}->{$s}};
  10         38  
712 10 50       37 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       17 unless (_anon_func_call($parser, $s)) {
730 4         17 $s = _to_code_block($parser, $s);
731 4         20 my $f = $parser->setfun(undef, [], $s);
732 4         13 $s = $parser->setcall($f, []);
733             }
734 4         11 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   5235 my ($parser, $s, $pattern) = @_;
755              
756 2763 100       5591 if (is_block($s)) {
757 318         539 my ($type, $a) = @{$parser->{strmap}->{$s}};
  318         886  
758 318 100       788 if (scalar @$a > 0) {
759 300         847 return &_final_break($parser, $a->[-1], $pattern);
760             }
761             }
762 2463 100       6611 if ($s =~ /^#stmt\d+$/) {
763 767         1748 my $cmd = $parser->{strmap}->{$s}->[0];
764 767 100       14135 if ($cmd =~ /^$pattern$/) {
765 391         1682 return $s;
766             }
767             }
768 2072         4025 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   180 my ($parser, $s) = @_;
823              
824 104 100       266 if ($s =~ /^#stmt\d+$/) {
825 40         82 my $cmd = $parser->{strmap}->{$s}->[0];
826 40         66 my $arglist = $parser->{strmap}->{$s}->[1];
827 40 50       94 if ($cmd eq 'echo') {
828 40         61 my $all_str = 1;
829              
830 40         76 foreach my $p (@$arglist) {
831 40 50       91 $all_str = 0 if !is_strval($p);
832             }
833 40         123 return ($arglist, $all_str);
834             }
835             }
836 64         143 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   2804 my ($parser, $s, $pattern, $info) = @_;
843              
844 1350         1894 foreach my $call (keys %{$info->{calls}}) {
  1350         3984  
845 102 100       374 next if ($info->{calls}{$call}) eq 'return'; # allow skipped call in return?
846              
847 95         192 my $name = $call;
848 95 50       307 if ($name !~ /^(ob_start|exit|die|__halt_compiler)$/i) { # allow skipped exit-like calls
849 95 50       285 if ($name !~ /^(error_reporting)$/i) { # allow skipped calls without side effects
850 95 50       609 if ($name =~ /^$pattern$/) {
851 95         357 return $call;
852             }
853             }
854             }
855             }
856 1255         1931 foreach my $stmt (keys %{$info->{stmts}}) {
  1255         2714  
857 51         138 my $cmd = $parser->{strmap}->{$stmt}->[0];
858 51 100       141 if ($cmd eq 'echo') {
    50          
859             # 'echo' is kept inline for non-string argument
860             #
861 50         88 my $arglist = $parser->{strmap}->{$stmt}->[1];
862 50 50 33     253 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       18 if ($cmd =~ /^$pattern$/) {
869 1         5 return $stmt;
870             }
871             }
872             }
873 1254         3437 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 1263 my ($ctx, $cmd, $stmt) = @_;
883 554         922 my $parser = $ctx->{parser};
884              
885 554         4340 my $info = {vars => {}, calls => {}, stmts => {}, assigns => {}, noassigns => {}, resolved => {$cmd => 1}, unresolved => {}, global_assigns => {}, local_assigns => {}};
886 554         2372 $parser->stmt_info($stmt, $info);
887              
888 554         910 foreach my $call (keys %{$info->{calls}}) {
  554         1688  
889 201         498 my $fun = $ctx->getfun($call);
890              
891 201         367 $call = lc($call);
892              
893 201 100       580 if (defined $fun) {
    100          
894 32         59 my ($name, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  32         103  
895              
896             # check if function was already visited
897             #
898 32 50       86 if (!exists $info->{resolved}{$call}) {
899 32         106 my $subinfo = $ctx->get_unresolved_info($call, $b);
900              
901 32         66 $info->{global_assigns} = {%{$info->{global_assigns}}, %{$subinfo->{global_assigns}}};
  32         74  
  32         72  
902 32         91 $info->{unresolved} = {%{$info->{unresolved}}, %{$subinfo->{unresolved}}};
  32         74  
  32         77  
903 32         64 $info->{resolved} = {%{$info->{resolved}}, %{$subinfo->{resolved}}};
  32         70  
  32         88  
904 32         197 $info->{resolved}{$call} = 1;
905             }
906             } elsif (my $f = PHP::Decode::Func::get_php_func($call)) {
907 40 100       99 if (PHP::Decode::Func::func_may_call_callbacks($call)) {
908 2         4 my $skip = 0;
909 2 50       7 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         8 $info->{unresolved}{$call} = 1;
919             }
920             }
921             # func without side-effects on vars here
922             } else {
923 129         343 $info->{unresolved}{$call} = 1;
924             }
925             }
926 554         972 foreach my $var (keys %{$info->{assigns}}) {
  554         1588  
927 273 50       841 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         635 my ($g) = global_split($var);
949 265 100       690 if (defined $g) {
950 26         65 $info->{global_assigns}{$g} = 1;
951 26         64 next;
952             }
953 239 100       607 if ($ctx->is_superglobal($var)) {
954 2         7 $info->{global_assigns}{$var} = 1;
955 2         6 next;
956             }
957 237         698 $info->{local_assigns}{$var} = 1;
958             } elsif ($var =~ /^#obj\d+$/) {
959 7         19 $info->{local_assigns}{$var} = 1;
960             } else {
961 1         3 $info->{unresolved}{$var} = 1;
962             }
963             }
964 554         1987 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   428 my ($parser, $s) = @_;
971              
972 209 50       704 unless ($s =~ /^#fun\d+$/) {
973 0         0 return;
974             }
975 209         326 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$s}};
  209         658  
976 209         568 $s = $parser->flatten_block_if_single($b);
977              
978 209 100       646 if ($s =~ /^#stmt\d+$/) {
979 92         203 my $cmd = $parser->{strmap}->{$s}->[0];
980 92 100       276 if (lc($cmd) eq 'return') {
981 61         128 my $val = $parser->{strmap}->{$s}->[1];
982 61 100       177 if ($val =~ /^#call\d+$/) {
983 7         17 my ($name, $arglist) = @{$parser->{strmap}->{$val}};
  7         23  
984              
985             # eval might create local vars
986 7 100 100     23 if (is_symbol($name) && (lc($name) ne 'eval') && (scalar @$arglist == scalar @$a)) {
      66        
987 5         10 my $i = 0;
988 5         10 my $arg_match = 1;
989 5         15 foreach my $k (@$arglist) {
990 4 100       14 if ($k ne $a->[$i]) {
991 1         2 $arg_match = 0;
992             }
993 4         10 $i++;
994             }
995 5 100       11 if ($arg_match) {
996 4         15 return $name;
997             }
998             }
999             }
1000             }
1001             }
1002 205         467 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 1892 my ($ctx, $rhs) = @_;
1009 1003         1603 my $parser = $ctx->{parser};
1010              
1011 1003 100       2471 if ($rhs =~ /^#expr\d+$/) {
1012 54         106 my ($op, $v1, $v2) = @{$parser->{strmap}->{$rhs}};
  54         173  
1013              
1014 54 50 33     211 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         151 return 1;
1023             }
1024 949         3817 my $info = {vars => {}, calls => {}, stmts => {}};
1025 949         3461 $parser->stmt_info($rhs, $info);
1026              
1027 949 100 100     2097 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         376 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         42 return 1;
1038             } elsif (is_variable($rhs)) {
1039             # forward unresolved state to lhs
1040             #
1041 17         59 my $val = $ctx->getvar($rhs, 1);
1042 17 100 66     108 if (defined $val && ($val eq '#unresolved')) {
1043 15         74 return 1;
1044             }
1045             }
1046 854         4139 return 0;
1047             }
1048              
1049             # check if this is pre/post increment expr
1050             #
1051             sub _is_increment_op {
1052 1238     1238   2168 my ($parser, $stmt) = @_;
1053              
1054 1238 100       2512 if ($stmt =~ /^#expr\d+$/) {
1055 50         114 my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}};
  50         162  
1056 50   100     312 return ($op eq '++') || ($op eq '--');
1057             }
1058 1188         3452 return;
1059             }
1060              
1061             # return varable if statement is assignment
1062             #
1063             sub _var_assignment {
1064 2345     2345   4892 my ($parser, $stmt) = @_;
1065              
1066 2345 100       5992 if ($stmt =~ /^#expr\d+$/) {
1067 1120         1694 my ($op, $v1, $v2) = @{$parser->{strmap}->{$stmt}};
  1120         3151  
1068              
1069 1120 100 66     4210 if (($op eq '=') && defined $v2) {
1070 1070         3585 return ($v1, $v2);
1071             }
1072             }
1073 1275         2531 return;
1074             }
1075              
1076             sub get_indexed_array_var {
1077 160     160 0 314 my ($ctx, $var) = @_;
1078 160         267 my $parser = $ctx->{parser};
1079              
1080 160 100       354 if ($var =~ /^#elem\d+$/) {
1081 50         75 my ($v, $i) = @{$parser->{strmap}->{$var}};
  50         117  
1082              
1083 50         111 my $val = $ctx->getvar($v, 1);
1084 50 50 33     164 if (defined $val && is_array($val)) {
1085 50         155 return ($v, $val);
1086             }
1087             }
1088 110         225 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 265 my ($ctx, $type, $stmt, $list, $res) = @_;
1098 113         196 my $parser = $ctx->{parser};
1099 113         159 my $changed = 0;
1100              
1101 113         299 ELEM: for (my $i = 0; $i < scalar @$res; $i++) {
1102 160         257 my $elem = $res->[$i];
1103              
1104             # merge previous array assignment with new one
1105             #
1106 160         294 my ($v, $lhs) = _var_assignment($parser, $elem);
1107 160 100       373 if (defined $v) {
1108             # optimize only trailing var assignments to strval or array
1109             #
1110 133         340 for (my $j = scalar @$list; $j > 0; $j--) {
1111 167         310 my $prev = $list->[$j-1];
1112 167         335 my ($vp, $lhsp) = _var_assignment($parser, $prev);
1113 167 100       371 if (!defined $vp) {
1114 10 50 33     31 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         3 push(@$list, $elem);
1118 1         5 next ELEM; # other statements than echo or assign
1119             } else {
1120 9         29 next;
1121             }
1122             }
1123             #$ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v: $prev $vp $lhsp") if $ctx->{log};
1124 157 100 100     348 unless (is_strval($lhsp) || is_array($lhsp)) {
1125 1         3 push(@$list, $elem);
1126 1         6 next ELEM; # unresolved assignment
1127             }
1128             # substitute: multiple var assignment -> single assigment
1129             #
1130 156 100 100     353 if (is_variable($v) && ($v eq $vp)) {
1131 53 50       140 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v [$prev -> $elem]") if $ctx->{log};
1132 53         112 splice(@$list, $j-1, 1); # remove $prev from list
1133 53         85 $changed = 1;
1134 53         97 push(@$list, $elem);
1135 53         173 next ELEM;
1136             }
1137              
1138             # substitute: multiple array assignment -> single assigment
1139             #
1140 103         228 my ($va, $a) = $ctx->get_indexed_array_var($v);
1141 103 100       283 if (defined $va) {
1142 38 100       101 if ($va eq $vp) {
1143 21         78 my $k = $parser->setexpr('=', $va, $a);
1144 21 50       74 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: $v ($va $a) [$prev, $elem -> $k]") if $ctx->{log};
1145 21         50 splice(@$list, $j-1, 1); # remove $prev from list
1146 21         41 $res->[$i] = $k;
1147 21         30 $changed = 1;
1148 21         48 push(@$list, $k);
1149 21         74 next ELEM;
1150             }
1151             }
1152             }
1153             # if no variable was found, then substitute new single array elem assigment -> array assignmet
1154             #
1155 57         138 my ($va, $a) = $ctx->get_indexed_array_var($v);
1156 57 100       174 if (defined $va) {
1157 12         36 my $arr = $parser->{strmap}{$a};
1158 12         36 my $keys = $arr->get_keys();
1159 12         23 my $size = scalar @$keys;
1160              
1161             # also allow assignment to existing array ($size > 1)
1162             #
1163 12 100       32 if ($size > 1) {
1164 5 50       16 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va already has elements") if $ctx->{log};
1165             }
1166 12         41 my $k = $parser->setexpr('=', $va, $a);
1167 12 50       33 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: initial $va ($a size=$size) [$elem -> $k]") if $ctx->{log};
1168 12         23 $res->[$i] = $k;
1169 12         18 $changed = 1;
1170 12         25 push(@$list, $k);
1171 12         55 next ELEM;
1172             }
1173             }
1174              
1175             # merge previous echo statement with new one
1176             #
1177 72         260 my ($args, $all_str) = _get_echo_arglist($parser, $elem);
1178 72 100       144 if (defined $args) {
1179 21         73 for (my $j = scalar @$list; $j > 0; $j--) {
1180 22         41 my $prev = $list->[$j-1];
1181 22         44 my ($prev_args, $prev_all_str) = _get_echo_arglist($parser, $prev);
1182              
1183 22 100       50 if (!defined $prev_args) {
1184 12         28 next;
1185             }
1186 10         18 my $k;
1187 10 50 33     41 if ($all_str && $prev_all_str) {
1188 10         24 my $val = join('', map { $parser->{strmap}->{$_} } (@$prev_args, @$args));
  20         89  
1189 10         38 my $str = $parser->setstr($val);
1190 10         42 $k = $parser->setstmt(['echo', [$str]]);
1191             } else {
1192 0         0 $k = $parser->setstmt(['echo', [@$prev_args, @$args]]);
1193             }
1194 10 50       31 $ctx->{log}->($ctx, $type, $stmt, "optimize loop: echo [$prev, $elem -> $k]") if $ctx->{log};
1195 10         20 splice(@$list, $j-1, 1); # remove $prev from list
1196 10         18 $res->[$i] = $k;
1197 10         19 $changed = 1;
1198 10         20 push(@$list, $k);
1199 10         36 next ELEM;
1200             }
1201             }
1202 62         177 push(@$list, $elem);
1203             }
1204 113         259 return $changed;
1205             }
1206              
1207             sub set_tainted {
1208 236     236 0 530 my ($ctx, $stmt) = @_;
1209              
1210 236 100       536 if ($ctx->{tainted}) {
1211 98         388 $ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted");
1212             } else {
1213 138         463 $ctx->{warn}->($ctx, 'taint', $stmt, "set ctx tainted (untainted before)");
1214             }
1215 236 50       10825 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         514 $ctx->{tainted} += 1;
1228 236         548 return;
1229             }
1230              
1231             sub set_globals_unresolved {
1232 10     10 0 29 my ($ctx, $list) = @_;
1233              
1234 10         41 foreach my $k (@$list) {
1235 6 50 33     17 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1236 6 100 100     39 if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne '#unresolved')) {
1237 5 50       19 $ctx->{log}->($ctx, 'set_unresolved', $k, "(global)") if $ctx->{log};
1238 5         16 $ctx->{globals}{$k} = '#unresolved';
1239             }
1240             }
1241             }
1242 10         19 return;
1243             }
1244              
1245             sub set_locals_unresolved {
1246 45     45 0 108 my ($ctx, $list) = @_;
1247              
1248 45         103 foreach my $k (@$list) {
1249 87 100 66     200 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1250 82 100 100     319 if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne '#unresolved')) {
1251 45 50       136 $ctx->{log}->($ctx, 'set_unresolved', $k, "(local)") if $ctx->{log};
1252 45         133 $ctx->{varmap}{$k} = '#unresolved';
1253             }
1254             }
1255             }
1256 45         89 return;
1257             }
1258              
1259             sub set_undefined_globals_unresolved {
1260 12     12 0 32 my ($ctx, $list) = @_;
1261              
1262 12         33 foreach my $k (@$list) {
1263 15 50 33     37 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1264 15 100       54 if (!exists $ctx->{globals}{$k}) {
1265 12 50       40 $ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined global)") if $ctx->{log};
1266 12         36 $ctx->{globals}{$k} = '#unresolved';
1267             }
1268             }
1269             }
1270 12         25 return;
1271             }
1272              
1273             sub set_undefined_locals_unresolved {
1274 96     96 0 262 my ($ctx, $list) = @_;
1275              
1276 96         259 foreach my $k (@$list) {
1277 145 100 66     441 if (is_variable($k) && !$ctx->is_superglobal($k)) {
1278 114 100       376 if (!exists $ctx->{varmap}{$k}) {
1279 63 100       182 if (exists $ctx->{varmap}{global}{$k}) {
1280 1 50       5 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       168 $ctx->{log}->($ctx, 'set_unresolved', $k, "(undefined local)") if $ctx->{log};
1286 62         222 $ctx->{varmap}{$k} = '#unresolved';
1287             }
1288             }
1289             }
1290             }
1291 96         260 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 281 my ($ctx, $info, $type, $stmt) = @_;
1298              
1299 102 100       186 if (keys %{$info->{globals}}) {
  102         373  
1300 12         24 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}}));
  12         64  
1301 12         1132 $ctx->set_undefined_globals_unresolved([keys %{$info->{globals}}]);
  12         78  
1302             }
1303 102 100       197 if (keys %{$info->{vars}}) {
  102         315  
1304 96   66     177 my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}};
  146         799  
  96         288  
1305 96 50       278 if (@vars) {
1306 96         481 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars));
1307 96         6308 $ctx->set_undefined_locals_unresolved(\@vars);
1308             }
1309             }
1310 102         255 return;
1311             }
1312              
1313             # invalidate all variables with dependencies on subsequent calls of same block.
1314             #
1315             sub invalidate_vars {
1316 31     31 0 84 my ($ctx, $info, $type, $stmt) = @_;
1317              
1318 31 100       46 if (keys %{$info->{global_assigns}}) {
  31         108  
1319 3         16 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found global assigns[%s]", join(' ', keys %{$info->{global_assigns}}));
  3         20  
1320 3         142 $ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]);
  3         21  
1321             }
1322 31 100       54 if (keys %{$info->{local_assigns}}) {
  31         98  
1323 28         68 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found local assigns[%s]", join(' ', keys %{$info->{local_assigns}}));
  28         165  
1324 28         1301 $ctx->set_locals_unresolved([keys %{$info->{local_assigns}}]);
  28         167  
1325             }
1326 31 100       85 if (keys %{$info->{unresolved}}) {
  31         115  
1327 18         39 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found unresolved[%s]", join(' ', keys %{$info->{unresolved}}));
  18         93  
1328              
1329             # TODO: is this necessary with set_tainted()?
1330             #
1331 18 100       391 if (keys %{$info->{globals}}) {
  18         94  
1332 2         8 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found globals[%s]", join(' ', keys %{$info->{globals}}));
  2         14  
1333 2         31 $ctx->set_globals_unresolved([keys %{$info->{globals}}]);
  2         13  
1334             }
1335 18 100       33 if (keys %{$info->{vars}}) {
  18         70  
1336 17   33     33 my @vars = grep { !exists $info->{globals}{$_} && !exists $info->{unresolved}{$_} } keys %{$info->{vars}};
  33         179  
  17         53  
1337 17 50       55 if (@vars) {
1338 17         84 $ctx->{warn}->($ctx, $type, $stmt, "unresolve - found locals[%s]", join(' ', @vars));
1339 17         346 $ctx->set_locals_unresolved(\@vars);
1340             }
1341             }
1342             }
1343 31         85 return;
1344             }
1345              
1346             sub update_unresolved {
1347 172     172 0 339 my ($ctx, $ctx2) = @_;
1348              
1349             # copy unresolved status from ctx2 to ctx
1350             #
1351 172         256 foreach my $k (keys %{$ctx2->{globals}}) {
  172         724  
1352 1053 100 100     1959 if (is_variable($k) && !$ctx2->is_superglobal($k)) {
1353 178 100 66     773 if (!exists $ctx->{globals}{$k} || ($ctx->{globals}{$k} ne $ctx2->{globals}{$k})) {
1354 34 50       110 $ctx->{log}->($ctx, 'set_unresolved', $k, "(global) update from clone") if $ctx->{log};
1355 34         87 $ctx->{globals}{$k} = '#unresolved';
1356             }
1357             }
1358             }
1359 172         382 foreach my $k (keys %{$ctx2->{varmap}}) {
  172         628  
1360 1473 100 100     2550 if (is_variable($k) && !$ctx2->is_superglobal($k)) {
1361 294 100 66     1257 if (!exists $ctx->{varmap}{$k} || ($ctx->{varmap}{$k} ne $ctx2->{varmap}{$k})) {
1362 37 50       95 $ctx->{log}->($ctx, 'set_unresolved', $k, "(local) update from clone") if $ctx->{log};
1363 37         97 $ctx->{varmap}{$k} = '#unresolved';
1364             }
1365             }
1366             }
1367 172         371 return;
1368             }
1369              
1370             sub is_superglobal {
1371 6090     6090 0 10865 my ($ctx, $var) = @_;
1372              
1373 6090         21009 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 58 my ($ctx, $var) = @_;
1380 20         55 my ($g) = global_split($var);
1381 20 100       59 if (defined $g) {
1382 10         27 return $g; # converted $GLOBALS['var']
1383             }
1384 10 50       35 if (exists $ctx->{varmap}{global}{$var}) {
1385 0         0 return $var; # 'global $var;'
1386             }
1387 10 50       26 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 3313 my ($var) = @_;
1397 1856         4560 my ($inst, $instvar) = inst_split($var);
1398 1856 100       3973 if (defined $inst) {
1399 46         194 return ($inst =~ /^#inst\d+$/);
1400             }
1401 1810         4870 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 2425 my ($ctx, $var, $val, $in_block) = @_;
1415 1160         1660 my $wasset = 0;
1416              
1417             # set class vars when classes are initialized
1418             #
1419 1160 100 100     3851 if (!$ctx->{infunction} && $ctx->{class_scope}) {
1420 9         30 my ($inst, $instvar) = inst_split($var);
1421 9 50 33     30 if (!defined $inst || ($inst ne 'GLOBALS')) {
1422 9         43 $var = inst_var($ctx->{class_scope}, $var);
1423             }
1424             }
1425 1160         3019 my ($global) = global_split($var);
1426 1160         2684 my ($inst, $instvar) = inst_split($var);
1427 1160 100       2621 $inst = lc($inst) if defined $inst;
1428              
1429 1160 100       2655 if ($ctx->is_superglobal($var)) {
1430 14         27 $global = $var;
1431             }
1432 1160 100 66     6865 if (defined $global) {
    100          
    100          
    100          
    100          
1433 34 50       93 if (exists $ctx->{globals}) {
1434 34         88 $ctx->{globals}{$global} = $val;
1435 34         57 $wasset = 1;
1436             }
1437             } elsif (exists $ctx->{varmap}{global}{$var}) {
1438 10 50       33 if (exists $ctx->{globals}) {
1439 10         23 $ctx->{globals}{$var} = $val;
1440 10         31 $var = global_var($var);
1441 10         19 $wasset = 1;
1442             }
1443             } elsif (exists $ctx->{varmap}{ref}{$var}) {
1444 6         14 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  6         18  
1445 6         21 $ctx2->setvar($var1, $val, $in_block);
1446             } elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) {
1447 4 100 66     28 if ($ctx->{infunction} && $ctx->{incall}) {
1448 3         9 $ctx->{varmap}{static}{$ctx->{infunction}}{$var} = $val;
1449 3         4 $wasset = 1;
1450             } else {
1451 1         5 $ctx->{warn}->($ctx, 'setvar', $var, "static not in call");
1452             }
1453             } elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) {
1454 27         80 $ctx->{varmap}{inst}{$inst}{$instvar} = $val;
1455 27         42 $wasset = 1;
1456             } else {
1457 1079         2978 $ctx->{varmap}{$var} = $val;
1458 1079         1689 $wasset = 1;
1459             }
1460 1160 100       2238 if ($wasset) {
1461 1153 100       2078 if (!$in_block) {
1462 192 50       511 $ctx->{log}->($ctx, 'setvar', $var, "= $val [TRACK]") if $ctx->{log};
1463 192         589 $ctx->track_assignment($var, $val);
1464             } else {
1465 961 50       1873 $ctx->{log}->($ctx, 'setvar', $var, "= $val") if $ctx->{log};
1466             }
1467             }
1468 1160         2658 return;
1469             }
1470              
1471             sub add_namespace {
1472 896     896 0 1817 my ($ctx, $name) = @_;
1473              
1474 896 100       2808 if ($name =~ /^\\(.*)$/) {
    100          
1475 3         11 $name = $1; # remove absolute
1476             } elsif ($ctx->{namespace}) {
1477 7         33 $name = ns_name(lc($ctx->{namespace}), $name); # relative
1478             }
1479 896         2115 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 663 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       646 if (exists $ctx->{class_scope}) {
1493 62         258 $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       673 if ($ctx->{namespace}) {
1498 6         18 $name = ns_name(lc($ctx->{namespace}), $name);
1499             }
1500 296 100       619 if ($ctx->{infunction}) {
1501 9         26 $ctx->{varmap}{fun}{$name} = $f;
1502             } else {
1503 287         828 $ctx->{globals}{fun}{$name} = $f;
1504             }
1505 296 50       700 $ctx->{log}->($ctx, 'registerfun', $name, "$f") if $ctx->{log};
1506 296         823 return;
1507             }
1508              
1509             # lookup method name by instance name
1510             #
1511             sub lookup_method_name {
1512 1217     1217 0 2047 my ($ctx, $name) = @_;
1513              
1514 1217         1875 $name = lc($name); # functions are not case-sensitive
1515              
1516 1217         2980 my ($inst, $prop) = method_split($name);
1517              
1518 1217 100       2584 if (defined $inst) {
1519 196 100 100     831 if (exists $ctx->{varmap}{inst}{$inst} && exists $ctx->{varmap}{inst}{$inst}{$prop}) {
1520 60         124 my $method = $ctx->{varmap}{inst}{$inst}{$prop}; # lookup instance function
1521 60         155 return $method;
1522             }
1523             }
1524 1157         3253 return;
1525             }
1526              
1527             sub getfun {
1528 1157     1157 1 2130 my ($ctx, $name) = @_;
1529              
1530 1157         2064 $name = lc($name); # functions are not case-sensitive
1531              
1532 1157 100       2227 if (my $method = $ctx->lookup_method_name($name)) {
    100          
1533 30         51 $name = $method;
1534             } elsif (exists $ctx->{class_scope}) {
1535 59         160 my $method = lc(method_name($ctx->{class_scope}, $name));
1536 59 100       233 if (exists $ctx->{globals}{fun}{$method}) {
    50          
1537 31         351 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       3405 if (exists $ctx->{globals}{fun}{$name}) {
    100          
1543 341         1654 return $ctx->{globals}{fun}{$name};
1544             } elsif (exists $ctx->{varmap}{fun}{$name}) {
1545 4         26 return $ctx->{varmap}{fun}{$name};
1546             }
1547 781         1526 return;
1548             }
1549              
1550             sub registerclass {
1551 68     68 1 135 my ($ctx, $name, $c) = @_;
1552              
1553 68         130 $name = lc($name);
1554              
1555 68 100       176 if ($ctx->{namespace}) {
1556 1         6 $name = ns_name(lc($ctx->{namespace}), $name);
1557             }
1558 68 100       150 if ($ctx->{infunction}) {
1559 2         9 $ctx->{varmap}{class}{$name} = $c;
1560             } else {
1561 66         162 $ctx->{globals}{class}{$name} = $c;
1562             }
1563 68 50       147 $ctx->{log}->($ctx, 'registerclass', $name, "$c") if $ctx->{log};
1564 68         140 return;
1565             }
1566              
1567             sub getclass {
1568 136     136 1 286 my ($ctx, $name) = @_;
1569              
1570 136         253 $name = lc($name);
1571              
1572 136 100       345 if (exists $ctx->{globals}{class}{$name}) {
    100          
1573 126         402 return $ctx->{globals}{class}{$name};
1574             } elsif (exists $ctx->{varmap}{class}{$name}) {
1575 1         5 return $ctx->{varmap}{class}{$name};
1576             }
1577 9         21 return;
1578             }
1579              
1580             sub getvar {
1581 2031     2031 1 3941 my ($ctx, $var, $quiet) = @_;
1582              
1583             # variable names are case sensitive
1584             #
1585 2031         4614 my ($global) = global_split($var);
1586 2031         4575 my ($inst, $instvar) = inst_split($var);
1587 2031 100       4270 $inst = lc($inst) if defined $inst;
1588              
1589 2031 100       4194 if ($ctx->is_superglobal($var)) {
1590 273         513 $global = $var;
1591             }
1592 2031 100 66     11274 if (defined $global) {
    100          
    100          
    100          
    100          
    100          
1593 331 50       761 if (exists $ctx->{globals}) {
1594 331 100       775 if (exists $ctx->{globals}{$global}) {
1595 43         111 my $val = $ctx->{globals}{$global};
1596 43         116 return $val;
1597             }
1598 288 100       551 if (!$ctx->is_superglobal($var)) {
1599 31 50 66     188 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1600 31 100       80 unless ($ctx->{tainted}) {
1601 5 50       25 $ctx->{warn}->($ctx, 'getvar', $var, "global not found -> #null") unless $quiet;
1602 5         328 return '#null';
1603             }
1604             }
1605             }
1606 283 100       1153 $ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet;
1607             }
1608             } elsif (exists $ctx->{varmap}{global}{$var}) {
1609 14 50       42 if (exists $ctx->{globals}) {
1610 14 100       39 if (exists $ctx->{globals}{$var}) {
1611 9         37 my $val = $ctx->{globals}{$var};
1612 9         23 return $val;
1613             }
1614 5 50       27 $ctx->{warn}->($ctx, 'getvar', $var, "global not found") unless $quiet;
1615             }
1616             } elsif (exists $ctx->{varmap}{ref}{$var}) {
1617 3         6 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  3         12  
1618 3         13 return $ctx2->getvar($var1, $quiet);
1619             } elsif (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$var}) {
1620 13 100 66     56 if ($ctx->{infunction} && $ctx->{incall}) {
1621 9         20 my $val = $ctx->{varmap}{static}{$ctx->{infunction}}{$var};
1622 9 100       21 if (!defined $val) {
1623 1         4 return '#null';
1624             }
1625 8         17 return $val;
1626             }
1627 4 50       18 $ctx->{warn}->($ctx, 'getvar', $var, "static not in call") unless $quiet;
1628             } elsif (defined $inst && exists $ctx->{varmap}{inst}{$inst}) {
1629 45 100 33     140 if (exists $ctx->{varmap}{inst}{$inst}{$instvar}) {
    50          
1630 40         77 my $val = $ctx->{varmap}{inst}{$inst}{$instvar};
1631 40 100       86 if (!defined $val) {
1632 5         11 return '#null';
1633             }
1634 35         89 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     29 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1644 5 100       16 if (!$ctx->{tainted}) {
1645 3 50       32 $ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found -> #null") unless $quiet;
1646 3         154 return '#null';
1647             }
1648             }
1649 2 50       17 $ctx->{warn}->($ctx, 'getvar', $var, "instvar $instvar not found") unless $quiet;
1650             } elsif (exists $ctx->{varmap}{$var}) {
1651 1388         2634 my $val = $ctx->{varmap}{$var};
1652 1388         3079 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 237 50 66     1113 if ($ctx->{incall} || !(exists $ctx->{skip}{null})) {
1662 237 100       590 if (!$ctx->{tainted}) {
1663 149 100       738 $ctx->{warn}->($ctx, 'getvar', $var, "not found -> #null") unless $quiet;
1664 149         15457 return '#null';
1665             }
1666             }
1667 88 100       330 $ctx->{warn}->($ctx, 'getvar', $var, "not found") unless $quiet;
1668             }
1669 382         32563 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 623 my ($ctx, $info, $code) = @_;
1676 207         464 my $parser = $ctx->{parser};
1677              
1678 207 100       796 $info->{remaining_locals} = {} unless exists $info->{remaining_locals};
1679 207 100       662 $info->{remaining_statics} = {} unless exists $info->{remaining_statics};
1680              
1681             my $out = $parser->map_stmt($code, sub {
1682 845     845   1332 my ($s) = @_;
1683              
1684 845 100       3193 if ($s =~ /^#expr\d+$/) {
    100          
    100          
    100          
1685             # $var =
1686 111         185 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  111         359  
1687 111 100 100     514 if (($op eq '=') && is_variable($v1)) {
    100 100        
1688 97         237 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     283 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       10 $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       16 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: convert global var $v1=$v2 -> $vv1=$vv2") if $ctx->{log};
1702 4         13 $info->{global_assigns}{$v1} = 1;
1703 4         16 my $k = $parser->setexpr('=', $vv1, $vv2);
1704 4         33 return $k;
1705             } elsif (defined $inst && ($inst eq 'GLOBALS')) {
1706 6 50       17 $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       11 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static func var $v1") if $ctx->{log};
1709 3         10 $info->{remaining_statics}{$v1} = 1;
1710             } elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) {
1711 12 50       32 $ctx->{log}->($ctx, 'eliminate', $code, "assignment: keep static class var $v1") if $ctx->{log};
1712 12         30 $info->{remaining_statics}{$v1} = 1;
1713 12         31 delete $info->{local_assigns}{$v1};
1714             } elsif (exists $info->{local_assigns}{$v1}) {
1715 69 100 66     271 if (exists $info->{noassigns}{$v1}) {
    100          
    100          
    100          
1716 3 50       11 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: remaining local var $v1") if $ctx->{log};
1717 3         41 $info->{remaining_locals}{$v1} = 1;
1718             } elsif (is_strval($v2)) {
1719 13 50       47 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log};
1720 13         48 my $empty = $parser->setblk('flat', []);
1721 13         54 return $empty;
1722             } elsif (is_array($v2) && PHP::Decode::Op::array_is_const($parser, $v2)) {
1723 50 50       128 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local var $v1=$v2 -> []") if $ctx->{log};
1724 50         148 my $empty = $parser->setblk('flat', []);
1725 50         154 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         10 my $empty = $parser->setblk('flat', []);
1729 2         8 return $empty;
1730             } else {
1731 1         6 my $vv2 = $ctx->eliminate_local_assigments($info, $v2);
1732 1 50       5 $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         9  
1742 3 50       14 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       8 $ctx->{log}->($ctx, 'eliminate', $code, "assignment $s: local elem $v1=$v2 -> []") if $ctx->{log};
1751 2         9 my $empty = $parser->setblk('flat', []);
1752 2         8 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         10 my ($o, $m) = @{$parser->{strmap}->{$s}};
  4         28  
1760 4 50       16 if (lc($o) eq '$this') {
1761 4         10 $info->{remaining_statics}{$s} = 1; # XXX
1762             } else {
1763 0         0 $info->{remaining_locals}{$s} = 1;
1764             }
1765 4 50       24 $ctx->{log}->($ctx, 'eliminate', $code, "keep obj $s") if $ctx->{log};
1766             } elsif ($s =~ /^#stmt\d+$/) {
1767 180         439 my $cmd = $parser->{strmap}->{$s}->[0];
1768 180 100       700 if ($cmd eq 'static') {
    100          
1769 4         12 my $arglist = $parser->{strmap}->{$s}->[1];
1770 4         8 foreach my $v (@$arglist) {
1771 4 100       10 if ($v =~ /^#expr\d+$/) {
1772 2 50       8 $ctx->{log}->($ctx, 'eliminate', $code, "$v from static assignment $s") if $ctx->{log};
1773             } else {
1774 2 50       6 $ctx->{log}->($ctx, 'eliminate', $code, "$v from static definition $s") if $ctx->{log};
1775             }
1776             }
1777 4         17 my $empty = $parser->setblk('flat', []);
1778 4         10 return $empty;
1779             } elsif ($cmd eq 'global') {
1780 4         11 my $arglist = $parser->{strmap}->{$s}->[1];
1781 4         11 return $s; # keep variables in global statement as is
1782             }
1783             } elsif (is_variable($s)) {
1784 57         149 my ($inst, $instvar) = inst_split($s);
1785              
1786 57 100 100     146 if ($ctx->is_superglobal($s)) {
    100 33        
    50 66        
    100 33        
    100          
    100          
    100          
1787 10 50       33 $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         7 $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       29 $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       11 $ctx->{log}->($ctx, 'eliminate', $code, "is static func var $s") if $ctx->{log};
1799 3         5 $info->{remaining_statics}{$s} = 1;
1800             } elsif (defined $inst && exists $ctx->{class_scope} && (lc($inst) eq $ctx->{class_scope})) {
1801 16 50       54 $ctx->{log}->($ctx, 'eliminate', $code, "keep static class var $s") if $ctx->{log};
1802 16         34 $info->{remaining_statics}{$s} = 1;
1803             } elsif (exists $info->{vars}{$s}) {
1804 12 50       29 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       42 $ctx->{log}->($ctx, 'eliminate', $code, "remaining local var $s") if $ctx->{log};
1809 12         24 $info->{remaining_locals}{$s} = 1;
1810             }
1811             } else {
1812 4 50       26 $ctx->{log}->($ctx, 'eliminate', $code, "remaining unknown var $s") if $ctx->{log};
1813 4         67 $info->{remaining_locals}{$s} = 1;
1814             }
1815             }
1816 765         1573 return;
1817 207         4479 });
1818              
1819 207 100       7811 if ($out ne $code) {
1820 72 50       188 $ctx->{log}->($ctx, 'eliminate', $code, "changed -> $out") if $ctx->{log};
1821             }
1822 207         530 return $out;
1823             }
1824              
1825             # convert assignment followed directly by return to single return
1826             #
1827             sub convert_assign_return {
1828 512     512 0 927 my ($ctx, $code) = @_;
1829 512         824 my $parser = $ctx->{parser};
1830              
1831             my $out = $parser->map_stmt($code, sub {
1832 1818     1818   3054 my ($s) = @_;
1833              
1834 1818 100       3919 if ($s =~ /^#blk\d+$/) {
1835 212         399 my ($type, $a) = @{$parser->{strmap}->{$s}};
  212         635  
1836 212         369 my @args = ();
1837 212         363 my $arg_changed = 0;
1838              
1839 212         567 for (my $i=0; $i < scalar @$a; $i++) {
1840 311         554 my $k = $a->[$i];
1841 311 100       665 if (($i+1) < scalar @$a) {
1842 102         183 my $k2 = $a->[$i+1];
1843 102         185 my $var;
1844 102 100       337 if ($k2 =~ /^#stmt\d+$/) {
1845 82         225 my $cmd2 = $parser->{strmap}->{$k2}->[0];
1846 82 100       207 if ($cmd2 eq 'return') {
1847 74         159 $var = $parser->{strmap}->{$k2}->[1];
1848             }
1849             }
1850 102 100 100     437 if (defined $var && ($k =~ /^#expr\d+$/)) {
1851 67         123 my ($op, $v1, $v2) = @{$parser->{strmap}->{$k}};
  67         201  
1852 67 100 66     308 if (($op eq '=') && ($var eq $v1)) {
1853 2         12 my $r = $parser->setstmt(['return', $v2]);
1854 2 50       12 $ctx->{log}->($ctx, 'convert', $code, "assign_return $k+$k2 -> $r") if $ctx->{log};
1855 2         4 push(@args, $r);
1856 2         5 $arg_changed = 1;
1857 2         4 $i++;
1858 2         7 next;
1859             }
1860             }
1861             }
1862 309         693 my $v = $ctx->convert_assign_return($k);
1863 309 50       562 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         932 push(@args, $v);
1870             }
1871             }
1872 212 100       558 if ($arg_changed) {
1873 2         6 $s = $parser->setblk($type, \@args);
1874 2         9 return $s;
1875             }
1876             }
1877 1816         3427 return;
1878 512         4092 });
1879              
1880 512 100       4965 if ($out ne $code) {
1881 2 50       7 $ctx->{log}->($ctx, 'convert', $code, "assign_return changed -> $out") if $ctx->{log};
1882             }
1883 512         1045 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 647 my ($ctx, $info, $code, $cctx) = @_;
1890 297         494 my $parser = $ctx->{parser};
1891              
1892 297 100       440 unless (scalar keys %{$info->{global_assigns}} > 0) {
  297         902  
1893 286         727 return $code; # no global exists
1894             }
1895              
1896             my $out = $parser->map_stmt($code, sub {
1897 68     68   100 my ($s) = @_;
1898              
1899 68 100       178 if ($s =~ /^#stmt\d+$/) {
    100          
1900 4         28 my $cmd = $parser->{strmap}->{$s}->[0];
1901 4 50       22 if ($cmd eq 'global') {
1902 4         8 my $arglist = $parser->{strmap}->{$s}->[1];
1903 4 50       14 $ctx->{log}->($ctx, 'convert', $code, "global $s -> drop global stmt") if $ctx->{log};
1904 4         22 my $empty = $parser->setblk('flat', []);
1905 4         12 return $empty;
1906             }
1907             } elsif (is_variable($s)) {
1908 16         72 my $g = $ctx->is_global_var($s);
1909 16         42 my ($inst, $instvar) = inst_split($s);
1910              
1911 16 50 66     96 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       35 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         32 return $g;
1924             }
1925             }
1926             }
1927 54         120 return;
1928 11         89 });
1929              
1930 11 100       124 if ($out ne $code) {
1931 10 50       37 $ctx->{log}->($ctx, 'convert', $code, "global changed -> $out") if $ctx->{log};
1932             }
1933 11         29 return $out;
1934             }
1935              
1936             # convert global vars to explicit globals
1937             #
1938             sub globlify_local_vars {
1939 4     4 0 18 my ($ctx, $info, $code) = @_;
1940 4         12 my $parser = $ctx->{parser};
1941              
1942             my $out = $parser->map_stmt($code, sub {
1943 16     16   26 my ($s) = @_;
1944              
1945 16 100       38 if (is_variable($s)) {
1946 5         17 my ($inst, $instvar) = inst_split($s);
1947              
1948 5 50 0     17 if ($ctx->is_superglobal($s)) {
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
1949 5 50       17 $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         31 return;
1967 4         42 });
1968              
1969 4 50       68 if ($out ne $code) {
1970 0 0       0 $ctx->{log}->($ctx, 'globlify', $code, "changed -> $out") if $ctx->{log};
1971             }
1972 4         12 return $out;
1973             }
1974              
1975             sub _remove_final_statement {
1976 127     127   268 my ($parser, $pattern, $code) = @_;
1977 127         251 my @seq = ();
1978 127         182 my @out = ();
1979 127         212 my $changed = 0;
1980              
1981 127         431 $parser->flatten_block($code, \@seq);
1982              
1983 127         381 foreach my $s (@seq) {
1984 142 100       482 if ($s =~ /^#stmt\d+$/) {
1985 129         291 my $cmd = $parser->{strmap}->{$s}->[0];
1986 129 100       839 if ($cmd =~ /^$pattern$/) {
1987 127         253 $changed = 1;
1988 127         295 next;
1989             }
1990             }
1991 15         45 push(@out, $s);
1992             }
1993 127 50       317 if ($changed) {
1994 127         380 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 501 my ($ctx, $code) = @_;
2004 249         488 my $parser = $ctx->{parser};
2005 249         348 my $allow = 1;
2006              
2007             my $out = $parser->map_stmt($code, sub {
2008 317     317   547 my ($s) = @_;
2009 317 100       717 return $s unless $allow;
2010              
2011 313 100       1665 if ($s =~ /^#stmt\d+$/) {
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    50          
2012 38         103 my $cmd = $parser->{strmap}->{$s}->[0];
2013 38 100       130 if ($cmd eq 'echo') {
    50          
    100          
    50          
2014 33         87 my $arglist = $parser->{strmap}->{$s}->[1];
2015 33         68 foreach my $a (@$arglist) {
2016 33 50       88 unless ($ctx->can_inline($a)) {
2017 0         0 $allow = 0;
2018 0         0 last;
2019             }
2020             }
2021 33         93 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         11 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         3 return; # check other statements
2034             }
2035             } elsif ($s =~ /^#blk\d+$/) {
2036 165         404 return; # check block elements
2037             } elsif ($s =~ /^#expr\d+$/) {
2038 14         22 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  14         44  
2039              
2040 14 50       50 if ($op ne '$') { # keep varvar
2041 14 50       37 if (defined $v1) {
2042 14 100       36 unless ($ctx->can_inline($v1)) {
2043 1         2 $allow = 0;
2044             }
2045             }
2046 14 100 66     67 if ($allow && defined $v2) {
2047 13 50       29 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         12 my ($v, $i) = @{$parser->{strmap}->{$s}};
  6         16  
2055              
2056 6 50       15 unless ($ctx->can_inline($v)) {
2057 0         0 $allow = 0;
2058             }
2059 6 50 33     27 if ($allow && defined $i) {
2060 6 50       14 unless ($ctx->can_inline($i)) {
2061 0         0 $allow = 0;
2062             }
2063             }
2064 6         17 return $s;
2065             } elsif ($s =~ /^#call\d+$/) {
2066 13         31 my ($name, $arglist) = @{$parser->{strmap}->{$s}};
  13         41  
2067 13         48 my ($inst, $prop) = method_split($name);
2068 13 0 66     76 if (defined $inst || is_symbol($name) || is_strval($name) || ($name =~ /^#fun\d+$/)) {
      33        
      33        
2069 13 50       48 unless ($name =~ /^(eval|create_function)$/i) {
2070 13         26 my $can = 1;
2071 13         27 my $arglist = $parser->{strmap}->{$s}->[1];
2072 13         46 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       52 if ($can) {
2079 13 50       37 $ctx->{log}->($ctx, 'inline', $code, "$s [$name] is allowed func") if $ctx->{log};
2080 13         38 return $s;
2081             }
2082             }
2083             }
2084             } elsif ($s =~ /^#fun\d+$/) {
2085 5         13 return $s;
2086             } elsif ($s =~ /^#class\d+$/) {
2087 0         0 return $s;
2088             } elsif (is_strval($s)) {
2089 53 50       162 $ctx->{log}->($ctx, 'inline', $code, "$s is strval") if $ctx->{log};
2090 53         136 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         46 my ($inst, $instvar) = inst_split($s);
2098              
2099 19 100 66     73 if ($ctx->is_superglobal($s)) {
    50 66        
    100          
2100 7 50       28 $ctx->{log}->($ctx, 'inline', $code, "$s is superglobal") if $ctx->{log};
2101 7         20 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       27 $ctx->{log}->($ctx, 'inline', $code, "$s is classvar") if $ctx->{log};
2107 10         31 return $s;
2108             }
2109             }
2110 2         18 $ctx->{warn}->($ctx, 'inline', $code, "disallow stmt $s");
2111 2         94 $allow = 0;
2112 2         7 return;
2113 249         1790 });
2114 249         4601 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 97 my ($ctx, $code) = @_;
2122 45         87 my $parser = $ctx->{parser};
2123 45         68 my $allow = 1;
2124              
2125             my $out = $parser->map_stmt($code, sub {
2126 52     52   102 my ($s) = @_;
2127 52 50       119 return $s unless $allow;
2128              
2129 52 100       305 if ($s =~ /^#stmt\d+$/) {
    100          
    100          
    50          
    100          
    50          
    50          
2130 11         60 my $cmd = $parser->{strmap}->{$s}->[0];
2131 11 100       43 if ($cmd eq 'echo') {
    50          
    50          
    50          
2132 9         31 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         16 return $s;
2140             }
2141             } elsif ($s =~ /^#blk\d+$/) {
2142 11         33 return; # check block elements
2143             } elsif ($s =~ /^#expr\d+$/) {
2144             # $var =
2145 5         8 my ($op, $v1, $v2) = @{$parser->{strmap}->{$s}};
  5         17  
2146 5 50       16 if ($op eq '=') {
2147 5 50       14 if (is_strval($v2)) {
2148 5         17 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         14 return $s;
2159             } elsif ($s =~ /^#class\d+$/) {
2160 0         0 return $s;
2161             } elsif (is_strval($s)) {
2162 19         48 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         491 return $allow;
2169             }
2170              
2171             # check if function body might return
2172             #
2173             sub _can_return {
2174 203     203   399 my ($info) = @_;
2175              
2176 203 50 66     868 if (exists $info->{returns} || exists $info->{calls}{'eval'} || exists $info->{calls}{'create_function'}) {
      33        
2177 130         409 return 1;
2178             }
2179 73         248 return 0;
2180             }
2181              
2182             sub _find_unresolved_param {
2183 182     182   405 my ($info, $param) = @_;
2184 182         326 my $param_found = 0;
2185              
2186 182         523 for (my $i=0; $i < scalar @$param; $i++) {
2187 122 100       327 if ($param->[$i] =~ /^#ref\d+$/) {
2188 3         6 $param_found = $param->[$i];
2189             }
2190 122 50       445 if (exists $info->{vars}{$param->[$i]}) {
2191 0         0 $param_found = $param->[$i];
2192             }
2193             }
2194 182         446 return $param_found;
2195             }
2196              
2197             sub set_func_params {
2198 205     205 0 404 my ($ctx, $cmd, $arglist, $param) = @_;
2199 205         360 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         304 my %varmap;
2207 205         599 for (my $i=0; $i < scalar @$param; $i++) {
2208 129         225 my $var;
2209             my $val;
2210              
2211 129 100       298 if ($i < scalar @$arglist) {
2212 127         228 $val = $arglist->[$i];
2213             }
2214 129 100       438 if ($param->[$i] =~ /^#expr\d+$/) {
    100          
2215 1         4 my ($op, $v1, $v2) = @{$parser->{strmap}->{$param->[$i]}};
  1         6  
2216 1 50       6 if ($op ne '=') {
2217 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "bad default param (skip): $param->[$i]");
2218 0         0 return;
2219             }
2220 1         3 $var = $v1;
2221              
2222 1 50       5 if (!defined $val) {
2223 1         3 $val = $v2; # set default for optional param
2224             }
2225             } elsif ($param->[$i] =~ /^#ref\d+$/) {
2226 3         15 $var = $parser->{strmap}->{$param->[$i]}->[0];
2227 3 50       10 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         15 $varmap{ref}{$var} = [$ctx, $val];
2232 3 50       23 $ctx->{log}->($ctx, 'func', $cmd, "$var references $val now") if $ctx->{log};
2233              
2234 3         12 $val = $ctx->exec_statement($val, 1); # don't remove assignments like ($x = #unresolved)
2235             }
2236             } else {
2237 125 100       324 if (!defined $val) {
2238 1         9 $ctx->{warn}->($ctx, 'func', $cmd, "no default param (skip): $param->[$i] (too few params %d want %d)", scalar @$arglist, scalar @$param);
2239 1         54 return;
2240             }
2241 124         198 $var = $param->[$i];
2242             }
2243 128 50       300 if (is_variable($var)) {
2244 128         537 my $info = {vars => {}, calls => {}, stmts => {}};
2245 128         516 $parser->stmt_info($val, $info);
2246              
2247 128 50       341 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     339 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         22 } 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         9 $ctx->{warn}->($ctx, 'func', $cmd, "unresolved varvar param (skip): $param->[$i] = $val");
2259 1         47 return;
2260 127         342 } elsif (scalar keys %{$info->{vars}} > 0) {
2261 4         15 $val = $ctx->globlify_local_vars($info, $val);
2262 4         11 $varmap{$var} = $val;
2263 4 50       26 $ctx->{log}->($ctx, 'func', $cmd, "globlified param: $var = $val") if $ctx->{log};
2264             } else {
2265 123         322 $varmap{$var} = $val;
2266 123 50       673 $ctx->{log}->($ctx, 'func', $cmd, "param: $var = $val") if $ctx->{log};
2267             }
2268             }
2269             }
2270 203         486 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   428 my ($ctx, $cmd, $arglist, $param, $block) = @_;
2301 205         365 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         574 my $varmap = $ctx->set_func_params($cmd, $arglist, $param);
2307 205 100       525 if (!defined $varmap) {
2308 2         6 return;
2309             }
2310 203 50       501 $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         322 my $out;
2315 203         683 my $ctx2 = $ctx->subscope_ctx(varmap => $varmap, infunction => lc($cmd), incall => 1);
2316 203         561 $ctx2->{varhist} = {};
2317              
2318 203         316 my $is_construct;
2319 203         785 my ($inst, $prop) = method_split(lc($cmd));
2320 203 100       532 if (defined $inst) {
2321 54         174 my $method = $ctx->lookup_method_name(lc($cmd)); # lookup instance function
2322 54 100       134 if (defined $method) {
2323 24         47 $cmd = $method;
2324 24         58 $ctx2->{varmap}{'$this'} = $inst; # init $this var for instance
2325 24 100       123 if ($prop eq '__construct') {
    100          
2326 4         12 $is_construct = 1;
2327             } elsif (lc($cmd) eq method_name($prop, $prop)) {
2328 2         7 $is_construct = 1;
2329             }
2330             } else {
2331 30         67 $ctx2->{class_scope} = $inst; # is class call
2332             }
2333             }
2334 203 100       593 $ctx2->{infunction} = ($cmd =~ /^#fun\d+$/) ? '{closure}' : lc($cmd);
2335              
2336 203         572 my $res = $ctx2->exec_statement($block);
2337 203 50       584 if (defined $res) {
2338 203         573 $res = $ctx2->convert_assign_return($res);
2339 203 50       531 $ctx->{log}->($ctx, 'func', $cmd, "res: $res '%s'", $parser->format_stmt($res)) if $ctx->{log};
2340 203 100       613 if (is_block($res)) {
2341 200         350 my ($type, $a) = @{$parser->{strmap}->{$res}};
  200         631  
2342 200         478 $out = $a;
2343             } else {
2344 3         10 $out = [$res];
2345             }
2346             }
2347 203 50       546 if (defined $out) {
2348 203         283 my $unresolved_param;
2349 203         320 my $keep_call = 0;
2350 203         572 my $resinfo = $ctx->get_unresolved_info($cmd, $res);
2351              
2352 203 100       585 if (scalar @$out > 0) {
2353 202         434 my $r = _final_break($parser, $res, '(return)');
2354 202         600 my $f = _skipped_call($parser, $res, '(.*)', $resinfo);
2355 202         535 my $u = $ctx2->unresolvable_var($resinfo); # allow to return superglobal result
2356              
2357 202 100       420 $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       591  
  202         805  
  202         1012  
2358              
2359 202         11257 my $res1 = $ctx2->eliminate_local_assigments($resinfo, $res);
2360 202 100 100     326 if ((scalar keys %{$resinfo->{remaining_locals}} == 0) && (scalar keys %{$resinfo->{remaining_statics}} == 0)) {
  202 100       934  
  191         702  
2361 174 100       425 if ($res ne $res1) {
2362 68         125 $res = $res1;
2363             }
2364 174         497 $resinfo = $ctx->get_unresolved_info($cmd, $res);
2365 174         570 $unresolved_param = _find_unresolved_param($resinfo, $param);
2366 28         100 } elsif (scalar keys %{$resinfo->{remaining_statics}} > 0) {
2367 21         36 $keep_call = 1;
2368             } else {
2369 7         57 $unresolved_param = _find_unresolved_param($resinfo, $param);
2370             }
2371              
2372 202 100       605 if ($is_construct) {
2373 6 50       33 unless (_anon_func_call($parser, $res)) {
2374 6         22 $res = _to_code_block($parser, $res);
2375             }
2376 6 50       19 $ctx->{log}->($ctx, 'func', $cmd, "return $res for void construct") if $ctx->{log};
2377 6         61 return ('#construct', $res); # return dummy result & show simplified code for construct
2378             }
2379              
2380             # undefined result
2381             #
2382 196 100 100     1217 if (defined $u || defined $f) {
2383 20 100       78 if ($ctx2->{tainted} > $ctx->{tainted}) {
2384 7         35 $ctx->{warn}->($ctx, 'func', $cmd, "not completely executed (and tainted)");
2385 7         323 $ctx->{tainted} = $ctx2->{tainted};
2386             }
2387             }
2388              
2389 196 100       518 if (_can_return($resinfo)) {
2390 130 50       354 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         293 my $arg = $parser->{strmap}->{$r}->[1];
2400 130         472 my $arginfo = {vars => {}, calls => {}, stmts => {}};
2401 130         476 $parser->stmt_info($arg, $arginfo);
2402              
2403 130 100       430 if ($ctx2->contains_local_var($arginfo)) {
2404 4 100 66     26 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         29 return (undef, $res);
2407             }
2408 2 50 33     15 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       8 $ctx->{log}->($ctx, 'func', $cmd, "return $arg is local var -> inline anon func") if $ctx->{log};
2413 2         11 $res = _to_anon_func_call($parser, $res);
2414 2         31 return ('#notaint', $res);
2415             }
2416 126         353 $arg = $ctx2->convert_globals_to_caller_ctx($resinfo, $arg, $ctx);
2417              
2418 126         359 my $res1 = _remove_final_statement($parser, '(return)', $res);
2419              
2420 126 100 66     624 if ($keep_call || $unresolved_param) {
2421 7         22 $resinfo = $ctx->get_unresolved_info($cmd, $res1);
2422 7 50       22 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       22 $ctx->{log}->($ctx, 'func', $cmd, "has return $arg & unresolved locals -> keep call") if $ctx->{log};
2427 7         87 return ($arg, undef);
2428             }
2429             }
2430 119 50       326 if ($ctx2->can_inline($res1)) {
2431 119         315 $res1 = $ctx2->convert_globals_to_caller_ctx($resinfo, $res1, $ctx);
2432 119         1356 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         3 $unresolved_param = _find_unresolved_param($resinfo, $param);
2440             }
2441              
2442 67 100       220 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       177 $ctx->{log}->($ctx, 'func', $cmd, "has no return - return #null") if $ctx->{log};
2447              
2448 66 100 100     244 if ($keep_call || $unresolved_param) {
2449 12         138 return ('#noreturn', undef);
2450             }
2451 54 100       175 if ($ctx2->can_inline($res)) {
2452 52         150 $res = $ctx2->convert_globals_to_caller_ctx($resinfo, $res, $ctx);
2453 52         530 return ('#noreturn', $res);
2454             }
2455 2         12 $res = _to_anon_func_call($parser, $res);
2456 2         29 return ('#noreturn', $res);
2457             }
2458             }
2459 1         7 return;
2460             }
2461              
2462             sub exec_func {
2463 205     205 0 532 my ($ctx, $cmd, $arglist, $param, $block) = @_;
2464 205         379 my $parser = $ctx->{parser};
2465 205         354 my $ret;
2466             my $code;
2467              
2468 205 100       589 if (exists $parser->{strmap}{_CALL}{$cmd}) {
2469 51         140 $parser->{strmap}{_CALL}{$cmd} += 1;
2470             } else {
2471 154         447 $parser->{strmap}{_CALL}{$cmd} = 1;
2472             }
2473 205         422 my $level = $parser->{strmap}{_CALL}{$cmd};
2474              
2475 205 50       392 if ($level > 4) {
2476 0         0 $ctx->{warn}->($ctx, 'func', $cmd, "max recursion level ($level) reached");
2477             } else {
2478 205         609 ($ret, $code) = $ctx->_exec_func($cmd, $arglist, $param, $block);
2479             }
2480 205         650 $parser->{strmap}{_CALL}{$cmd} -= 1;
2481              
2482 205 100       525 if (defined $ret) {
2483 200         633 return ($ret, $code);
2484             }
2485 5         22 return;
2486             }
2487              
2488             # get elem list for multidimensional array (base elem first)
2489             #
2490             sub _get_elemlist {
2491 167     167   367 my ($parser, $var) = @_;
2492 167         283 my @list = ();
2493              
2494 167         597 while ($var =~ /^#elem\d+$/) {
2495 195         320 my ($v, $i) = @{$parser->{strmap}->{$var}};
  195         480  
2496              
2497 195         498 unshift(@list, $var);
2498 195         543 $var = $v;
2499             }
2500 167         373 return \@list;
2501             }
2502              
2503             # convert elem list to point to new base var
2504             #
2505             sub _update_elemlist {
2506 18     18   57 my ($parser, $var, $elemlist) = @_;
2507 18         45 my @list = ();
2508              
2509 18         50 foreach my $elem (@$elemlist) {
2510 24         44 my ($v, $i) = @{$parser->{strmap}->{$elem}};
  24         78  
2511 24         77 my $next = $parser->setelem($var, $i);
2512 24         78 push(@list, $next);
2513 24         72 $var = $next;
2514             }
2515 18         74 return \@list;
2516             }
2517              
2518             sub resolve_varvar {
2519 55     55 0 130 my ($ctx, $var, $in_block) = @_;
2520 55         96 my $parser = $ctx->{parser};
2521              
2522             # https://www.php.net/manual/en/language.variables.variable.php
2523             #
2524 55 50       177 if ($var =~ /^#expr\d+$/) {
2525 55         98 my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}};
  55         147  
2526              
2527 55 50 66     271 if (($op eq '$') && !defined $v1 && defined $v2) {
      66        
2528 42         110 my $op2 = $ctx->exec_statement($v2, $in_block);
2529 42         150 my $val = $parser->varvar_to_var($op2);
2530 42 100       460 if (defined $val) {
2531 37         97 return $val;
2532             }
2533 5 100       18 if ($v2 ne $op2) {
2534             # simplify expr
2535 2         10 $val = $parser->setexpr($op, undef, $op2);
2536 2         9 return $val;
2537             }
2538             }
2539             }
2540 16         37 return $var;
2541             }
2542              
2543             sub resolve_obj {
2544 65     65 0 145 my ($ctx, $var, $in_block) = @_;
2545 65         107 my $parser = $ctx->{parser};
2546              
2547 65 50       219 if ($var =~ /^#obj\d+$/) {
2548 65         110 my ($o, $m) = @{$parser->{strmap}->{$var}};
  65         162  
2549              
2550 65 50       171 if ($o =~ /^#inst\d+$/) {
2551 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "obj already instanciated $o");
2552             }
2553 65         173 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($o, $in_block);
2554 65         110 my $basestr;
2555 65 100 100     242 if (defined $basevar && !$has_index) {
    50          
2556 50         132 $basestr = $ctx->exec_statement($basevar, $in_block);
2557 50 100       147 if ($basestr ne $basevar) {
2558 29 0       76 $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       142 if (!defined $basestr) {
2565 15         42 my $inst = $ctx->exec_statement($o);
2566 15 100       57 if ($inst ne $o) {
2567 13 50       35 $ctx->{log}->($ctx, 'resolve', $var, "created $inst") if $ctx->{log};
2568 13         25 $basestr = $inst;
2569             }
2570             }
2571 65 0       146 $ctx->{log}->($ctx, 'resolve', $var, "[$o->$m] -> %s", defined $basestr ? $basestr : '-') if $ctx->{log};
    50          
2572              
2573 65 100 100     321 if (defined $basestr && ($basestr =~ /^#inst\d+$/)) {
2574 40         94 my $inst = $basestr;
2575 40         65 my $sym = $m;
2576              
2577             # $obj->{'a'}() or $obj->{$x}() is allowed
2578             #
2579 40 100 66     92 if (is_block($m) || is_variable($m)) {
2580 1         4 $sym = $ctx->exec_statement($m);
2581             }
2582 40 100 66     115 if (is_strval($sym) && !is_null($sym)) {
2583 1         3 $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         140 return ($inst, $sym);
2587             }
2588             }
2589 25         65 return;
2590             }
2591              
2592             sub resolve_scope {
2593 49     49 0 101 my ($ctx, $var, $in_block) = @_;
2594 49         86 my $parser = $ctx->{parser};
2595              
2596             # https://php.net/manual/en/language.oop5.paamayim-nekudotayim.php
2597             #
2598 49 50       150 if ($var =~ /^#scope\d+$/) {
2599 49         121 my ($c, $e) = @{$parser->{strmap}->{$var}};
  49         115  
2600 49         95 my $class;
2601             my $scopename;
2602              
2603 49 50       97 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         74 my $name = $c;
2608 49 100       116 if (!is_symbol($name)) {
2609 1         4 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         6 $name = $s;
2614             }
2615 1 50       5 $ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $c, $s, $name) if $ctx->{log};
2616             }
2617 49 100       139 if ($name eq 'self') {
    50          
2618 3 50       18 if (exists $ctx->{class_scope}) {
2619 3         9 $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         123 $scopename = $ctx->add_namespace($name);
2631 46         106 $class = $ctx->getclass($scopename);
2632             }
2633             }
2634 49 100       128 if (defined $class) {
2635 46         65 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  46         111  
2636              
2637 46 100       104 $scopename = $n unless defined $scopename;
2638              
2639 46 100       104 if (is_variable($e)) {
2640 22         75 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($e, $in_block);
2641 22 50 33     92 if (defined $basevar && is_variable($basevar)) {
2642 22 50       58 $ctx->{log}->($ctx, 'resolve', $var, "var %s::%s -> %s::%s", $c, $e, $scopename, $basevar) if $ctx->{log};
2643 22         106 return ($scopename, $basevar);
2644             }
2645             } else {
2646 24         49 my $sym = $e;
2647 24 50       92 if (is_block($e)) {
2648 0         0 $sym = $ctx->exec_statement($e);
2649             }
2650 24 50 33     57 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         96 return ($scopename, $sym);
2655             }
2656             }
2657             }
2658 3         8 return;
2659             }
2660              
2661             sub resolve_ns {
2662 11     11 0 23 my ($ctx, $var, $in_block) = @_;
2663 11         18 my $parser = $ctx->{parser};
2664              
2665             # https://php.net/manual/en/language.namespaces.rationale.php
2666             #
2667 11 50       35 if ($var =~ /^#ns\d+$/) {
2668 11         15 my ($n, $e) = @{$parser->{strmap}->{$var}};
  11         27  
2669 11         16 my $ns;
2670              
2671 11 100       24 if (!defined $n) {
2672 7 50       17 $ctx->{log}->($ctx, 'resolve', $var, "toplevel") if $ctx->{log};
2673 7         12 $ns = ''; # toplevel
2674             } else {
2675 4         8 my $name = $n;
2676 4 50       10 if (!is_symbol($name)) {
2677 4         11 my $s = $ctx->exec_statement($name);
2678 4 50 33     9 if (is_strval($s) && !is_null($s)) {
2679 0         0 $name = $parser->{strmap}->{$s};
2680             } else {
2681 4         7 $name = $s;
2682             }
2683 4 50       12 $ctx->{log}->($ctx, 'resolve', $var, "map %s (%s) -> %s", $n, $e, $name) if $ctx->{log};
2684             }
2685 4 50       9 if ($name eq 'namespace') {
2686 0         0 $ns = lc($ctx->{namespace});
2687             } else {
2688 4         6 $ns = $name;
2689             }
2690             }
2691 11         57 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 359 my ($ctx, $var, $in_block) = @_;
2700 164         291 my $parser = $ctx->{parser};
2701 164         441 my $elemlist = _get_elemlist($parser, $var);
2702              
2703 164 50       623 if ($elemlist->[0] =~ /^#elem\d+$/) {
2704 164         292 my ($v, $i) = @{$parser->{strmap}->{$elemlist->[0]}};
  164         445  
2705              
2706 164 100 66     708 if (defined $i && ($v !~ /^#elem\d+$/)) {
2707             # allow only to resolve variable recursively
2708             # todo: use resolve_variable() here?
2709             #
2710 140         223 my $val;
2711 140 100       431 if ($v =~ /^#expr\d+$/) {
    100          
2712 2         9 $val = $ctx->resolve_varvar($v, $in_block);
2713 2 50 33     11 if (($val ne $v) && !is_variable($val)) {
2714 0         0 return _update_elemlist($parser, $val, $elemlist);
2715             }
2716             } elsif ($v =~ /^#obj\d+$/) {
2717 4         18 my ($inst, $prop) = $ctx->resolve_obj($v, $in_block);
2718 4 100       20 if (defined $inst) {
2719 2         11 $val = inst_var($inst, '$'.$prop);
2720             }
2721             } else {
2722 134         332 $val = $ctx->exec_statement($v, $in_block);
2723             }
2724 140 100 100     604 if (defined $val && is_variable($val)) {
2725 65         261 my $idx = $ctx->exec_statement($i);
2726 65         254 my $g = $parser->globalvar_to_var($val, $idx);
2727 65 100       261 if (defined $g) {
    100          
2728             # convert resolved basevar $GLOBALS['x'] -> $x,
2729             #
2730 30 100       92 if ($ctx->{infunction}) {
2731 13         46 $g = global_var($g);
2732             }
2733 30         84 shift(@$elemlist);
2734 30 100       71 if (@$elemlist) {
2735 4         20 return _update_elemlist($parser, $g, $elemlist);
2736             } else {
2737 26         100 return [$g];
2738             }
2739             } elsif ($ctx->is_superglobal($val)) {
2740 21         67 return $elemlist;
2741             } else {
2742             # convert resolved baseelem ${$a}['x'] -> $b['x'],
2743             #
2744 14         65 return _update_elemlist($parser, $val, $elemlist);
2745             }
2746             }
2747             }
2748             }
2749 99         232 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 237 my ($ctx, $elemlist, $in_block) = @_;
2763 123         258 my $parser = $ctx->{parser};
2764 123         349 my $superglobals_writable = 1;
2765              
2766 123         235 my $elem = $elemlist->[0];
2767 123         208 my ($v, $i) = @{$parser->{strmap}->{$elem}};
  123         300  
2768 123         303 my $val = $ctx->exec_statement($v, $in_block);
2769 123         249 my $basevar = $v;
2770              
2771 123 100       291 if (is_variable($val)) {
2772             # resolved reference
2773 29 50 66     102 if (!$ctx->is_superglobal($val) || $superglobals_writable) {
2774 29         57 $v = $val;
2775 29         61 $val = undef;
2776             }
2777             }
2778 123 100 100     412 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       118 unless (exists $ctx->{skip}{treat_empty_str_like_empty_array}) {
2783 38         190 $ctx->{warn}->($ctx, 'elem', $elem, "treat empty str $val like empty array");
2784 38         2726 $val = undef;
2785             }
2786             }
2787 123 50 66     424 if (defined $val && is_null($val)) {
2788 0         0 $val = undef;
2789             }
2790 123 100 100     380 if (!defined $val || is_array($val)) {
2791 119 100       245 if (!defined $val) {
2792             # nonexisting array is auto-created
2793             #
2794 67         232 my $arr = $parser->newarr();
2795 67         153 $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         119 my $arr = $parser->{strmap}{$val};
2802 52         150 $arr = $arr->copy(); # recursive copy
2803 52 50       170 $ctx->{log}->($ctx, 'elem', $elem, "create_base copyarr $v: $val -> $arr->{name}") if $ctx->{log};
2804 52         97 $val = $arr->{name};
2805             }
2806             # don't insert '$x = array()' into block
2807             #
2808 119         337 $ctx->setvar($v, $val, 1);
2809             #$ctx->setvar($v, $val, $in_block);
2810             } else {
2811             # something like #obj?
2812             #
2813 4         27 my $lastelem = $elemlist->[-1];
2814 4         8 my ($lastvar, $lastidx) = @{$parser->{strmap}->{$lastelem}};
  4         15  
2815 4         19 return ($lastvar, $val, $basevar);
2816             }
2817              
2818             # resolve next index
2819             #
2820 119         493 foreach my $nextelem (@$elemlist[1..@$elemlist-1]) {
2821 22         53 my $idx;
2822             my $nextval;
2823 22         49 my $arr = $parser->{strmap}{$val};
2824              
2825 22 50       63 if (defined $i) {
2826 22         68 $idx = $ctx->exec_statement($i, $in_block);
2827 22 100       87 $idx = $parser->setstr('') if is_null($idx); # null maps to '' array index
2828 22         83 my $arrval = $arr->get($idx);
2829 22 100       94 if (defined $arrval) {
2830 4         8 $nextval = $arrval;
2831             }
2832             }
2833 22 100 100     108 if (!defined $nextval || is_array($nextval)) {
2834 21 100       54 if (!defined $nextval) {
2835             # nonexisting intermediate array is auto-created
2836             #
2837 18         48 my $newarr = $parser->newarr();
2838 18 50       79 $ctx->{log}->($ctx, 'elem', $elem, "create_base autoarr $nextelem: = $newarr->{name} [basevar: $basevar]") if $ctx->{log};
2839 18         59 $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         84 $arr->set($idx, $nextval);
2846 21 50       75 $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     68 if (($elem ne $v) || ($idx ne $i)) {
2852 22         68 $elem = $parser->setelem($v, $idx);
2853             }
2854 22         45 $v = $elem;
2855 22         38 $val = $nextval;
2856 22         43 ($elem, $i) = @{$parser->{strmap}->{$nextelem}};
  22         79  
2857             }
2858 119         443 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 361 my ($ctx, $var, $in_block) = @_;
2868 180         329 my $parser = $ctx->{parser};
2869              
2870             # returns: <$resolved_var>
2871             #
2872 180 50       402 if (!defined $var) {
2873 0         0 $ctx->{warn}->($ctx, 'resolve', '', "");
2874 0         0 return;
2875             }
2876 180 100       430 if (is_variable($var)) {
    50          
    50          
    100          
    50          
2877 124 50       458 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         415 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         26 my ($v, $i) = @{$parser->{strmap}->{$var}};
  16         50  
2902              
2903 16 50       44 if (!defined $v) {
2904 0         0 $ctx->{warn}->($ctx, 'resolve', $var, "BAD ELEM");
2905 0         0 return;
2906             }
2907 16 50       45 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         61 my $elemlist = $ctx->get_baseelem($var, $in_block);
2926 16         56 my $basevar = $elemlist->[0];
2927 16         36 my $baseidx;
2928              
2929             # this was a conversion '$GLOBALS[x] -> $x'
2930             #
2931 16 100       72 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         6 return ($basevar, 0);
2934             }
2935 15         26 ($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}};
  15         58  
2936              
2937 15 0       44 $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       42 if (defined $basevar) {
2940 15 50       29 if (defined $i) {
2941 15         40 my $idxstr = $ctx->exec_statement($i);
2942 15         88 return ($basevar, 1, $idxstr);
2943             }
2944             }
2945             } elsif ($var =~ /^#expr\d+$/) {
2946 40         125 my $val = $ctx->resolve_varvar($var, $in_block);
2947 40 100 66     184 if (($val ne $var) && !($val =~ /^#expr\d+$/)) {
2948 27         91 return $ctx->resolve_variable($val, $in_block);
2949             }
2950             }
2951 13         32 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 1470 my ($ctx, $arglist, $param, $in_block) = @_;
2959 768         1195 my @args = ();
2960 768         1162 my $arg_changed = 0;
2961 768         991 my $i = 0;
2962              
2963 768         1505 foreach my $p (@$arglist) {
2964 626 100 100     2482 if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) {
    100 66        
2965             # reference is resolved in exec_func->set_func_params
2966             #
2967 27         85 push(@args, $p);
2968             } elsif (!is_strval($p) || is_const($p)) {
2969 255         751 my $v = $ctx->exec_statement($p, $in_block);
2970              
2971 255         642 push(@args, $v);
2972 255 100       759 if ($v ne $p) {
2973 158         364 $arg_changed = 1;
2974             }
2975             } else {
2976 344         910 push(@args, $p);
2977             }
2978             }
2979 768         2214 return (\@args, $arg_changed);
2980             }
2981              
2982             sub invalidate_arglist_refs {
2983 2     2 0 8 my ($ctx, $arglist, $param, $in_block) = @_;
2984 2         7 my $i = 0;
2985              
2986 2         4 foreach my $p (@$arglist) {
2987 4 100 66     61 if (($i < scalar @$param) && ($param->[$i++] =~ /^#ref\d+$/)) {
2988 2 50       13 if (is_variable($p)) {
2989 2         17 $ctx->setvar($p, '#unresolved', $in_block);
2990             }
2991             # todo: elem
2992             }
2993             }
2994 2         6 return;
2995             }
2996              
2997             sub loop_start {
2998 59     59 0 144 my ($parser) = @_;
2999              
3000 59 50       156 unless (exists $parser->{strmap}->{_LOOP}) {
3001 59         161 $parser->{strmap}->{_LOOP} = 0;
3002 59         121 $parser->{strmap}->{_LOOP_LEVEL} = 1;
3003 59         134 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 83 my ($parser) = @_;
3017 42         137 return $parser->{strmap}->{_LOOP_LEVEL};
3018             }
3019              
3020             sub loop_end {
3021 59     59 0 127 my ($parser, $toploop, $i) = @_;
3022              
3023 59 50       133 if ($toploop) {
3024 59         136 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         117 return;
3031             }
3032              
3033             sub exec_statement {
3034 8049     8049 1 16026 my ($ctx, $var, $in_block) = @_;
3035 8049         13954 my $parser = $ctx->{parser};
3036              
3037 8049 50       14863 if (!defined $var) {
3038 0         0 $ctx->{warn}->($ctx, 'exec', '', "");
3039 0         0 return $var;
3040             }
3041 8049 100 100     18303 if (is_strval($var) && !is_const($var)) {
3042 1096         2926 return $var;
3043             }
3044 6953 100       14025 if ($var =~ /^#ref\d+$/) {
3045 6         16 return $var;
3046             }
3047 6947 0       13264 $ctx->{log}->($ctx, 'exec', $var, "%s%s", $parser->stmt_str($var), $in_block ? ' (inblock)' : '') if $ctx->{log};
    50          
3048              
3049 6947 100       14150 if (is_variable($var)) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
3050 1588 100       4193 if (exists $ctx->{varmap}{ref}{$var}) {
3051 15         25 my ($ctx2, $var1) = @{$ctx->{varmap}{ref}{$var}};
  15         44  
3052             #if (!$ctx->is_superglobal($var1) || ($var1 =~ /^\$GLOBALS$/)) {
3053 15 50       45 $ctx->{log}->($ctx, 'exec', $var, "resolve reference -> $var1") if $ctx->{log};
3054 15         25 $var = $var1;
3055 15         23 $ctx = $ctx2;
3056             #}
3057             }
3058 1588         3680 my $val = $ctx->getvar($var);
3059 1588 100 100     5889 if (defined $val && ($val eq '#unresolved')) {
3060 266 50       750 $ctx->{log}->($ctx, 'exec', $var, "is unresolved") if $ctx->{log};
3061 266         495 $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       3391 if (defined $val) {
3071             #unless ($val =~ /^\$GLOBALS$/) {
3072 1031         1878 my $str = $val;
3073 1031 100       2498 if (is_strval($val)) {
    100          
3074 670         1735 $str = $parser->{strmap}{$val};
3075 670 50       1520 $ctx->{log}->($ctx, 'getvar', $var, "-> %s [%s]", $val, $parser->shortstr($str, 60)) if $ctx->{log};
3076             } elsif (is_array($val)) {
3077 309         614 my $arr = $parser->{strmap}{$val};
3078 309         888 my $keys = $arr->get_keys();
3079 309 50       960 $ctx->{log}->($ctx, 'getvar', $var, "-> %s [size: %d]", $val, scalar @$keys) if $ctx->{log};
3080             } else {
3081 52 50       153 $ctx->{log}->($ctx, 'getvar', $var, "-> %s", $val) if $ctx->{log};
3082             }
3083 1031         2751 return $val;
3084             #} else {
3085             # $ctx->{log}->($ctx, 'exec', $var, "is superglobal") if $ctx->{log};
3086             #}
3087             }
3088 557         1735 return $var;
3089             } elsif (is_const($var)) {
3090 89         275 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         226 my $nv = $ctx->add_namespace($v);
3099              
3100 89 100 33     719 if (exists $ctx->{defines}{$nv}) {
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
3101 3         15 my $val = $ctx->{defines}{$nv};
3102 3         10 my $str = $val;
3103 3 50       15 $ctx->{log}->($ctx, 'getdef', $var, "%s -> %s [%s]", $nv, $val, $parser->shortstr($str, 60)) if $ctx->{log};
3104 3         12 return $val;
3105             } elsif ($v =~ /^__FUNCTION__$/) {
3106 5 50       16 if ($ctx->{infunction}) {
3107 5         18 my ($class, $prop) = method_split($ctx->{infunction});
3108 5 100       18 $prop = $ctx->{infunction} unless defined $prop;
3109 5         14 my $fun = $ctx->getfun($prop);
3110 5 100       18 if (defined $fun) { # convert name to mixedcase
3111 4         5 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  4         15  
3112 4 100       13 if ($ctx->{namespace}) {
3113 1         10 $f = ns_name($ctx->{namespace}, $f); # keep namespace case here
3114             }
3115 4         18 return $parser->setstr($f);
3116             }
3117             } else {
3118 0         0 return $parser->setstr('');
3119             }
3120             } elsif ($v =~ /^__CLASS__$/) {
3121 1 50       5 if (exists $ctx->{class_scope}) {
3122 1         5 my $class = $ctx->getclass($ctx->{class_scope});
3123 1 50       6 if (defined $class) { # convert name to mixedcase
3124 1         5 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  1         5  
3125 1 50       315 if ($ctx->{namespace}) {
3126 0         0 $n = ns_name($ctx->{namespace}, $n); # keep namespace case here
3127             }
3128 1         9 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         13 my $fun = $ctx->getfun($ctx->{infunction});
3137 4 50       14 if (defined $fun) {
3138 4         7 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$fun}};
  4         16  
3139 4         12 my ($classname, $prop) = method_split($ctx->{infunction});
3140 4         9 my $name; # convert name to mixedcase
3141 4 50       14 if (defined $classname) {
3142 4         12 my $class = $ctx->getclass($classname);
3143 4         8 my ($n, $cb, $cp) = @{$parser->{strmap}->{$class}};
  4         12  
3144 4         12 $name = method_name($n, $f);
3145             } else {
3146 0         0 $name = $f;
3147             }
3148 4 50       13 if ($ctx->{namespace}) {
3149 0         0 $name = ns_name($ctx->{namespace}, $name); # keep namespace case here
3150             }
3151 4         13 return $parser->setstr($name);
3152             }
3153             } else {
3154 0         0 return $parser->setstr('');
3155             }
3156             } elsif ($v =~ /^__NAMESPACE__$/) {
3157 1 50       7 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       157 unless ($ctx->{tainted}) {
3178 50         149 my $k = $parser->setstr($v);
3179 50         294 $ctx->{warn}->($ctx, 'exec', $var, "convert undefined const to string: $v -> $k");
3180 50         5205 return $k;
3181             } else {
3182 24         100 $ctx->{warn}->($ctx, 'exec', $var, "don't convert undefined const to string: $v -> tainted");
3183             }
3184             }
3185 26         1670 return $var;
3186             } elsif ($var =~ /^#arr\d+$/) {
3187 201         546 my $arr = $parser->{strmap}{$var};
3188              
3189             # try to simplify array here (if not in function)
3190             #
3191 201 100       605 unless ($ctx->{incall}) {
3192 145 50       376 if (exists $ctx->{simplify}{arr}) {
3193 145         237 my @newkeys;
3194             my %newmap;
3195 145         211 my $changed = 0;
3196 145         443 my $keys = $arr->get_keys();
3197              
3198 145         378 foreach my $k (@$keys) {
3199 205         498 my $val = $arr->val($k);
3200 205 100 100     671 if ((is_int_index($k) || is_strval($k)) && (!defined $val
      66        
      100        
3201             || (defined $val && is_strval($val)))) {
3202 191         374 push(@newkeys, $k);
3203 191         639 $newmap{$k} = $val;
3204             } else {
3205 14         42 my $k2 = $k;
3206 14 100       72 unless (is_int_index($k)) {
3207 9         28 $k2 = $ctx->exec_statement($k);
3208             }
3209 14         46 push(@newkeys, $k2);
3210 14 50       62 if (defined $val) {
3211 14         40 my $v = $ctx->exec_statement($val);
3212 14         58 $newmap{$k2} = $v;
3213             } else {
3214 0         0 $newmap{$k2} = undef;
3215             }
3216 14 100 100     91 if (($k ne $k2) || ($val ne $newmap{$k2})) {
3217 10         32 $changed = 1;
3218             }
3219             }
3220             }
3221 145 100       544 if ($changed) {
3222 10         38 $arr = $parser->newarr();
3223 10         27 foreach my $k (@newkeys) {
3224 12         45 $arr->set($k, $newmap{$k});
3225             }
3226 10 50       48 $ctx->{log}->($ctx, 'exec', $var, "simplify -> $arr->{name}") if $ctx->{log};
3227 10         48 return $arr->{name};
3228             }
3229             }
3230             }
3231 191         495 return $var;
3232             } elsif ($var =~ /^#obj\d+$/) {
3233 22         38 my ($o, $m) = @{$parser->{strmap}->{$var}};
  22         80  
3234              
3235 22         112 my ($inst, $prop) = $ctx->resolve_obj($var, $in_block);
3236 22 100       61 if (defined $inst) {
3237 13         64 my $instvar = inst_var($inst, '$'.$prop);
3238              
3239 13         39 my $basestr = $ctx->getvar($instvar);
3240 13 100 100     60 if (defined $basestr && ($basestr ne '#unresolved')) {
3241 11         35 return $basestr;
3242             }
3243 2 50       7 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         31 return $var;
3250             } elsif ($var =~ /^#scope\d+$/) {
3251 16         45 my ($c, $e) = @{$parser->{strmap}->{$var}};
  16         51  
3252              
3253 16         52 my ($scope, $val) = $ctx->resolve_scope($var, $in_block);
3254 16 50       43 if (defined $scope) {
3255 16 100       37 if (is_variable($val)) {
    50          
3256 13         38 my $classvar = inst_var($scope, $val);
3257              
3258 13         33 my $basestr = $ctx->getvar($classvar);
3259 13 100 100     55 if (defined $basestr && ($basestr ne '#unresolved')) {
3260 2         7 return $basestr;
3261             }
3262 11         41 return $classvar;
3263             } elsif (is_symbol($val)) {
3264 3         22 my $name = method_name($scope, $val);
3265              
3266 3 50       19 if (exists $ctx->{defines}{$name}) {
3267 3         8 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         9 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         17 my ($n, $e) = @{$parser->{strmap}->{$var}};
  9         23  
3286              
3287 9         27 my ($ns, $val) = $ctx->resolve_ns($var, $in_block);
3288 9 50       23 if (defined $ns) {
3289 9 50       31 if ($val =~ /^#class\d+$/) {
    50          
    100          
    50          
    50          
3290             } elsif ($val =~ /^#fun\d+$/) {
3291             } elsif (is_const($val)) {
3292 4         25 my $str = $parser->get_strval($val);
3293 4         13 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         9 my $const = $ctx->{defines}{$sym};
3298 4 50       10 $ctx->{log}->($ctx, 'exec', $var, "lookup const %s -> %s", $name, $const) if $ctx->{log};
3299 4         20 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         18 my $name = ns_name(lc($ns), $val);
3308 5         12 my ($sym) = $name =~ /^\/(.*)$/;
3309 5         13 return $name;
3310             }
3311             }
3312 0         0 return $var;
3313             } elsif ($var =~ /^#elem\d+$/) {
3314 363         658 my ($v, $i) = @{$parser->{strmap}->{$var}};
  363         1112  
3315 363         670 my $basevar = $v;
3316 363         1694 my $basestr = $ctx->exec_statement($v, $in_block);
3317 363         701 my $idxstr = $i;
3318              
3319 363 100       996 if (is_null($basestr)) {
3320 18         38 $basestr = undef;
3321             }
3322 363 50       860 if (defined $i) {
3323 363 100 100     852 if (!is_strval($i) || is_const($i)) {
3324 163         410 $idxstr = $ctx->exec_statement($i);
3325             }
3326 363 100       800 if (defined $basestr) {
3327 345         1136 my $g = $parser->globalvar_to_var($basestr, $idxstr);
3328 345 100       958 if (defined $g) {
    100          
    100          
    100          
3329 63 100       185 if ($ctx->{infunction}) {
3330 24         74 $g = global_var($g);
3331             }
3332 63         172 $basestr = $ctx->getvar($g);
3333              
3334 63 0       202 $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     241 if (defined $basestr && ($basestr eq '#unresolved')) {
3337 9         19 $basestr = undef;
3338             }
3339 63 100       148 if (defined $basestr) {
3340 40         101 return $ctx->exec_statement($basestr);
3341             }
3342 23         74 return $g; # return simplified global var
3343             } elsif ($ctx->is_superglobal($basestr)) {
3344 51         109 $basevar = $basestr;
3345 51         146 my $val = $ctx->getvar($basestr);
3346 51 50       189 if (defined $val) {
3347 0         0 $basestr = $val;
3348             }
3349             } elsif (is_variable($basestr)) {
3350 19 100       68 if ($basestr eq $basevar) { # getvar() failed
3351 9         24 $basestr = $ctx->getvar($basevar);
3352             } else {
3353 10         22 $basevar = $basestr;
3354             }
3355             } elsif ($basestr =~ /^#elem\d+$/) {
3356 7         18 $basevar = $basestr;
3357             }
3358             }
3359             }
3360 300 0       835 $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     1868 if (defined $basestr && ($basestr eq '#unresolved')) {
    100 100        
    100 66        
    100 66        
      33        
      100        
      66        
      66        
      33        
      66        
3363 7 50       37 $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         101 my $baseval = $parser->get_strval($basestr);
3366 31         109 my $pos = $parser->get_strval($idxstr);
3367              
3368             # todo: $pos might be non-numeric array-key here
3369             #
3370 31 50       151 if ($pos =~ /^[\d\.]+$/) {
3371 31         75 $pos = int($pos);
3372 31 100       75 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         26 $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       278 if ($pos == length($baseval)) {
3380 3         10 my $ch = '';
3381 3         14 return $parser->setstr($ch);
3382             }
3383             } else {
3384 28         69 my $ch = substr($baseval, $pos, 1);
3385 28         95 my $k = $parser->setstr($ch);
3386 28 50       78 $ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s", $basestr, $pos, $ch) if $ctx->{log};
3387 28         84 return $k;
3388             }
3389             }
3390             } elsif (defined $basestr && is_array($basestr) && defined $idxstr) {
3391 169         393 my $arr = $parser->{strmap}{$basestr};
3392 169 100       370 $idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index
3393 169         561 my $arrval = $arr->get($idxstr);
3394 169 100       767 if (defined $arrval) {
3395 135 50       322 $ctx->{log}->($ctx, 'exec', $var, "getelem %s[%s] = %s[%s]", $basevar, $idxstr, $basestr, $arrval) if $ctx->{log};
3396 135         455 return $arrval;
3397             }
3398             } elsif (!(exists $ctx->{skip}{null}) && !defined $basestr && (!$ctx->is_superglobal($basevar) || ($basevar =~ /^\$GLOBALS$/))) {
3399 20 100       58 unless ($ctx->{tainted}) {
3400 18 50       71 $ctx->{warn}->($ctx, 'exec', $var, "getelem %s[%s] not found -> #null", $basevar, defined $i ? $i : '');
3401 18         1898 return '#null';
3402             }
3403             }
3404             # simplify elem expression
3405             # (don't simplify $GLOBAL[..] references when parsing function)
3406             #
3407 116 50       835 if (exists $ctx->{simplify}{elem}) {
3408 116 50       256 if (defined $i) {
3409 116 100 100     447 if (($v ne $basevar) || ($i ne $idxstr)) {
3410 36         144 my $k = $parser->setelem($basevar, $idxstr);
3411 36 50       124 $ctx->{log}->($ctx, 'exec', $var, "simplify %s -> %s[%s]", $parser->stmt_str($var), $basevar, $idxstr) if $ctx->{log};
3412 36         113 return $k;
3413             }
3414             }
3415             }
3416 80         246 return $var;
3417             } elsif ($var =~ /^#expr\d+$/) {
3418 1618         2455 my ($op, $v1, $v2) = @{$parser->{strmap}->{$var}};
  1618         4485  
3419 1618         2569 my $op2;
3420              
3421 1618 100 66     5143 if (($op eq '=') && defined $v2) {
3422 1030         1788 my $vv1 = $v1;
3423              
3424 1030 100       2138 if ($v1 =~ /^#obj\d+$/) {
3425 11         65 my ($inst, $prop) = $ctx->resolve_obj($v1, $in_block);
3426 11 100       35 if (defined $inst) {
3427 7         30 my $instvar = inst_var($inst, '$'.$prop);
3428 7 50       22 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to instvar $instvar") if $ctx->{log};
3429 7         26 $vv1 = $instvar;
3430             }
3431             }
3432 1030 100       1980 if ($v1 =~ /^#scope\d+$/) {
3433 9         25 my ($scope, $val) = $ctx->resolve_scope($v1, $in_block);
3434 9 50 33     35 if (defined $scope && is_variable($val)) {
3435 9         38 my $classvar = inst_var($scope, $val);
3436 9 50       31 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to classvar $classvar") if $ctx->{log};
3437 9         36 $vv1 = $classvar;
3438             }
3439             }
3440 1030 100       1945 if ($v1 =~ /^#expr\d+$/) {
3441             # calc variable name (a.e: ${ $var })
3442             #
3443 13         51 my $basevar = $ctx->resolve_varvar($v1, $in_block);
3444 13 100 66     69 if (defined $basevar && ($basevar ne $v1)) {
3445 10 50       32 $ctx->{log}->($ctx, 'exec', $var, "assign to var $v1 -> resolved to varvar $basevar") if $ctx->{log};
3446 10         30 $vv1 = $basevar;
3447             }
3448             }
3449             # don't simplify #obj variable to $#inst\d+$var
3450             #
3451 1030 100       2447 my $vv1_sim = is_instvar($vv1) ? $v1 : $vv1;
3452              
3453 1030 50       2008 if (defined $v2) {
3454             # always track variables here for statements like '$a = $b = 1'
3455             #
3456 1030         2511 $op2 = $ctx->exec_statement($v2);
3457             }
3458 1030 100       2390 if (is_variable($vv1)) {
    100          
    100          
3459 865 100 66     5894 if (defined $op2 && ($op2 =~ /^#ref\d+$/)) {
    100 66        
    100 66        
    100          
    100          
3460 6         21 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         26 $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         22 $ctx->{varmap}{ref}{$vv1} = [$ctx, $v2];
3472 3 50       13 $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         13 my $a = $ctx->getvar($v2);
3487 5 100 66     27 if (defined $a && is_array($a)) {
3488 1         4 my $arr = $parser->{strmap}{$a};
3489 1         5 $arr = $arr->copy();
3490 1         2 my $a2 = $arr->{name};
3491 1 50       4 $ctx->{log}->($ctx, 'setref', $vv1, "copy defined superglobal $v2 -> $a") if $ctx->{log};
3492 1         4 $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         19 $ctx->setvar($vv1, '#unresolved', $in_block);
3497 4         9 $op2 = $v2;
3498 4 50       15 $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         439 $ctx->setvar($vv1, '#unresolved', $in_block);
3504 133 100 66     495 if ($in_block || !exists $ctx->{varhist}) {
3505 120 50       327 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved") if $ctx->{log};
3506 120 100 100     560 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3507 25         102 return $parser->setexpr('=', $vv1_sim, $op2);
3508             }
3509 95         319 return $var;
3510             }
3511 13 50       43 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> #unresolved [TRACK]") if $ctx->{log};
3512 13         47 $ctx->track_assignment($vv1, $op2);
3513 13         50 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         5 my ($type, $a) = @{$parser->{strmap}->{$op2}};
  1         4  
3520 1 50       6 if (scalar @$a > 0) {
3521 1         4 $ctx->setvar($vv1, $a->[0], $in_block);
3522 1         4 my $k = $parser->setexpr('=', $vv1_sim, $a->[0]);
3523 1         7 my $b = $parser->setblk('flat', [$k, @$a[1..@$a-1]]);
3524 1 50       4 $ctx->{log}->($ctx, 'exec', $var, "assign to var $vv1 = $op2 -> converted to block $k") if $ctx->{log};
3525 1         4 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       1696 $ctx->{log}->($ctx, 'exec', $var, "assign to var %s = %s -> %s", $vv1, $v2, $op2) if $ctx->{log};
3532 717         1665 $ctx->setvar($vv1, $op2, $in_block);
3533             }
3534 730 100       1528 if ($in_block) {
3535 669 100 100     2504 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3536 218         742 return $parser->setexpr('=', $vv1_sim, $op2);
3537             }
3538             } else {
3539 61         180 return $op2;
3540             }
3541             } elsif ($v1 =~ /^#elem\d+$/) {
3542 148         285 my ($v, $i) = @{$parser->{strmap}->{$v1}};
  148         465  
3543 148         451 my $elemlist = $ctx->get_baseelem($v1, $in_block);
3544 148         307 my $basevar = $elemlist->[0];
3545 148         762 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       535 if ($basevar =~ /^(\#elem\d+)$/) {
3552 123         193 ($basevar, $baseidx) = @{$parser->{strmap}->{$basevar}};
  123         345  
3553 123         363 ($parent, $basestr, $basevar) = $ctx->create_basearray($elemlist, $in_block);
3554 123         230 $has_index = 1;
3555             } else {
3556 25         49 $has_index = 0; # conversion '$GLOBALS[x] -> $x'
3557 25         38 $parent = $basevar;
3558 25         73 $basestr = $ctx->exec_statement($basevar, $in_block);
3559             }
3560            
3561 148 100 66     583 if (defined $basestr && is_null($basestr)) {
3562 10         24 $basestr = undef;
3563             }
3564 148 50 66     538 if (defined $basestr && ($basestr eq '#unresolved')) {
3565 0         0 $basestr = undef;
3566             }
3567 148 100       278 if (defined $i) {
3568 123         306 $idxstr = $ctx->exec_statement($i);
3569             }
3570              
3571 148 50       328 if (defined $basevar) {
3572 148 0       409 $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     600 if (!$has_index) {
    100 66        
    100 66        
      66        
3575 25 100       75 if ($ctx->is_unresolved_assignment($op2)) {
3576 5         14 $ctx->setvar($basevar, "#unresolved", $in_block);
3577             } else {
3578 20         62 $ctx->setvar($basevar, $op2, $in_block);
3579             }
3580 25         88 return $parser->setexpr('=', $basevar, $op2);
3581             } elsif (defined $basestr && is_strval($basestr) && !is_null($basestr) && defined $idxstr) {
3582 3 50       20 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         10 my $str = $parser->{strmap}->{$basestr};
3589 3         7 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         6 eval { substr($str, $pos, 1) = $ch; };
  3         10  
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         15 my $k = $parser->setstr($str);
3599 3         10 $ctx->setvar($v, $k, $in_block);
3600              
3601 3 50       16 $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         10 return $parser->setexpr('=', $v, $k);
3603             }
3604             } elsif (!defined $basestr || is_array($basestr)) {
3605 118 50       261 if (defined $basestr) {
3606 118         258 my $arr = $parser->{strmap}{$basestr};
3607 118 100       342 if (!defined $idxstr) {
    100          
3608             # $arr[] = val - appends at end of array
3609             #
3610 25 100       75 if ($ctx->is_unresolved_assignment($op2)) {
3611             # mark variable as unresolved if rhs is not resolvable
3612             #
3613 4         22 $ctx->setvar($basevar, '#unresolved', $in_block);
3614 4         24 $arr->set(undef, $v2);
3615 4 50       15 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[] = %s -> #unresolved", $v, $op2) if $ctx->{log};
3616             } else {
3617 21         87 $arr->set(undef, $op2);
3618 21 50       62 $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         170 my $key = $idxstr;
3622 92 100       274 if ($ctx->is_unresolved_assignment($op2)) {
    100          
3623 7         27 $ctx->setvar($basevar, '#unresolved', $in_block);
3624 7         36 $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         28 $arr->set($key, $op2);
3629 5 50       21 $ctx->{log}->($ctx, 'exec', $var, "assign to elem $v1 set: %s[null] = %s", $v, $op2) if $ctx->{log};
3630             } else {
3631 80         334 $arr->set($key, $op2);
3632 80 50       283 $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       334 if (exists $ctx->{simplify}{expr}) {
3645 118         209 my $op1 = $v1;
3646 118 100 100     550 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     116 if (!is_instvar($parent) && !is_instvar($basevar)) {
3650 40         119 $op1 = $parser->setelem($parent, $idxstr);
3651             }
3652             }
3653 118 100 66     1892 if ($in_block || !exists $ctx->{varhist}) {
3654 108 100 100     382 if (($v1 ne $op1) || ($v2 ne $op2)) {
3655 61         180 my $k = $parser->setexpr('=', $op1, $op2);
3656 61 50       181 $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         291 return $k;
3658             }
3659 47         189 return $var;
3660             }
3661              
3662             # track elem assignments in expressions
3663             #
3664 10 100 66     37 if (($v1 ne $op1) || ($v2 ne $op2)) {
3665 3 50       12 $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       18 $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     29 if (is_strval($op2) || is_array($op2)) {
3672 9         37 return $op2;
3673             }
3674 1         5 return $op1;
3675             }
3676 0         0 return $var;
3677             }
3678             }
3679 2         13 $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         21 my $arr_d = $parser->{strmap}{$v1};
3684 8         21 my $keys_d = $arr_d->get_keys();
3685              
3686 8         19 my $arr_s;
3687 8 100       24 if (is_array($op2)) {
    100          
3688 6         18 $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       21 if (defined $arr_s) {
3694 7         18 my $keys_s = $arr_s->get_keys();
3695 7         23 my $newarr = $parser->newarr();
3696 7         32 foreach my $k (@$keys_d) {
3697 15         42 my $dst = $arr_d->val($k);
3698 15 100       36 next if (!defined $dst);
3699 14         31 my $src = $arr_s->get($k);
3700 14 100       33 if (defined $src) {
3701 12 100       40 if (is_variable($dst)) {
    50          
3702 10 50       28 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         26 $ctx->setvar($dst, $src, $in_block);
3707             }
3708             } elsif ($dst =~ /^#elem\d+$/) {
3709 2         4 my ($v, $i) = @{$parser->{strmap}{$dst}};
  2         26  
3710 2 50       9 $ctx->{log}->($ctx, 'exec', $var, "assign to array $v1 = $op2 -> key $k ($dst) is elem") if $ctx->{log};
3711              
3712 2         8 my $sub = $parser->setexpr('=', $dst, $src);
3713 2         11 my $had_assigns = $ctx->have_assignments();
3714 2         6 $src = $ctx->exec_statement($sub);
3715 2 50       9 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         111 $ctx->discard_pending_assignments();
3721             }
3722             }
3723 12         39 $newarr->set($k, $src);
3724             }
3725             }
3726 7 100 66     28 if ($in_block || !exists $ctx->{varhist}) {
3727 4 50       11 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         17 return $var;
3733             }
3734 3         14 return $newarr->{name};
3735             }
3736             }
3737 463 50       1384 if (exists $ctx->{simplify}{expr}) {
3738 463 100       1044 if ($v1 =~ /^#elem\d+$/) {
3739 2         9 $vv1 = $ctx->exec_statement($v1, $in_block);
3740 2 50       7 if (!$ctx->is_superglobal($vv1)) {
3741 2 50 33     8 if (!is_variable($vv1) && !($vv1 =~ /^#elem\d+$/)) {
3742 0         0 $vv1 = $v1;
3743             }
3744             }
3745 2         5 $vv1_sim = $vv1;
3746             }
3747              
3748 463 100 100     1629 if (($v1 ne $vv1_sim) || ($v2 ne $op2)) {
3749             # simplify expr
3750             #
3751 4         17 my $k = $parser->setexpr('=', $vv1_sim, $op2);
3752 4 50       29 $ctx->{log}->($ctx, 'exec', $var, "simplify assign to $v1 ($vv1_sim) = $v2 ($op2) -> $k") if $ctx->{log};
3753 4         15 return $k;
3754             }
3755             }
3756 459         1330 return $var;
3757             }
3758 588         901 my $op1;
3759              
3760 588 100       1112 if (defined $v1) {
3761 447 50       930 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         1579 $op1 = $ctx->exec_statement($v1, $in_block);
3766             }
3767             }
3768 588 100 66     3468 if (!defined $v1 && defined $v2 && ($op eq 'new')) {
    100 100        
    100 66        
    100 66        
      100        
      66        
3769 39 50       133 if ($v2 =~ /^#call\d+$/) {
3770 39         62 my ($name0, $arglist) = @{$parser->{strmap}->{$v2}};
  39         97  
3771              
3772             # new class()
3773             # - class properties are initialized when exec(#class) is called
3774             #
3775 39         138 my ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block);
3776 39         91 my $name = lc($name0);
3777              
3778 39         89 $name = $ctx->add_namespace($name);
3779              
3780 39         93 my $class = $ctx->getclass($name);
3781 39 100 100     188 if (defined $class && exists $ctx->{varmap}{inst}{$name}) {
3782 34         62 my ($n, $b, $p) = @{$parser->{strmap}->{$class}};
  34         89  
3783 34         58 my $ctx2 = $ctx;
3784              
3785 34 50       86 $ctx->{log}->($ctx, 'new', $v2, "found class $class") if $ctx->{log};
3786              
3787             # create class instance
3788             #
3789 34         55 my $c2 = $v2;
3790 34 100       77 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         116 my $inst = $parser->setinst($class, $c2, $ctx2);
3795 34         79 $ctx2->{varmap}{inst}{$inst} = {}; # init instance var map
3796              
3797 34 50       73 $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         51 my %varmap = %{$ctx->{varmap}};
  34         193  
3802 34         74 $ctx2->{varmap}{inst}{$inst} = {%{$ctx2->{varmap}{inst}{$name}}}; # copy class var map
  34         110  
3803              
3804             # initialize instance methods class functions
3805             #
3806 34         57 my ($type, $memlist) = @{$parser->{strmap}->{$b}};
  34         87  
3807 34         70 foreach my $m (@$memlist) {
3808 59 100       186 if ($m =~ /^#fun\d+$/) {
3809 26         77 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$m}};
  26         81  
3810 26 50 33     94 if (defined $f && is_symbol($f)) {
3811 26         83 my $instvar = method_name($inst, lc($f)); # inst var default is class func
3812 26         94 my $classfunc = method_name($name, lc($f));
3813 26         89 $ctx2->{varmap}{inst}{$inst}{lc($f)} = $classfunc;
3814 26 50       86 $ctx->{log}->($ctx, 'new', $v2, "init inst func $instvar -> $classfunc") if $ctx->{log};
3815             }
3816             }
3817             }
3818              
3819             # constructor returns void
3820             #
3821 34         76 my $init = method_name($inst, '__construct');
3822 34         78 my $f = $ctx2->getfun($init);
3823 34 100       76 if (!defined $f) {
3824             # try old-style constructor (prior php80)
3825 30         79 my $init2 = method_name($inst, $name);
3826 30         65 $f = $ctx2->getfun($init2);
3827 30 100       75 if (defined $f) {
3828 2 50       9 $ctx->{log}->($ctx, 'new', $v2, "found oldstyle constructor $name") if $ctx->{log};
3829 2         5 $init = $init2;
3830             }
3831             }
3832 34 100       89 if (defined $f) {
3833 6         24 my $c = $parser->setcall($init, $arglist);
3834 6         31 my $k = $ctx2->exec_statement($c);
3835             # ignore void result
3836             }
3837 34         163 return $inst;
3838             }
3839 5 50       19 unless ($ctx->{incall}) {
3840 5 50       17 if (exists $ctx->{simplify}{stmt}) {
3841 5 50       15 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         467 $op2 = $ctx->exec_statement($v2, $in_block);
3855              
3856 102 100 100     500 if ($op eq '$') {
    100 100        
3857 48         174 my $var1 = $parser->varvar_to_var($op2);
3858 48 100       137 if (defined $var1) {
3859 42         99 return $ctx->exec_statement($var1);
3860             }
3861 6 50       25 if (exists $ctx->{simplify}{expr}) {
3862 6 100 66     27 if (is_variable($op2) && ($v2 ne $op2)) {
3863             # simplify expr
3864             #
3865 5         18 my $k = $parser->setexpr($op, undef, $op2);
3866 5 50       33 $ctx->{log}->($ctx, 'exec', $var, "simplify varvar $v2 ($op2) -> $k") if $ctx->{log};
3867 5         16 return $k;
3868             }
3869             }
3870             } elsif ((($op eq '--') || ($op eq '++')) && is_variable($v2)) {
3871             # ++$var
3872             # --$var
3873             #
3874 19 100       48 if (is_strval($op2)) {
3875 18         59 my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op2);
3876              
3877 18 50       46 if (defined $val) {
3878 18 50       55 $ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op, $op2, $val, $result) if $ctx->{log};
3879              
3880 18         50 my $k = $parser->setexpr('=', $v2, $val);
3881 18         48 my $res = $ctx->exec_statement($k, $in_block);
3882 18         62 return $res;
3883             }
3884             } else {
3885             # remove from varmap to avoid later simplification
3886             #
3887 1         15 $ctx->setvar($v2, '#unresolved', $in_block);
3888             }
3889             } else {
3890 35 100 100     99 if (is_strval($op2) || is_array($op2)) {
3891 21         86 my ($k, $result) = PHP::Decode::Op::unary($parser, $op, $op2);
3892 21 50       55 if (defined $k) {
3893 21 50       52 $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       106 if (exists $ctx->{simplify}{expr}) {
3901 16 50       50 if (is_instvar($op2)) {
3902 0         0 $op2 = $v2;
3903             }
3904 16 100       60 if ($v2 ne $op2) {
3905             # simplify expr
3906             #
3907 8         34 my $k = $parser->setexpr($op, undef, $op2);
3908 8 50       26 $ctx->{log}->($ctx, 'exec', $var, "simplify unary $var: $op $v2 ($op2) -> $k") if $ctx->{log};
3909 8         28 return $k;
3910             }
3911             }
3912             } elsif (defined $v1 && is_strval($op1) && !defined $v2) {
3913             # $var++
3914             # $var--
3915             #
3916 49 50       144 if (is_strval($op1)) {
3917 49         189 my ($val, $result) = PHP::Decode::Op::unary($parser, $op, $op1);
3918 49 50       152 if (defined $val) {
3919 49 50       165 $ctx->{log}->($ctx, 'exec', $var, "%s %s -> %s = %s", $op1, $op, $val, $result) if $ctx->{log};
3920              
3921 49         142 my $k = $parser->setexpr('=', $v1, $val);
3922 49         141 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     306 if (defined $res && ($res !~ /^#expr\d+$/)) {
3928 27         56 $res = $op1;
3929             }
3930 49         160 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       799 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     3182 if (!$in_block && (($op eq '||') || ($op eq 'or') || ($op eq '&&') || ($op eq 'and') || ($op eq '?') || ($op eq ':'))) {
      66        
3943 23 50       69 $ctx->{log}->($ctx, 'exec', $var, "set in_block for lazy or ordered evaluation") if $ctx->{log};
3944 23         37 $in_block = 1;
3945             }
3946 384         886 $op2 = $ctx->exec_statement($v2, $in_block);
3947             }
3948              
3949 384 100 100     959 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     980 if (($op ne '?') && ($op ne ':')) {
3951 242         855 my ($k, $result) = PHP::Decode::Op::binary($parser, $op1, $op, $op2);
3952 242 100       563 if (defined $k) {
3953 241 50       526 $ctx->{log}->($ctx, 'exec', $var, "%s %s %s -> %s", $op1, $op, $op2, $k) if $ctx->{log};
3954 241         683 return $k;
3955             } else {
3956 1         6 $ctx->{warn}->($ctx, 'exec', $var, "%s %s %s -> failed", $op1, $op, $op2);
3957             }
3958             }
3959             } elsif ($op eq '?') {
3960 15 50 66     69 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         19 my $val = $parser->{strmap}{$op1};
3965 7 50       19 if (is_array($op1)) {
3966 0         0 my $arr = $parser->{strmap}{$op1};
3967 0         0 $val = !$arr->empty();
3968             }
3969 7         25 my $k;
3970 7 100       18 if ($val) {
3971 5         20 $k = $ctx->exec_statement($parser->{strmap}->{$op2}->[1]);
3972             } else {
3973 2         10 $k = $ctx->exec_statement($parser->{strmap}->{$op2}->[2]);
3974             }
3975 7         26 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         7 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       378 if (exists $ctx->{simplify}{expr}) {
4000 136 50       300 if (is_instvar($op1)) {
4001 0         0 $op1 = $v1;
4002             }
4003 136 50       344 if (is_instvar($op2)) {
4004 0         0 $op2 = $v2;
4005             }
4006 136 100 100     580 if (($v1 ne $op1) || ($v2 ne $op2)) {
4007             # simplify expr (no variable setting must occur)
4008             #
4009 40         172 my $k = $parser->setexpr($op, $op1, $op2);
4010 40 50       130 $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         336 return $var;
4016             } elsif ($var =~ /^#call\d+$/) {
4017 733         1357 my ($name, $arglist) = @{$parser->{strmap}->{$var}};
  733         2149  
4018 733         1377 my $cmd = $name;
4019 733         1164 my $cmdsim = $name;
4020              
4021 733 100 100     1558 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         80 my $s = $ctx->exec_statement($name);
4023 26 100       146 if ($s =~ /^#fun\d+$/) {
    100          
4024 8         18 $cmd = $s;
4025 8         15 $cmdsim = $s;
4026             } elsif (!is_null($s)) {
4027 16 100       39 if (is_strval($s)) {
4028 13         42 $cmd = $parser->{strmap}->{$s};
4029             } else {
4030 3         15 $cmd = $s;
4031             }
4032 16         32 $cmdsim = $cmd;
4033             }
4034 26 50       82 $ctx->{log}->($ctx, 'exec', $var, "map %s (%s) -> %s", $name, $s, $cmd) if $ctx->{log};
4035             } elsif ($name =~ /^#obj\d+$/) {
4036 28         91 my ($inst, $prop) = $ctx->resolve_obj($name);
4037 28 100       66 if (defined $inst) {
4038 18 50       46 if (is_symbol($prop)) {
4039 18         42 $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       98 $ctx->{log}->($ctx, 'exec', $var, "map obj %s -> %s", $name, $cmd) if $ctx->{log};
4049             } elsif ($name =~ /^#scope\d+$/) {
4050 24         76 my ($scope, $val) = $ctx->resolve_scope($name);
4051 24 100       61 if (defined $scope) {
4052 21 50       71 if (is_symbol($val)) {
4053 21         62 $cmd = method_name($scope, $val);
4054 21         43 $cmdsim = $cmd;
4055             }
4056             }
4057 24 50       75 $ctx->{log}->($ctx, 'exec', $var, "map scope %s -> %s", $name, $cmd) if $ctx->{log};
4058             } elsif ($name =~ /^#ns\d+$/) {
4059 2         8 my ($ns, $val) = $ctx->resolve_ns($name);
4060 2 50       7 if (defined $ns) {
4061 2         8 $cmd = $parser->ns_to_str($name);
4062 2         5 $cmdsim = $cmd;
4063             }
4064 2 50       6 $ctx->{log}->($ctx, 'exec', $var, "map ns %s -> %s", $name, $cmd) if $ctx->{log};
4065             } elsif (is_symbol($name)) {
4066 635         1115 $cmd = $name;
4067 635         1235 $cmdsim = $cmd;
4068             }
4069              
4070             # function passed by name, by reference or anonymous function
4071             #
4072 733         1300 my $fun;
4073 733 100       1617 $fun = $cmd if ($cmd =~ /^#fun\d+$/);
4074 733 100       1571 unless (defined $fun) {
4075 722         1660 my $ncmd = $ctx->add_namespace($cmd);
4076 722         1949 $fun = $ctx->getfun($ncmd);
4077 722 100       1550 if (defined $fun) {
4078 198         393 $cmd = $ncmd;
4079             }
4080             }
4081 733 100       1529 if (defined $fun) {
4082 209         527 my $cmd1 = _is_wrapped_call($parser, $fun);
4083 209 100       442 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         8 $cmdsim = $cmd1;
4087 4         12 $fun = $ctx->getfun($cmd);
4088             }
4089             }
4090              
4091 733         1438 my $args = [];
4092 733         1172 my $arg_changed = 0;
4093              
4094 733 100 66     2840 if (defined $fun) {
    100 66        
    100          
4095 205 50       521 unless (exists $ctx->{skip}{call}) {
4096 205         330 my ($_name, $param, $block, $p) = @{$parser->{strmap}->{$fun}};
  205         595  
4097              
4098 205         520 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, $param, $in_block);
4099              
4100 205         428 my ($key, $code);
4101 205 50       533 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       466 unless (defined $key) {
4131 205         638 ($key, $code) = $ctx->exec_func($cmd, $args, $param, $block);
4132             }
4133 205 100       519 if (!defined $key) {
4134 5 50       25 my $info = $ctx->get_unresolved_info($cmd, defined $code ? $code : $block);
4135              
4136 5 50       16 unless (keys %{$info->{unresolved}}) {
  5         20  
4137 5 50       25 $ctx->{warn}->($ctx, 'func', $cmd, "%s executed (but no additional taint) (globals[%s])", defined $code ? 'partially' : 'not', join(' ', keys %{$info->{global_assigns}}));
  5         33  
4138 5         219 $ctx->set_globals_unresolved([keys %{$info->{global_assigns}}]);
  5         37  
4139 5         30 $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       426 if (defined $key) {
4145             # register exposed funcs
4146             #
4147 205 100       464 if (defined $code) {
4148 181 100       517 if (is_block($code)) {
4149 169         261 my ($type, $a) = @{$parser->{strmap}->{$code}};
  169         502  
4150 169         435 register_funcs($a, $ctx, $parser);
4151             } else {
4152 12         52 register_funcs([$code], $ctx, $parser);
4153             }
4154             }
4155 205 100       536 if ($key ne '#construct') {
4156 199         415 my $name_changed = 0;
4157 199 100       486 if ($cmd ne $name) {
4158             # expand anonymous function if not variable in #call
4159             #
4160 56 100 100     244 if (($cmd =~ /^#fun\d+$/) && is_variable($name)) {
    50          
4161 6         14 $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         120 $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         282 my $c;
4174 199         506 my $v = '$'.'eval'.'$'.$cmd;
4175             #my $v = '$'.'call'.'$'.$cmd;
4176 199 100 100     699 if (defined $code && !$in_block) {
4177 173         301 $c = $code;
4178             } else {
4179 26 100 100     145 if ($name_changed || $arg_changed) {
4180 13 50       40 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  8         43  
4181 13         54 $c = $parser->setcall($cmdsim, \@argssim);
4182             } else {
4183 13         29 $c = $var;
4184             }
4185             }
4186 199 100       590 if ($key eq '#notaint') {
    100          
4187 7         21 $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         7 $key = $c;
4194             }
4195             } else {
4196 188         602 $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       455 if ($key eq '#noreturn') {
4202 62         140 $key = '#null';
4203             }
4204             }
4205             }
4206 205 100       428 if ($key eq '#construct') {
4207             # insert simplified anonymous function here
4208             #
4209 6         18 my $methodname = $ctx->lookup_method_name($cmd);
4210 6 50       18 if (defined $methodname) {
4211 6         18 my ($classname, $prop) = method_split($methodname);
4212 6         11 my $f;
4213 6 50       17 unless ($f = _anon_func_call($parser, $code)) {
4214 6         27 $f = $parser->setfun(undef, [], $code);
4215             }
4216 6         18 my $v = '$__'.$classname.'_'.'__construct';
4217 6         19 $ctx->track_assignment($v, $f); # always track this variable
4218             }
4219             }
4220 205 0       491 $ctx->{log}->($ctx, 'exec', $var, "%s(%s) -> %s [%s]", $cmd, join(' , ', @$arglist), $key, defined $code ? $code : '-') if $ctx->{log};
    50          
4221 205         825 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         175 ($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         180 my $oldline = $parser->{strmap}->{'__LINE__'};
4237 56         103 $parser->{strmap}->{'__LINE__'} = 1;
4238 56         164 my $parser2 = $parser->subparser();
4239 56         205 my $ctx2 = $ctx->subctx(parser => $parser2, varhist => {});
4240 56         206 my $blk = $ctx2->parse_eval($args->[0]);
4241 56         99 my $key;
4242 56 100       152 if (defined $blk) { # might be non-string
4243 48         174 $key = $ctx2->exec_eval($blk);
4244             }
4245 56         128 $parser->{strmap}->{'__LINE__'} = $oldline;
4246              
4247 56 100       130 if (defined $key) {
4248 48         114 my $result = $parser->{strmap}->{$key};
4249              
4250             # eval returns concatted list of statements (as example a single #str)
4251             #
4252 48 50       111 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) -> %s", $cmd, $arglist->[0], $key) if $ctx->{log};
4253              
4254 48 100       106 if (is_block($key)) {
4255 13         30 my ($type, $a) = @{$parser->{strmap}->{$key}};
  13         39  
4256 13         34 register_funcs($a, $ctx, $parser);
4257             } else {
4258 35         135 register_funcs([$key], $ctx, $parser);
4259             }
4260              
4261 48         118 my @seq = ();
4262 48         168 $parser->flatten_block($key, \@seq);
4263 48         119 my $r = _final_break($parser, $key, '(return)');
4264 48 100       110 if (defined $r) {
4265 3         6 my $arg = $parser->{strmap}->{$r}->[1];
4266              
4267 3         6 my $r2 = pop(@seq); # remove return statement from block
4268 3 50       10 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       7 if (scalar @seq > 0) {
4272             # insert simplified block without return here
4273 1         6 my $b = $parser->setblk('flat', [@seq]);
4274 1         5 my $v = '$eval$'.$var;
4275 1         6 $ctx->track_assignment($v, $b); # track special $eval variable
4276 1 50       5 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns block %s [TRACK]", $cmd, $arglist->[0], $b) if $ctx->{log};
4277             } else {
4278 2 50       5 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) returns %s", $cmd, $arglist->[0], $r) if $ctx->{log};
4279             }
4280 3         23 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         126 my $resolved_eval = $ctx->can_inline_eval($key);
4287              
4288 45 50 33     144 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       135 if ($key ne '#null') {
4295 45         117 my $v = '$eval$x'.$var;
4296 45         176 $ctx->track_assignment($v, $key); # track special $eval variable
4297 45 50       111 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) track last %s", $cmd, $arglist->[0], $key) if $ctx->{log};
4298             #$key = $parser->setblk('flat', []);
4299 45         95 $key = '#null';
4300             }
4301 45         656 return $key;
4302             }
4303 8 50       26 if (exists $ctx->{simplify}{call}) {
4304 8 100       42 if ($args->[0] =~ /^#call\d+$/) {
4305             # call without eval can not generate 'return '
4306 3         11 my $name = $parser->{strmap}->{$args->[0]}->[0];
4307              
4308 3 100       12 if (!PHP::Decode::Func::func_may_return_string($name)) {
4309 1         5 my $v = '$eval$x'.$var;
4310 1         4 $ctx->track_assignment($v, $args->[0]); # track special $eval variable
4311 1 50       3 $ctx->{log}->($ctx, 'eval', $var, "%s(%s) track call $args->[0]", $cmd, $arglist->[0]) if $ctx->{log};
4312 1         8 return '#null';
4313             }
4314             }
4315             }
4316 7         20 $ctx->set_tainted($var); # eval() might always change variables
4317             } elsif (($cmd eq 'assert') && (scalar @$arglist == 1)) {
4318 4         12 my $val = $arglist->[0];
4319 4         10 my $key = $ctx->exec_statement($val);
4320              
4321 4 50       14 if (is_strval($key)) {
4322 4         19 my $e = $parser->setcall('eval', [$val]);
4323 4         13 $key = $ctx->exec_statement($e);
4324             }
4325 4         15 return $key;
4326             } else {
4327 468 100       1281 if ($cmd =~ /^\\(.*)$/) {
4328 1         3 $cmd = $1; # remove absolute namespace
4329             }
4330 468         1242 my $f = PHP::Decode::Func::get_php_func($cmd);
4331              
4332 468 100 100     1829 if (defined $f && exists $f->{param}) {
4333 24         87 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, $f->{param}, $in_block);
4334             } else {
4335 444         1210 ($args, $arg_changed) = $ctx->resolve_arglist($arglist, [], $in_block);
4336             }
4337 468         1589 my $key = PHP::Decode::Func::exec_cmd($ctx, $cmd, $args);
4338 468 100       980 if (defined $key) {
4339 187 50       499 $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       438 if ($key eq '#noreturn') {
4342 3         5 $key = $var;
4343 3 50 33     16 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         634 return $key;
4350             }
4351 281 100       540 if (defined $f) {
4352 55 100       158 if (exists $f->{param}) {
4353 2         9 $ctx->invalidate_arglist_refs($arglist, $f->{param}, $in_block);
4354             }
4355             } else {
4356 226         1155 $ctx->{warn}->($ctx, 'cmd', $var, "not found %s(%s)", $cmd, join(', ', @$arglist));
4357             }
4358 281 100       16565 if (PHP::Decode::Func::func_may_call_callbacks($cmd)) {
4359 229         748 $ctx->set_tainted($var);
4360             }
4361             }
4362             # simplify function params for failed call
4363             #
4364 288 50       849 if (exists $ctx->{simplify}{call}) {
4365 288 50       661 if (is_instvar($cmdsim)) {
4366 0         0 $cmdsim = $name;
4367             }
4368 288 100       970 my @argssim = map { ($args->[$_] =~ /^(#inst\d+)$/) ? $arglist->[$_] : $args->[$_] } 0..$#$args;
  161         854  
4369              
4370 288 100 100     1283 if (($name ne $cmdsim) || $arg_changed) {
4371 69         281 my $k = $parser->setcall($cmdsim, \@argssim);
4372 69         335 $ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s) -> %s %s", $cmd, join(', ', @$arglist), $k, $parser->stmt_str($k));
4373 69         4000 return $k;
4374             }
4375             }
4376 219         1095 $ctx->{warn}->($ctx, 'exec', $var, "skip %s(%s)", $cmd, join(', ', @$arglist));
4377 219         9956 return $var;
4378             } elsif ($var =~ /^#blk\d+$/) {
4379 1299         2194 my ($type, $arglist) = @{$parser->{strmap}->{$var}};
  1299         3723  
4380 1299         2473 my @args = ();
4381 1299         2478 my $changed = 0;
4382 1299         2425 foreach my $p (@$arglist) {
4383 2138         3469 my $keep_assign = 0;
4384              
4385 2138 100 100     7535 if (($type ne 'brace') && ($type ne 'expr')) {
4386 2018         4033 my ($rhs, $lhs) = _var_assignment($parser, $p);
4387 2018 100 100     5903 if (defined $rhs || _is_increment_op($parser, $p)) {
4388 810 50       1799 $ctx->{log}->($ctx, 'exec', $var, "keep assignment $p intact -> set in_block") if $ctx->{log};
4389 810         1376 $keep_assign = 1;
4390             }
4391             }
4392 2138 100       6440 my $v = $ctx->exec_statement($p, $keep_assign ? 1 : $in_block);
4393 2138 50       5017 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     6758 if (($type ne 'brace') && ($type ne 'expr')) {
4401 2018         4792 my $v1 = $ctx->insert_assignments($v);
4402 2018 100       4941 if ($v1 ne $v) {
4403 141 50       475 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         377 $parser->flatten_block($v1, \@args);
4409             }
4410 141         305 $changed = 1;
4411             } else {
4412 1877         5302 $parser->flatten_block($v, \@args);
4413             }
4414             } else {
4415 120         365 $parser->flatten_block($v, \@args);
4416             }
4417 2138 100       4618 if ($p ne $v) {
4418 1027         1616 $changed = 1;
4419             }
4420 2138         4173 my $f = _final_break($parser, $v, '(break|continue|return)');
4421 2138 100       5561 if (defined $f) {
4422 256 100       868 if (scalar @args < scalar @$arglist) {
4423 9         41 $changed = 1;
4424             }
4425 256         617 last;
4426             }
4427             }
4428             # evaluate block to string or anonymous func if possible
4429             #
4430 1299 100 100     4017 if (scalar @args == 1 && (is_strval($args[0]) || ($args[0] =~ /^#fun\d+$/))) {
      100        
4431 92 50       222 $ctx->{log}->($ctx, 'exec', $var, "reduce: $arglist->[0] -> $args[0]") if $ctx->{log};
4432 92         315 return $args[0];
4433             }
4434 1207 100       2669 if ($changed) {
4435 743         1887 $var = $parser->setblk($type, \@args);
4436             }
4437 1207         3468 return $var;
4438             } elsif ($var =~ /^#stmt\d+$/) {
4439 710         1942 my $cmd = $parser->{strmap}->{$var}->[0];
4440              
4441 710 100       4627 if ($cmd eq 'echo') {
    50          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
4442 184         358 my $arglist = $parser->{strmap}->{$var}->[1];
4443 184         344 my @param = ();
4444 184         259 my $all_str = 1;
4445 184         269 my $changed = 0;
4446              
4447 184         367 foreach my $p (@$arglist) {
4448 193 100 100     438 if (!is_strval($p) || is_const($p)) {
4449 107         301 my $v = $ctx->exec_statement($p);
4450 107         284 push(@param, $v);
4451 107 100       282 if ($v ne $p) {
4452 88         173 $changed = 1;
4453             }
4454 107 100       278 unless (is_strval($v)) {
4455 31         107 $all_str = 0;
4456             }
4457             } else {
4458 86         253 push(@param, $p);
4459             }
4460             }
4461             # keep consts in simplified statement
4462             #
4463 184 100 100     557 my @paramsim = map { (is_const($arglist->[$_]) && !$parser->is_magic_const($arglist->[$_]) && !exists $ctx->{defines}{$parser->{strmap}{$arglist->[$_]}}) ? $arglist->[$_] : $param[$_] } 0..$#param;
  193         514  
4464              
4465 184         501 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     732 if ($all_str && (scalar @param > 1)) {
4471 4         13 my $res = join('', map { $parser->{strmap}->{$_} } @param);
  12         33  
4472 4         17 my $k = $parser->setstr($res);
4473 4         16 @param = ($k);
4474 4         10 $changed = 1;
4475             }
4476 184 100       474 unless ($ctx->{skipundef}) {
4477 119 100 66     520 if (exists $ctx->{globals} && exists $ctx->{globals}{stdout}) {
4478 117 100       291 if (exists $ctx->{globals}{stdout}{ob}) {
4479 1         3 push(@{$ctx->{globals}{stdout}{ob}}, @param);
  1         5  
4480             } else {
4481 116         188 push(@{$ctx->{globals}{stdout}{buf}}, @param);
  116         330  
4482             }
4483             }
4484             }
4485 184 50       467 if (exists $ctx->{simplify}{stmt}) {
4486 184 100       444 if ($changed) {
4487 84 100       237 if (scalar @paramsim > 1) {
4488 5         19 merge_str_list(\@paramsim, $parser);
4489             }
4490 84         350 my $k = $parser->setstmt(['echo', \@paramsim]);
4491 84 50       224 $ctx->{log}->($ctx, 'echo', $var, "simplify -> $k") if $ctx->{log};
4492 84         271 return $k;
4493             }
4494             }
4495 100         317 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         28 my $arglist = $parser->{strmap}->{$var}->[1];
4519 10         29 my @param = ();
4520              
4521 10         21 foreach my $v (@$arglist) {
4522 10 50       27 if (is_variable($v)) {
4523 10 50       33 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         39 $ctx->{varmap}{global}{$v} = 1;
4527 10 50       38 $ctx->{log}->($ctx, 'global', $var, "set func var $v global") if $ctx->{log};
4528             }
4529             }
4530             }
4531 10         33 return $var;
4532             } elsif ($cmd eq 'static') {
4533 15         37 my $arglist = $parser->{strmap}->{$var}->[1];
4534 15         33 my @param = ();
4535              
4536 15         33 foreach my $v (@$arglist) {
4537 15 100       37 if (is_variable($v)) {
    50          
4538 10 50       43 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       42 if ($ctx->{infunction}) {
    50          
4542 3 100       16 unless (exists $ctx->{varmap}{static}{$ctx->{infunction}}{$v}) {
4543 1         5 $ctx->{varmap}{static}{$ctx->{infunction}}{$v} = undef;
4544 1 50       5 $ctx->{log}->($ctx, 'static', $var, "set static func var $v") if $ctx->{log};
4545             }
4546             } elsif (exists $ctx->{class_scope}) {
4547 7 50       32 unless (exists $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v}) {
4548 7         24 $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         32  
4557 5 50       20 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       16 if ($ctx->{infunction}) {
    50          
4562 3 100       15 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         8 $ctx->{varmap}{inst}{$ctx->{class_scope}}{$v1} = $v2;
4569 2 50       9 $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         45 return $var;
4583             } elsif ($cmd eq 'const') {
4584 9         29 my $arglist = $parser->{strmap}->{$var}->[1];
4585 9         19 my @param = ();
4586              
4587 9         20 foreach my $v (@$arglist) {
4588 9 50       33 if ($v =~ /^#expr\d+$/) {
4589 9         15 my ($op, $v1, $v2) = @{$parser->{strmap}->{$v}};
  9         46  
4590              
4591 9 50       24 if ($op eq '=') {
4592 9 50       26 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         24 my $name = $parser->{strmap}{$v1}; # consts are case-sensitive
4598 9         26 my $op2 = $ctx->exec_statement($v2, 1); # should be constant expression
4599              
4600 9 100       34 if (exists $ctx->{class_scope}) {
4601 4         34 $name = method_name($ctx->{class_scope}, $name);
4602             }
4603 9 100       25 if ($ctx->{namespace}) {
4604 4         17 $name = ns_name(lc($ctx->{namespace}), $name);
4605             }
4606 9         30 $ctx->{defines}{$name} = $op2;
4607 9 50       34 $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         25 return $var;
4617             } elsif ($cmd eq 'return') {
4618 254         580 my $arg = $parser->{strmap}->{$var}->[1];
4619 254         568 my $res = $ctx->exec_statement($arg);
4620 254 100 66     1036 if (defined $res && ($arg ne $res)) {
4621 107         484 my $k = $parser->setstmt(['return', $res]);
4622 107         314 return $k;
4623             }
4624 147         380 return $var;
4625             } elsif ($cmd eq 'unset') {
4626             # https://www.php.net/manual/en/function.unset.php
4627             #
4628 5         12 my $arglist = $parser->{strmap}->{$var}->[1];
4629 5         11 my @param = ();
4630 5         7 my $all_var = 1;
4631 5         7 my $changed = 0;
4632              
4633 5         11 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         4 $ctx->setvar($p, '#null', 1);
4641 1         4 push(@param, $p);
4642 1         4 next;
4643             } elsif ($p =~ /^(\#elem\d+)$/) {
4644             # todo: suppport multi dimensional
4645             #
4646 4         8 my ($v, $i) = @{$parser->{strmap}->{$p}};
  4         11  
4647 4         14 my ($basevar, $has_index, $idxstr) = $ctx->resolve_variable($p, 0);
4648 4 50       11 if (defined $basevar) {
4649 4 100       12 if ($has_index) {
4650 3         7 my $basestr = $ctx->exec_statement($basevar, 0);
4651 3 100 66     14 if (defined $basestr && is_array($basestr) && defined $idxstr) {
      66        
4652 2         4 my $arr = $parser->{strmap}->{$basestr};
4653 2 50       7 $idxstr = $parser->setstr('') if is_null($idxstr); # null maps to '' array index
4654 2         11 my $arrval = $arr->get($idxstr);
4655 2 50       6 if (defined $arrval) {
4656 2         6 my $idxval = $arr->get_index($idxstr);
4657 2 50       5 $ctx->{log}->($ctx, 'unset', $var, "unset elem $p: %s %s[%s]", $basevar, $basestr, $idxstr) if $ctx->{log};
4658 2         10 my $arr2 = $arr->copy();
4659 2         10 $arr2->delete($idxval);
4660 2         66 $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       5 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         5 $ctx->setvar($basevar, '#null', 1);
4672 1         2 push(@param, $basevar);
4673 1         13 $changed = 1;
4674 1         6 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         7 push(@param, $v);
4682 3 100       10 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       16 if (exists $ctx->{simplify}{stmt}) {
4691 5 100       13 if ($changed) {
4692 2         11 my $k = $parser->setstmt(['unset', \@param]);
4693 2 50       5 $ctx->{log}->($ctx, 'unset', $var, "simplify -> $k") if $ctx->{log};
4694 2         15 return $k;
4695             }
4696             }
4697 3         18 return $var;
4698             } elsif ($cmd eq 'break') {
4699 2         9 return $var;
4700             } elsif ($cmd eq 'continue') {
4701 0         0 return $var;
4702             } elsif ($cmd eq 'namespace') {
4703 10         22 my ($arg, $block) = @{$parser->{strmap}->{$var}}[1..2];
  10         25  
4704              
4705 10         20 $ctx->{namespace} = $arg; # always use case in-sensitive later
4706              
4707 10 100       22 if (defined $block) {
4708 2         8 my $block1 = $ctx->exec_statement($block);
4709 2 100       7 if ($block1 ne $block) {
4710 1         8 my $k = $parser->setstmt(['namespace', $arg, $block1]);
4711 1         3 return $k;
4712             }
4713             }
4714 9         23 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         336 my ($expr, $then, $else) = @{$parser->{strmap}->{$var}}[1..3];
  150         541  
4731              
4732 150         385 my $cond = $ctx->exec_statement($expr);
4733              
4734             # insert possible assignment from expr
4735             #
4736 150         465 my $fin = $ctx->insert_assignments(undef);
4737              
4738 150 0       442 $ctx->{log}->($ctx, 'if', $var, "expr %s -> %s", $expr, defined $cond ? $cond : '') if $ctx->{log};
    50          
4739 150 100 100     567 if (defined $cond && (is_strval($cond) || is_array($cond))) {
      66        
4740 48         104 my $res;
4741              
4742 48         124 my $val = $parser->{strmap}{$cond};
4743 48 100       124 if (is_array($cond)) {
4744 1         16 my $arr = $parser->{strmap}{$cond};
4745 1         8 $val = !$arr->empty();
4746             }
4747 48 100       136 if ($val) {
    100          
4748 25         70 $res = $ctx->exec_statement($then);
4749 25         109 $res = $parser->flatten_block_if_single($res);
4750             } elsif (defined $else) {
4751 11         31 $res = $ctx->exec_statement($else);
4752 11         38 $res = $parser->flatten_block_if_single($res);
4753             } else {
4754 12         47 $res = $parser->setblk('flat', []);
4755             }
4756              
4757             # convert std blocks to flat
4758             #
4759 48         109 my @seq = ();
4760 48 100       138 $parser->flatten_block($fin, \@seq) if defined $fin;
4761 48         158 $parser->flatten_block($res, \@seq);
4762 48 100       240 if (scalar @seq > 1) {
    100          
4763 4         15 $res = $parser->setblk('flat', [@seq]);
4764             } elsif (scalar @seq > 0) {
4765 32         65 $res = $seq[0];
4766             }
4767 48         154 return $res;
4768             }
4769              
4770             # simplify if
4771             #
4772             # invalidate undefined variables first to avoid '#null' compares
4773             #
4774 102         216 my $var0 = $var;
4775 102 100       289 if ($expr ne $cond) {
4776             # use cond with removed assignments
4777 44         212 $var0 = $parser->setstmt(['if', $cond, $then, $else]);
4778             }
4779 102         354 my $info = $ctx->get_unresolved_info($var, $var0);
4780 102         364 $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         324 my $ctx_t = $ctx->clone();
4786 102         202 my $ctx_e;
4787 102         314 my $then1 = $ctx_t->exec_statement($then);
4788 102         223 my $else1;
4789 102 100       289 if (defined $else) {
4790 14         76 $ctx_e = $ctx->clone();
4791 14         53 $else1 = $ctx_e->exec_statement($else);
4792             }
4793 102         430 $ctx->update_unresolved($ctx_t);
4794 102 100       236 if (defined $else) {
4795 14         43 $ctx->update_unresolved($ctx_e);
4796             }
4797 102 50       235 if (is_instvar($cond)) {
4798 0         0 $cond = $expr;
4799             }
4800 102 100 100     551 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     262 if (($then ne $then1) && !is_block($then1)) {
4805 2         13 $then1 = $parser->setblk('std', [$then1]);
4806             }
4807 72 50 100     251 if (defined $else && ($else ne $else1) && !is_block($else1)) {
      66        
4808 0         0 $else1 = $parser->setblk('std', [$else1]);
4809             }
4810 72         363 my $k = $parser->setstmt(['if', $cond, $then1, $else1]);
4811 72 50       232 $ctx->{log}->($ctx, 'if', $var, "simplify -> $k") if $ctx->{log};
4812 72         149 $var = $k;
4813             }
4814 102 100       228 if (defined $fin) {
4815 8         20 my @seq = ();
4816 8         28 $parser->flatten_block($fin, \@seq);
4817 8         14 push(@seq, $var);
4818 8 50       22 if (scalar @seq > 1) {
    0          
4819 8         26 $var = $parser->setblk('std', [@seq]);
4820             } elsif (scalar @seq > 0) {
4821 0         0 $var = $seq[0];
4822             }
4823             }
4824 102         1099 return $var;
4825             } elsif ($cmd eq 'while') {
4826 10         21 my ($expr, $block) = @{$parser->{strmap}->{$var}}[1..2];
  10         34  
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       45 unless (exists $ctx->{skip}{loop}) {
4833 10         42 my $orgloop = $parser->format_stmt($var);
4834 10         33 my $toploop = loop_start($parser);
4835 10         19 my $i = 0;
4836 10         18 my $res;
4837 10         16 my @seq = ();
4838              
4839 10         18 while (1) {
4840 18         48 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         29 my $val = $parser->{strmap}->{$cond};
4846 6 100       18 if (is_array($cond)) {
4847 1         4 my $arr = $parser->{strmap}{$cond};
4848 1         7 $val = !$arr->empty();
4849             }
4850 6 50       49 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       42 $ctx->{log}->($ctx, 'while', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
4857 18 100 100     40 if (is_strval($cond) || is_array($cond)) {
    50          
4858 14         29 my $val = $parser->{strmap}->{$cond};
4859 14 100       31 if (is_array($cond)) {
4860 2         5 my $arr = $parser->{strmap}{$cond};
4861 2         397 $val = !$arr->empty();
4862             }
4863 14 100       53 if (!$val) {
4864             # loop might never execute
4865 3 50       11 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         6 last;
4870             }
4871             } elsif ($i == 0) {
4872             # can't resolve expression - just return full while()-statement
4873 4         18 $ctx->{warn}->($ctx, 'while', $var, "initial bad cond %s -> %s", $expr, $cond);
4874 4         186 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         26 $res = $ctx->exec_statement($block);
4883 11 50       29 unless (defined $res) {
4884 0         0 last;
4885             }
4886 11         48 my $info = {vars => {}, calls => {}, stmts => {}};
4887 11         45 $parser->stmt_info($res, $info);
4888 11         321 my $r = _final_break($parser, $res, '(break)');
4889 11         29 my $u = $ctx->unresolvable_var($info);
4890 11         26 my $f = _skipped_call($parser, $res, '(.*)', $info);
4891 11 50 33     52 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         110 $res = undef;
4894 2         12 last;
4895             }
4896 9 50       23 $ctx->{log}->($ctx, 'while', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log};
4897 9 100       21 if (defined $r) {
4898 1 50       10 $ctx->{log}->($ctx, 'while', $var, "%d: block break: %s", $i, $res) if $ctx->{log};
4899 1         5 last;
4900             }
4901 8         23 my $fin = $ctx->insert_assignments(undef);
4902              
4903 8         19 my @list = ();
4904 8 50       19 if (defined $fin) {
4905 0         0 $parser->flatten_block($fin, \@list);
4906             }
4907 8         29 $parser->flatten_block($res, \@list);
4908 8         30 $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     21 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     23 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         33 $i++;
4924             }
4925 10         35 loop_end($parser, $toploop, $i);
4926              
4927 10 100       32 if (defined $res) {
4928             # insert final loop var value
4929             #
4930 4         15 my $fin = $ctx->insert_assignments(undef);
4931 4 100       15 if (defined $fin) {
4932 1         4 my @list = ();
4933 1         4 $parser->flatten_block($fin, \@list);
4934 1         8 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
4935             }
4936 4 100       17 if (scalar @seq > 1) {
    50          
4937 2         15 $res = $parser->setblk('std', [@seq]);
4938             } elsif (scalar @seq > 0) {
4939 2         5 $res = $seq[0];
4940             }
4941 4 50       15 $ctx->{log}->($ctx, 'while', $var, "optimized '%s' -> $res '%s'", $orgloop, $parser->format_stmt($res)) if $ctx->{log};
4942 4         15 return $res;
4943             }
4944             }
4945              
4946 6 50       20 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         17 my $info = $ctx->get_unresolved_info($var, $var);
4955 6         22 $ctx->invalidate_vars($info, 'while', $var);
4956 6         24 $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         18 my $ctx_e = $ctx->clone();
4962 6         24 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
4963 6         23 $ctx->update_unresolved($ctx_e);
4964              
4965 6         19 my $ctx_b = $ctx->clone();
4966 6         20 my $block0 = $ctx_b->exec_statement($block);
4967 6         21 $ctx->update_unresolved($ctx_b);
4968              
4969 6 50       16 if (is_instvar($expr0)) {
4970 0         0 $expr0 = $expr;
4971             }
4972 6 50 33     84 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         22 return $var;
4978             } elsif ($cmd eq 'do') {
4979 7         21 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         25 my $orgloop = $parser->format_stmt($var);
4985 7         14 my @seq = ();
4986              
4987 7         24 my $res = $ctx->exec_statement($block);
4988 7 50       25 if (defined $res) {
4989 7         15 my @list = ();
4990 7         22 $parser->flatten_block($res, \@list);
4991 7         42 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
4992             }
4993 7 50       31 unless (exists $ctx->{skip}{loop}) {
4994 7         13 my $i = 0;
4995 7         21 my $toploop = loop_start($parser);
4996              
4997 7         21 while (defined $res) {
4998 11         29 my $cond = $ctx->exec_statement($expr);
4999              
5000 11 50       35 $ctx->{log}->($ctx, 'do', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
5001 11 100 66     28 if (is_strval($cond) || is_array($cond)) {
    50          
5002 10         24 my $val = $parser->{strmap}{$cond};
5003 10 50       24 if (is_array($cond)) {
5004 0         0 my $arr = $parser->{strmap}{$cond};
5005 0         0 $val = !$arr->empty();
5006             }
5007 10 100       27 if (!$val) {
5008 6         15 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         11 $res = $ctx->exec_statement($block);
5022 4 50       14 unless (defined $res) {
5023 0         0 last;
5024             }
5025 4         15 my $info = {vars => {}, calls => {}, stmts => {}};
5026 4         16 $parser->stmt_info($res, $info);
5027 4         12 my $r = _final_break($parser, $res, '(break)');
5028 4         13 my $u = $ctx->unresolvable_var($info);
5029 4         12 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       10 $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         11 my $fin = $ctx->insert_assignments(undef);
5041              
5042 4         9 my @list = ();
5043 4 50       9 if (defined $fin) {
5044 0         0 $parser->flatten_block($fin, \@list);
5045             }
5046 4         14 $parser->flatten_block($res, \@list);
5047 4         15 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5048              
5049 4 50       13 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     11 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     22 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         21 $i++;
5063             }
5064 7         22 loop_end($parser, $toploop, $i);
5065             }
5066 7 100       20 if (defined $res) {
5067             # insert final loop var value
5068             #
5069 6         21 my $fin = $ctx->insert_assignments(undef);
5070 6 100       26 if (defined $fin) {
5071 1         2 my @list = ();
5072 1         5 $parser->flatten_block($fin, \@list);
5073 1         5 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5074             }
5075 6 100       21 if (scalar @seq > 1) {
    50          
5076 2         9 $res = $parser->setblk('std', [@seq]);
5077             } elsif (scalar @seq > 0) {
5078 4         10 $res = $seq[0];
5079             }
5080 6 50       19 $ctx->{log}->($ctx, 'do', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5081 6         20 return $res;
5082             }
5083              
5084 1 50       5 if (exists $ctx->{simplify}{stmt}) {
5085 1 50       5 $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         5 my $block0 = $ctx_b->exec_statement($block);
5101 1         9 $ctx->update_unresolved($ctx_b);
5102              
5103 1         7 my $ctx_e = $ctx->clone();
5104 1         8 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
5105 1         6 $ctx->update_unresolved($ctx_e);
5106              
5107 1 50       14 if (is_instvar($expr0)) {
5108 0         0 $expr0 = $expr;
5109             }
5110 1 50 33     18 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         6 return $var;
5116             } elsif ($cmd eq 'for') {
5117 23         47 my ($pre, $expr, $post, $block) = @{$parser->{strmap}->{$var}}[1..4];
  23         126  
5118              
5119             # - pre is executed just once at the start of foreach
5120             # - expr & post are recalculated on each loop
5121             #
5122 23         66 my $pre0 = $ctx->exec_statement($pre, 1);
5123              
5124 23 50       75 unless (exists $ctx->{skip}{loop}) {
5125 23         79 my $orgloop = $parser->format_stmt($var);
5126 23         86 my $toploop = loop_start($parser);
5127 23         37 my $i = 0;
5128 23         39 my $res;
5129 23         47 my @seq = ();
5130              
5131             # add initial variable assignments to result list
5132             #
5133 23         40 my @list = ();
5134 23         94 $parser->flatten_block($pre0, \@list);
5135 23         105 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5136              
5137 23         37 while (1) {
5138 53         140 my $cond = $ctx->exec_statement($expr);
5139              
5140 53 50       118 $ctx->{log}->($ctx, 'for', $var, "%d: cond result: %s -> %s", $i, $expr, $cond) if $ctx->{log};
5141 53 100       203 if ($parser->is_empty_block($cond)) {
5142 2         6 $cond = '#null'; # null statements are eliminated in block execution
5143             }
5144 53 100 66     113 if (is_strval($cond) || is_array($cond)) {
    50          
5145 48         105 my $val = $parser->{strmap}{$cond};
5146 48 50       107 if (is_array($cond)) {
5147 0         0 my $arr = $parser->{strmap}{$cond};
5148 0         0 $val = !$arr->empty();
5149             }
5150 48 100       127 if (!$val) {
5151             # loop might never execute
5152 15 100       53 unless (defined $res) {
5153 3 50       11 $ctx->{log}->($ctx, 'for', $var, "%d: block $block never executed", $i) if $ctx->{log};
5154 3         12 $res = $parser->setblk('flat', []);
5155             }
5156 15         30 last;
5157             }
5158             } elsif ($i == 0) {
5159             # can't resolve expression - just return full for()-statement
5160 5         12 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         87 $res = $ctx->exec_statement($block);
5168 33 50       82 unless (defined $res) {
5169 0         0 last;
5170             }
5171 33         125 my $info = {vars => {}, calls => {}, stmts => {}};
5172 33         116 $parser->stmt_info($res, $info);
5173 33         88 my $r = _final_break($parser, $res, '(break)');
5174 33         101 my $u = $ctx->unresolvable_var($info);
5175 33         74 my $f = _skipped_call($parser, $res, '(.*)', $info);
5176 33 50 0     153 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      33        
      66        
5177 3 50       23 $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         232 $res = undef;
5179 3         18 last;
5180             }
5181 30 50       78 $ctx->{log}->($ctx, 'for', $var, "%d: block result: %s -> %s", $i, $block, $res) if $ctx->{log};
5182 30 50       65 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         75 my $fin = $ctx->insert_assignments(undef);
5189              
5190 30         66 my @list = ();
5191 30 50       56 if (defined $fin) {
5192 0         0 $parser->flatten_block($fin, \@list);
5193             }
5194 30         111 $parser->flatten_block($res, \@list);
5195 30         117 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5196              
5197 30         87 my $post0 = $ctx->exec_statement($post);
5198 30 50       95 $ctx->{log}->($ctx, 'for', $var, "%d: post result: %s -> %s", $i, $post, $post0) if $ctx->{log};
5199              
5200 30 50       80 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     74 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         121 $i++;
5209             }
5210 23         83 loop_end($parser, $toploop, $i);
5211              
5212 23 100       61 if (defined $res) {
5213             # insert final loop var value
5214             #
5215 15         51 my $fin = $ctx->insert_assignments(undef);
5216 15 100       54 if (defined $fin) {
5217 14         30 my @list = ();
5218 14         45 $parser->flatten_block($fin, \@list);
5219 14         57 $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       57 if (scalar @seq > 1) {
    50          
5224 14         54 $res = $parser->setblk('std', [@seq]);
5225             } elsif (scalar @seq > 0) {
5226 1         3 $res = $seq[0];
5227             }
5228 15 50       39 $ctx->{log}->($ctx, 'for', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5229 15         57 return $res;
5230             }
5231             }
5232              
5233 8 50       37 if (exists $ctx->{simplify}{stmt}) {
5234 8 50       23 $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         21 my $var0 = $var;
5243 8 50       24 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         36 $ctx->invalidate_vars($info, 'for', $var);
5248 8         34 $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         29 my $ctx_e = $ctx->clone();
5254 8         37 my $expr0 = $ctx_e->exec_statement($expr, 1); # keep assignments inline
5255 8         45 $ctx->update_unresolved($ctx_e);
5256              
5257 8         27 my $ctx_b = $ctx->clone();
5258 8         44 my $block0 = $ctx_b->exec_statement($block);
5259 8         35 $ctx->update_unresolved($ctx_b);
5260              
5261 8         30 my $ctx_p = $ctx->clone();
5262 8         37 my $post0 = $ctx_p->exec_statement($post, 1); # keep assignments inline
5263 8         35 $ctx->update_unresolved($ctx_p);
5264              
5265 8 50       22 if (is_instvar($expr0)) {
5266 0         0 $expr0 = $expr;
5267             }
5268 8 100 33     155 if (($pre ne $pre0) || ($expr ne $expr0) || ($post ne $post0) || ($block ne $block0)) {
      33        
      66        
5269 1         7 my $k = $parser->setstmt(['for', $pre0, $expr0, $post0, $block0]);
5270 1         15 return $k;
5271             }
5272             }
5273 7         26 return $var;
5274             } elsif ($cmd eq 'foreach') {
5275 19         36 my ($expr, $key, $value, $block) = @{$parser->{strmap}->{$var}}[1..4];
  19         71  
5276 19         33 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         84 my $expr0 = $ctx->exec_statement($expr);
5284              
5285 19 100       52 if (defined $key) {
5286 13         54 my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block);
5287 13 50       39 $keyvar = defined $_basevar2 ? $_basevar2 : $key;
5288             }
5289 19         49 my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block);
5290 19 50       45 $valvar = defined $_basevar ? $_basevar : $value;
5291              
5292             # loop should be unrolled only after variables are available
5293 19 50       52 unless (exists $ctx->{skip}{loop}) {
5294 19         65 my $orgloop = $parser->format_stmt($var);
5295 19         67 my $toploop = loop_start($parser);
5296 19         48 my $i = 0;
5297 19         27 my $res;
5298 19         46 my @seq = ();
5299              
5300 19 100       52 if (is_array($expr0)) {
5301             #my ($a2, $array2) = $parser->copyarr($expr0); # copy if value not reference
5302             #$expr0 = $a2;
5303 11         25 my $arr = $parser->{strmap}{$expr0};
5304 11         32 my $keys = $arr->get_keys();
5305              
5306             # loop might never execute
5307 11 50 33     47 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         23 foreach my $k (@$keys) {
5312 23 50 66     112 if (defined $key && defined $keyvar && is_variable($keyvar)) {
      66        
5313 17 50       47 if (is_int_index($k)) {
5314 17         46 my $kstr = $parser->setnum($k);
5315 17         122 $ctx->{varmap}{$keyvar} = $kstr;
5316             } else {
5317 0         0 $ctx->{varmap}{$keyvar} = $k;
5318             }
5319             }
5320 23 50 33     78 if (defined $valvar && is_variable($valvar)) {
5321 23         62 my $arrval = $arr->val($k);
5322 23         58 $ctx->{varmap}{$valvar} = $arrval;
5323             }
5324 23         68 $res = $ctx->exec_statement($block);
5325 23 50       59 unless (defined $res) {
5326 0         0 last;
5327             }
5328 23         108 my $info = {vars => {}, calls => {}, stmts => {}};
5329 23         92 $parser->stmt_info($res, $info);
5330 23         51 my $r = _final_break($parser, $res, '(break)');
5331 23         72 my $u = $ctx->unresolvable_var($info);
5332 23         62 my $f = _skipped_call($parser, $res, '(.*)', $info);
5333 23 50 33     98 if (defined $u || (defined $f && (!defined $r || ($f ne $r)))) {
      66        
      66        
5334 2 50       16 $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         96 $res = undef;
5336 2         15 last;
5337             }
5338 21 50       45 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         50 my $fin = $ctx->insert_assignments(undef);
5343              
5344 21         54 my @list = ();
5345 21 50       49 if (defined $fin) {
5346 0         0 $parser->flatten_block($fin, \@list);
5347             }
5348 21         112 $parser->flatten_block($res, \@list);
5349 21         76 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5350              
5351             # recalculate key & value on each loop
5352             #
5353 21 100 66     108 if (defined $key && defined $keyvar && ($keyvar ne $key)) {
      100        
5354 9         28 my ($_basevar2, $_has_index2, $_idxstr2) = $ctx->resolve_variable($key, $in_block);
5355 9 50       26 $keyvar = defined $_basevar2 ? $_basevar2 : $key;
5356             }
5357 21 100 66     76 if (defined $valvar && ($valvar ne $value)) {
5358 11         25 my ($_basevar, $_has_index, $_idxstr) = $ctx->resolve_variable($value, $in_block);
5359 11 50       46 $valvar = defined $_basevar ? $_basevar : $value;
5360             }
5361 21         100 $i++;
5362             }
5363             } else {
5364 8 50       25 $ctx->{log}->($ctx, 'foreach', $var, "can't handle expr: %s (%s)", $expr, $expr0) if $ctx->{log};
5365             }
5366 19         56 loop_end($parser, $toploop, $i);
5367              
5368 19 100       49 if (defined $res) {
5369             # insert final loop var value
5370             #
5371 9         24 my $fin = $ctx->insert_assignments(undef);
5372 9 50       22 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       34 if (scalar @seq > 1) {
    50          
5380 6         21 $res = $parser->setblk('std', [@seq]);
5381             } elsif (scalar @seq > 0) {
5382 3         8 $res = $seq[0];
5383             }
5384 9 50       21 $ctx->{log}->($ctx, 'foreach', $var, "optimized '%s' -> %s '%s'", $orgloop, $res, $parser->format_stmt($res)) if $ctx->{log};
5385 9         29 return $res;
5386             }
5387             }
5388              
5389 10 50       34 if (exists $ctx->{simplify}{stmt}) {
5390 10 50       25 $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         17 my $var0 = $var;
5399 10 100       30 if ($expr ne $expr0) {
5400             # use expr with removed assignments
5401 4         21 $var0 = $parser->setstmt(['foreach', $expr0, $key, $value, $block]);
5402             }
5403 10         31 my $info = $ctx->get_unresolved_info($var, $var0);
5404 10         45 $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         29 my $ctx_b = $ctx->clone();
5410 10         34 my $block0 = $ctx_b->exec_statement($block);
5411 10         32 $ctx->update_unresolved($ctx_b);
5412              
5413 10 50 100     97 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         34 my $k = $parser->setstmt(['foreach', $expr0, $keyvar, $valvar, $block0]);
5417 8 50       34 $ctx->{log}->($ctx, 'foreach', $var, "simplify -> $k") if $ctx->{log};
5418 8         91 return $k;
5419             }
5420             }
5421 2         11 return $var;
5422             } elsif ($cmd eq 'switch') {
5423 9         20 my ($expr, $cases) = @{$parser->{strmap}->{$var}}[1..2];
  9         35  
5424 9         28 my $op1 = $ctx->exec_statement($expr);
5425              
5426             # insert possible assignment from expr
5427             #
5428 9         26 my $fin = $ctx->insert_assignments(undef);
5429              
5430 9 100       27 if (is_strval($op1)) {
5431 3         5 my $found;
5432 3         7 my @seq = ();
5433              
5434 3 50       8 $parser->flatten_block($fin, \@seq) if defined $fin;
5435 3         6 $fin = undef;
5436              
5437 3         11 for (my $i=0; $i < scalar @$cases; $i++) {
5438 5         9 my $e = $cases->[$i];
5439 5         9 my $c = $e->[0];
5440 5 50       11 if (defined $c) {
5441 5         13 my $op2 = $ctx->exec_statement($c);
5442 5 50       11 if (is_strval($op2)) {
5443 5         24 my ($val, $result) = PHP::Decode::Op::binary($parser, $op1, '==', $op2);
5444 5 100 66     25 if (defined $result && $result) {
5445 3         4 $found = $i;
5446 3         17 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     14 if (defined $found && ($found >= 0)) {
5468 3         18 for (my $i=$found; $i < scalar @$cases; $i++) {
5469 4         8 my $e = $cases->[$i];
5470 4         6 my $b = $e->[1];
5471 4         10 my $res = $ctx->exec_statement($b);
5472 4 50       20 unless (defined $res) {
5473 0         0 last;
5474             }
5475 4         7 my @list = ();
5476 4         10 my $f = _final_break($parser, $res, '(break|continue|return)');
5477 4 100       20 if (defined $f) {
5478 1         4 $res = _remove_final_statement($parser, '(break|continue)', $res);
5479             }
5480 4         16 $parser->flatten_block($res, \@list);
5481 4         17 $ctx->optimize_loop_var_list($cmd, $var, \@seq, \@list);
5482 4 100       14 if (defined $f) {
5483 1         4 last;
5484             }
5485             }
5486             # convert std blocks to flat
5487             #
5488 3         6 my $res;
5489 3 50       11 if (scalar @seq > 1) {
    50          
5490 0         0 $res = $parser->setblk('flat', [@seq]);
5491             } elsif (scalar @seq > 0) {
5492 3         6 $res = $seq[0];
5493             } else {
5494 0         0 $res = $parser->setblk('flat', []);
5495             }
5496 3         9 return $res;
5497             }
5498             }
5499              
5500 6 50       20 if (exists $ctx->{simplify}{stmt}) {
5501 6 50       29 $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         18 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         21 my $info = $ctx->get_unresolved_info($var, $var0);
5513             #$ctx->invalidate_undefined_vars($info, 'switch', $var);
5514 6         27 $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         14 my @cnew = ();
5520 6         9 my @cctx = ();
5521 6         13 my $changed = 0;
5522 6         22 for (my $i=0; $i < scalar @$cases; $i++) {
5523 8         20 my $e = $cases->[$i];
5524 8         15 my $c = $e->[0];
5525 8         14 my $b = $e->[1];
5526 8         17 my $c0 = $c;
5527              
5528 8         25 $cctx[$i] = $ctx->clone();
5529 8 50       24 if (defined $c) {
5530 8         27 $c0 = $cctx[$i]->exec_statement($c);
5531             }
5532 8         31 my $b0 = $cctx[$i]->exec_statement($b);
5533              
5534 8 100 66     48 if ((defined $c0 && ($c0 ne $c)) || ($b0 ne $b)) {
      66        
5535 2         4 $changed = 1;
5536             }
5537 8         37 push (@cnew, [$c0, $b0]);
5538             }
5539 6         23 for (my $i=0; $i < scalar @$cases; $i++) {
5540 8         37 $ctx->update_unresolved($cctx[$i]);
5541             }
5542              
5543 6 100 66     31 if (($expr ne $op1) || $changed) {
5544 2         9 my $k = $parser->setstmt(['switch', $op1, \@cnew]);
5545 2 50       9 $ctx->{log}->($ctx, 'switch', $var, "simplify -> $k") if $ctx->{log};
5546 2         4 $var = $k;
5547 2         20 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         13 return $var;
5561             }
5562             } elsif ($var =~ /^#fun\d+$/) {
5563 242         445 my ($f, $a, $b, $p) = @{$parser->{strmap}->{$var}};
  242         732  
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       843 my $name = defined $f ? (exists $ctx->{class_scope} ? method_name($ctx->{class_scope}, lc($f)) : lc($f)) : '{closure}';
    100          
5570 242         670 my $ctx2 = $ctx->simplification_ctx(infunction => $name);
5571              
5572             # invalidate function params for simplification
5573             #
5574 242 100       809 if (scalar @$a > 0) {
5575 106         316 foreach my $v (@$a) {
5576 111 100       373 if (is_variable($v)) {
    100          
    50          
5577 107         408 $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     15 if (($op eq '=') && is_variable($v1)) {
5581 2         5 $ctx2->setvar($v1, "#unresolved", 0);
5582             }
5583             } elsif ($v =~ /^#ref\d+$/) {
5584 2         7 my $r = $parser->{strmap}->{$v}->[0];
5585 2 50       8 if (is_variable($r)) {
5586 2         15 $ctx2->setvar($r, "#unresolved", 0);
5587             }
5588             }
5589             }
5590             }
5591 242         650 my $b2 = $ctx2->exec_statement($b);
5592              
5593 242 100       640 if (!is_block($b2)) {
5594 2         10 $b2 = $parser->setblk('std', [$b2]);
5595             }
5596              
5597             # copy static function variables into live context
5598             #
5599 242         423 foreach my $sf (keys %{$ctx2->{varmap}{static}}) {
  242         928  
5600 169         286 foreach my $sv (keys %{$ctx2->{varmap}{static}{$sf}}) {
  169         674  
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       671 if ($b2 ne $b) {
5606 70         234 my $k = $parser->setfun($f, $a, $b2, $p);
5607 70 100       203 if (defined $f) {
5608 69         177 $ctx->registerfun($f, $k);
5609             }
5610 70         555 return $k;
5611             }
5612 172 100 100     892 if (defined $f && !$ctx->getfun($f)) {
5613             # allow local functions also for block simplify
5614             #
5615 18 50       60 $ctx->{log}->($ctx, 'exec', $var, "register local func $var [$f]") if $ctx->{log};
5616 18         47 $ctx->registerfun($f, $var);
5617             }
5618             } elsif ($var =~ /^#class\d+$/) {
5619 56         99 my ($c, $b, $p) = @{$parser->{strmap}->{$var}};
  56         156  
5620 56         86 my ($type, $arglist) = @{$parser->{strmap}->{$b}};
  56         123  
5621 56 50       132 my $name = defined $c ? $c : 'class@anonymous';
5622              
5623 56         169 $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         115 my @args = ();
5629 56         83 my $changed = 0;
5630 56         113 foreach my $a (@$arglist) {
5631 94 100       341 if ($a =~ /^#fun\d+$/) {
    100          
    100          
5632             # function bodies are replaced inplace
5633 47         176 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5634 47         190 my $f = $ctx2->exec_statement($a, 1);
5635 47         113 push(@args, $f);
5636 47 100       212 if ($f ne $a) {
5637 16         84 $changed = 1;
5638             }
5639             } elsif (($a =~ /^#expr\d+$/)) {
5640 9         21 my ($op, $o1, $o2) = @{$parser->{strmap}->{$a}};
  9         34  
5641 9         40 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5642 9 50       39 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         32 my $cmd = $parser->{strmap}->{$a}->[0];
5648 13         74 my $ctx2 = $ctx->subscope_ctx(varmap => {}, class_scope => lc($name), infunction => 0);
5649 13 100       63 if ($cmd eq 'static') {
    50          
5650 9         34 my $k = $ctx2->exec_statement($a, 1);
5651 9         55 push(@args, $k);
5652             } elsif ($cmd eq 'const') {
5653 4         31 my $k = $ctx2->exec_statement($a, 1);
5654 4         28 push(@args, $k);
5655             }
5656             } else {
5657 25         49 push(@args, $a);
5658             }
5659             }
5660 56 100       137 if ($changed) {
5661 13         43 my $b2 = $parser->setblk('std', \@args);
5662 13         49 my $k = $parser->setclass($c, $b2, $p);
5663 13         44 $ctx->registerclass($c, $k);
5664 13         38 return $k;
5665             }
5666 43 100 66     167 if (defined $c && !$ctx->getclass($c)) {
5667 2 50       8 $ctx->{log}->($ctx, 'exec', $var, "register local class $var [$c]") if $ctx->{log};
5668 2         10 $ctx->registerclass($c, $var);
5669             }
5670             } else {
5671 1         18 $ctx->{warn}->($ctx, 'exec', $var, "skip");
5672             }
5673 219         610 return $var;
5674             }
5675              
5676             # track variable assignments in expressions (optionally reinsert them later)
5677             #
5678             sub track_assignment {
5679 456     456 0 989 my ($ctx, $var, $val) = @_;
5680              
5681 456         1543 $ctx->{varhist}{$var} = [$val, $histidx++];
5682 456         854 return;
5683             }
5684              
5685             sub discard_pending_assignments {
5686 17     17 0 42 my ($ctx) = @_;
5687 17         58 $ctx->{varhist} = {};
5688 17         31 return;
5689             }
5690              
5691             sub have_assignments {
5692 2     2 0 6 my ($ctx) = @_;
5693              
5694 2 50       5 if (scalar keys %{$ctx->{varhist}} > 0) {
  2         10  
5695 0         0 return 1;
5696             }
5697 2         6 return 0;
5698             }
5699              
5700             sub insert_assignments {
5701 3058     3058 0 5342 my ($ctx, $stmt) = @_;
5702 3058         5047 my $parser = $ctx->{parser};
5703              
5704 3058 100       4340 if (scalar keys %{$ctx->{varhist}} > 0) {
  3058         9041  
5705             # add assignments in exec-order
5706             #
5707 395         769 my @blk = ();
5708 395         619 my @ass = ();
5709 395         647 foreach my $v (sort { $ctx->{varhist}{$a}->[1] <=> $ctx->{varhist}{$b}->[1] } keys %{$ctx->{varhist}}) {
  24         122  
  395         1442  
5710 417 0       1411 $ctx->{log}->($ctx, 'assign', defined $stmt ? $stmt : '[]', "$v = $ctx->{varhist}{$v}->[0]") if $ctx->{log};
    50          
5711              
5712 417 100       1163 if ($ctx->{varhist}{$v}->[0] ne '#unresolved') {
5713 305         503 my $e;
5714 305 100       1119 if ($v =~ /^\$eval\$/) {
5715             # eval blocks are inserted at front before assignments
5716             #
5717 218         469 $e = $ctx->{varhist}{$v}->[0]; # eval block
5718 218 100       595 if (is_block($e)) {
5719 157         540 $parser->flatten_block($e, \@blk);
5720             } else {
5721 61         174 push(@blk, $e);
5722             }
5723             } else {
5724             # assignments are inserted at front
5725             #
5726 87         295 $e = $parser->setexpr('=', $v, $ctx->{varhist}{$v}->[0]);
5727 87         243 push(@ass, $e);
5728             }
5729             }
5730             }
5731 395 100 100     1683 if ((scalar @ass > 0) || (scalar @blk > 0)) {
5732 193 100       505 if (defined $stmt) {
5733 165         470 $parser->flatten_block($stmt, \@ass);
5734             }
5735 193         782 $stmt = $parser->setblk('flat', [@blk, @ass]);
5736             }
5737             }
5738 3058         7931 $ctx->{varhist} = {};
5739 3058         5882 return $stmt;
5740             }
5741              
5742             1;
5743              
5744             __END__