[v2] malloc: Replace shell/Perl gate in mtrace

  The previous version expanded $0 and $@ twice.

The new version defines a q no-op shell command.  The Perl syntax
error is masked by the eval Perl function.  The q { … } construct
is executed by the shell without errors because the q shell function
was defined, but treated as a non-expanding quoted string by Perl,
effectively hiding its context from the Perl interpreter.  As before
the script is read by require instead of executed directly, to avoid
infinite recursion because the #! line contains /bin/sh.

Introduce the “fatal” function to produce diagnostics that are not
suppressed by “do”.  Use “do” instead of “require” because it has
fewer requirements on the executed script that “require”.

Add the s,,, construct to prefix relative paths with './'
because “do” (and “require“ before that) searches for the script
in @INC if the path is relative and does not start with './'.
Use $_ to make the trampoline shorter.

---
v2: Add ./ to relative paths, some other cleanups.
 malloc/mtrace.pl | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)


base-commit: 71dafdf5f19dd2b0729e4774149944911a405bc6
  

On Jun 20 2024, Florian Weimer wrote:

> +    exec perl -e '$_ = shift; s,([^/]),./\1,; do $_' "$0" "$@"

Perhaps: s:^:./: unless m:^/:

Also, it would be nice to tell the editors that this is perl script
despite the /bin/sh shebang.
  

On 6/20/24 7:20 AM, Florian Weimer wrote:
> The previous version expanded $0 and $@ twice.
> 
> The new version defines a q no-op shell command.  The Perl syntax
> error is masked by the eval Perl function.  The q { … } construct
> is executed by the shell without errors because the q shell function
> was defined, but treated as a non-expanding quoted string by Perl,
> effectively hiding its context from the Perl interpreter.  As before
> the script is read by require instead of executed directly, to avoid
> infinite recursion because the #! line contains /bin/sh.
> 
> Introduce the “fatal” function to produce diagnostics that are not
> suppressed by “do”.  Use “do” instead of “require” because it has
> fewer requirements on the executed script that “require”.
> 
> Add the s,,, construct to prefix relative paths with './'
> because “do” (and “require“ before that) searches for the script
> in @INC if the path is relative and does not start with './'.
> Use $_ to make the trampoline shorter.

The error message is a little bit odd with the injected "./" appearing
in the progname, but OK, if we can improve it that would be better.

Test for no arguments:
$ /usr/bin/mtrace
Wrong number of arguments, run /./usr/bin/mtrace --help for help.

Test for quoting of spaces in error:
$ /usr/bin/mtrace "/home/carlos odonell/elf/tst-leaks1.mtrace"
/./usr/bin/mtrace: Cannot open mtrace data file /home/carlos odonell/elf/tst-leaks1.mtrace: No such file or directory

Test for relative path:
$ /usr/bin/mtrace elf/tst-leaks1.mtrace 
- 0x0000555555ea6300 Free 2 was never alloc'd 0x85eac
- 0x0000555555ea62a0 Free 43 was never alloc'd 0x864b2
No memory leaks.

Test for relative path with spaces and quoting:
$ /usr/bin/mtrace "elf/tst space leaks1.mtrace"
- 0x0000555555ea6300 Free 2 was never alloc'd 0x85eac
- 0x0000555555ea62a0 Free 43 was never alloc'd 0x864b2
No memory leaks.

Tested-by: Carlos O'Donell <carlos@redhat.com>
Reviewed-by: Carlos O'Donell <carlos@redhat.com>

> ---
> v2: Add ./ to relative paths, some other cleanups.
>  malloc/mtrace.pl | 20 ++++++++++++++++----
>  1 file changed, 16 insertions(+), 4 deletions(-)
> 
> diff --git a/malloc/mtrace.pl b/malloc/mtrace.pl
> index dc6085820e..ba14be6cae 100644
> --- a/malloc/mtrace.pl
> +++ b/malloc/mtrace.pl
> @@ -1,6 +1,11 @@
>  #! /bin/sh
> -eval exec "perl -e 'shift; \$progname=shift; shift; require \$progname'" . "$0" . "$@"
> -   if 0;
> +eval "q () {
> +  :
> +}";
> +q {
> +    exec perl -e '$_ = shift; s,([^/]),./\1,; do $_' "$0" "$@"
> +}
> +;
>  # Copyright (C) 1997-2024 Free Software Foundation, Inc.
>  # This file is part of the GNU C Library.
>  # Based on the mtrace.awk script.
> @@ -22,6 +27,7 @@ eval exec "perl -e 'shift; \$progname=shift; shift; require \$progname'" . "$0"
>  $VERSION = "@VERSION@";
>  $PKGVERSION = "@PKGVERSION@";
>  $REPORT_BUGS_TO = '@REPORT_BUGS_TO@';
> +$progname = $_;
>  
>  sub usage {
>      print "Usage: mtrace [OPTION]... [Binary] MtraceData\n";
> @@ -33,6 +39,11 @@ sub usage {
>      exit 0;
>  }
>  
> +sub fatal {
> +    print STDERR "$_[0]\n";
> +    exit 1;
> +}
> +
>  # We expect two arguments:
>  #   #1: the complete path to the binary
>  #   #2: the mtrace data filename
> @@ -86,7 +97,7 @@ if ($#ARGV == 0) {
>  	close (LOCS);
>      }
>  } else {
> -    die "Wrong number of arguments, run $progname --help for help.";
> +    fatal "Wrong number of arguments, run $progname --help for help.";
>  }
>  
>  sub addr2line {
> @@ -148,7 +159,8 @@ sub location {
>  }
>  
>  $nr=0;
> -open(DATA, "<$data") || die "Cannot open mtrace data file";
> +open(DATA, "<$data")
> +  or fatal "$progname: Cannot open mtrace data file $data: $!";
>  while (<DATA>) {
>      my @cols = split (' ');
>      my $n, $where;
> 
> base-commit: 71dafdf5f19dd2b0729e4774149944911a405bc6
>