Re: Possible bug in Tcl.pm exposed by Tktable?

Hi,
I'd like to share my finding.
I also duplicated the error on CentOS 7, who comes with perl 5.16
installed and tcl-8.5.
while on my Cygwin build there is no problem.
After some tracing, I found the error point is at the perl_destruct()
calling Perl_safesysfree() in perl.c:

    https://perl5.git.perl.org/perl5.git/blob/06d742c02d396d6515581002f376b=
55ab1972c1b:/perl.c#l811

There is a 'char **environ' for the environment variable string list
and calling Perl_safesysfree(environ[i]) to free the memory space.
However, I found the pointer value passed into Perl_safesysfree()
differs from that reported by gdb 'p environ[0]' command.
Here I have a demo of the gdb tracing result. There are two
'environ[0]'s: One is at address 0x7fffffffe70e (report by gdb)
and the other is at 0x618330 (actually passed into Perl_safesysfree).
Both of them have the same string content "USER=3D...".
However, later has one additional item in its string list: "FOO=3Dbar"
while gdb reported one does not have it.
Freeing this additional string leads to the error.
Its seems to be issue of compiler optimization. I am going to digging
into it later.

--------------------
(gdb) set breakpoint pending on
(gdb) b perl.c:811
Breakpoint 1 (perl.c:811) pending.
(gdb) r
Starting program: /usr/bin/perl -MTcl -e Tcl::new-\>Eval\(\"set\
env\(FOO\)\ bar\"\)
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".
[New Thread 0x7fffefa8f700 (LWP 6045)]
[Thread 0x7fffefa8f700 (LWP 6045) exited]

Breakpoint 1, perl_destruct (my_perl=3D0x603010) at perl.c:811
811                 safesysfree(environ[i]);
Missing separate debuginfos, use: debuginfo-install
libgcc-4.8.5-39.el7.x86_64 nss-softokn-freebl-3.44.0-8.el7_7.x86_64
tcl-8.5.13-8.el7.x86
(gdb) p environ
$1 =3D (char **) 0x7fffffffe460
(gdb) p environ[0]
$2 =3D 0x7fffffffe70e "USER=3Dcrystal"
(gdb) p environ[1]
$3 =3D 0x7fffffffe71b "LOGNAME=3Dcrystal"
(gdb) step
Perl_safesysfree (where=3D0x618330) at util.c:254
254         if (where) {
(gdb) p (char*)where
$4 =3D 0x618330 "USER=3Dcrystal"
(gdb) finish
Run till exit from #0  Perl_safesysfree (where=3D0x618330) at util.c:254
perl_destruct (my_perl=3D0x603010) at perl.c:810
810             for (i =3D 0; environ[i]; i++)
(gdb) step

Breakpoint 1, perl_destruct (my_perl=3D0x603010) at perl.c:811
811                 safesysfree(environ[i]);
(gdb) step
Perl_safesysfree (where=3D0x618350) at util.c:254
254         if (where) {
(gdb) p (char*)where
$5 =3D 0x618350 "LOGNAME=3Dcrystal"
--------------------
SJ

Konovalov, Vadim <[email protected]> wrote
>
> You're ingenious!
>
> vad@bonita:~$ perl -MTcl -we 'my $i=3Dnew Tcl;$i->Init;$i->Eval("set env(=
FOO) bar");'
> free(): invalid size
> Aborted (core dumped)
> vad@bonita:~$
>
> and even $i->Init not needed:
>
> vad@bonita:~$ perl -MTcl -we 'Tcl::new->Eval("set env(FOO) bar");'
> free(): invalid size
> Aborted (core dumped)
>
> Haven't looked deeper though, but the picture now is much more clear! Tha=
nks!
>
> -----Original Message-----
> From: Christopher Chavez <[email protected]>
> Sent: Tuesday, March 17, 2020 6:08 AM
> To: [email protected]
> Subject: Re: Possible bug in Tcl.pm exposed by Tktable?
>
>
> [EXTERNAL EMAIL]
>
> On 3/16/2020 4:09 AM, Christopher Chavez wrote:
> > To partially answer my own question:
> > there are some compile-time techniques to try like -DPURIFY
> > https://wiki.tcl-lang.org/page/How+to+debug+memory+faults+in+Tcl+and+e
> > xtensions
> After build from upstream sources (Tcl/Tk core-8-6-branch and TkTable 2.1=
1 -- no Debian/Ubuntu Tcl/Tk packages) with -DPURIFY, the error is revealed=
 to be a double free. The addresses involved correspond to strings allocate=
d for environment variable(s) set by Tktable (tkTableInitScript.h).
>
> A simpler program without Tk or Tktable reveals the same issue:
>
> use Tcl;
>
> my $i =3D new Tcl;
> $i->Init;
> $i->Eval('set env(FOO) bar');
>
>
> Command line output:
>
> free(): double free detected in tcache 2 Aborted (core dumped)
>
> Valgrind output:
>
> =3D=3D13666=3D=3D Invalid free() / delete / delete[] / realloc()
> =3D=3D13666=3D=3D    at 0x48369AB: free (vg_replace_malloc.c:530)
> =3D=3D13666=3D=3D    by 0x162304: perl_destruct (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C3DB: main (in /usr/bin/perl)
> =3D=3D13666=3D=3D  Address 0x5229a20 is 0 bytes inside a block of size 8 =
free'd
> =3D=3D13666=3D=3D    at 0x48369AB: free (vg_replace_malloc.c:530)
> =3D=3D13666=3D=3D    by 0x543EE86: TclpFree (tclAlloc.c:722)
> =3D=3D13666=3D=3D    by 0x5517935: TclFinalizeEnvironment (tclEnv.c:768)
> =3D=3D13666=3D=3D    by 0x5519268: Tcl_Finalize (tclEvent.c:1151)
> =3D=3D13666=3D=3D    by 0x485123D: XS_Tcl__Finalize (Tcl.xs:1449)
> =3D=3D13666=3D=3D    by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x15DF61: Perl_call_sv (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x160AC3: Perl_call_list (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x16235E: perl_destruct (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C3DB: main (in /usr/bin/perl)
> =3D=3D13666=3D=3D  Block was alloc'd at
> =3D=3D13666=3D=3D    at 0x4837D7B: realloc (vg_replace_malloc.c:826)
> =3D=3D13666=3D=3D    by 0x543EEAA: TclpRealloc (tclAlloc.c:747)
> =3D=3D13666=3D=3D    by 0x5456E8D: Tcl_Realloc (tclCkalloc.c:1147)
> =3D=3D13666=3D=3D    by 0x55172A9: TclSetEnv (tclEnv.c:317)
> =3D=3D13666=3D=3D    by 0x5517688: EnvTraceProc (tclEnv.c:636)
> =3D=3D13666=3D=3D    by 0x55A0B69: TclCallVarTraces (tclTrace.c:2678)
> =3D=3D13666=3D=3D    by 0x55A0860: TclObjCallVarTraces (tclTrace.c:2564)
> =3D=3D13666=3D=3D    by 0x55AAFDB: TclPtrSetVarIdx (tclVar.c:2001)
> =3D=3D13666=3D=3D    by 0x55AA957: Tcl_ObjSetVar2 (tclVar.c:1770)
> =3D=3D13666=3D=3D    by 0x55AA609: Tcl_SetObjCmd (tclVar.c:1529)
> =3D=3D13666=3D=3D    by 0x544A42A: Dispatch (tclBasic.c:4456)
> =3D=3D13666=3D=3D    by 0x544A4B0: TclNRRunCallbacks (tclBasic.c:4492)
> =3D=3D13666=3D=3D    by 0x5449D83: Tcl_EvalObjv (tclBasic.c:4215)
> =3D=3D13666=3D=3D    by 0x544C1AB: TclEvalEx (tclBasic.c:5361)
> =3D=3D13666=3D=3D    by 0x544B571: Tcl_EvalEx (tclBasic.c:5026)
> =3D=3D13666=3D=3D    by 0x48525A8: XS_Tcl_Eval (Tcl.xs:1097)
> =3D=3D13666=3D=3D    by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x166116: perl_run (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C401: main (in /usr/bin/perl)
> =3D=3D13666=3D=3D
> =3D=3D13666=3D=3D Invalid free() / delete / delete[] / realloc()
> =3D=3D13666=3D=3D    at 0x48369AB: free (vg_replace_malloc.c:530)
> =3D=3D13666=3D=3D    by 0x162322: perl_destruct (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C3DB: main (in /usr/bin/perl)
> =3D=3D13666=3D=3D  Address 0x5229810 is 0 bytes inside a block of size 37=
6 free'd
> =3D=3D13666=3D=3D    at 0x48369AB: free (vg_replace_malloc.c:530)
> =3D=3D13666=3D=3D    by 0x543EE86: TclpFree (tclAlloc.c:722)
> =3D=3D13666=3D=3D    by 0x5517983: TclFinalizeEnvironment (tclEnv.c:776)
> =3D=3D13666=3D=3D    by 0x5519268: Tcl_Finalize (tclEvent.c:1151)
> =3D=3D13666=3D=3D    by 0x485123D: XS_Tcl__Finalize (Tcl.xs:1449)
> =3D=3D13666=3D=3D    by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x15DF61: Perl_call_sv (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x160AC3: Perl_call_list (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x16235E: perl_destruct (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C3DB: main (in /usr/bin/perl)
> =3D=3D13666=3D=3D  Block was alloc'd at
> =3D=3D13666=3D=3D    at 0x483577F: malloc (vg_replace_malloc.c:299)
> =3D=3D13666=3D=3D    by 0x543EE6C: TclpAlloc (tclAlloc.c:699)
> =3D=3D13666=3D=3D    by 0x5456D99: Tcl_Alloc (tclCkalloc.c:1059)
> =3D=3D13666=3D=3D    by 0x5517074: TclSetEnv (tclEnv.c:263)
> =3D=3D13666=3D=3D    by 0x5517688: EnvTraceProc (tclEnv.c:636)
> =3D=3D13666=3D=3D    by 0x55A0B69: TclCallVarTraces (tclTrace.c:2678)
> =3D=3D13666=3D=3D    by 0x55A0860: TclObjCallVarTraces (tclTrace.c:2564)
> =3D=3D13666=3D=3D    by 0x55AAFDB: TclPtrSetVarIdx (tclVar.c:2001)
> =3D=3D13666=3D=3D    by 0x55AA957: Tcl_ObjSetVar2 (tclVar.c:1770)
> =3D=3D13666=3D=3D    by 0x55AA609: Tcl_SetObjCmd (tclVar.c:1529)
> =3D=3D13666=3D=3D    by 0x544A42A: Dispatch (tclBasic.c:4456)
> =3D=3D13666=3D=3D    by 0x544A4B0: TclNRRunCallbacks (tclBasic.c:4492)
> =3D=3D13666=3D=3D    by 0x5449D83: Tcl_EvalObjv (tclBasic.c:4215)
> =3D=3D13666=3D=3D    by 0x544C1AB: TclEvalEx (tclBasic.c:5361)
> =3D=3D13666=3D=3D    by 0x544B571: Tcl_EvalEx (tclBasic.c:5026)
> =3D=3D13666=3D=3D    by 0x48525A8: XS_Tcl_Eval (Tcl.xs:1097)
> =3D=3D13666=3D=3D    by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x166116: perl_run (in /usr/bin/perl)
> =3D=3D13666=3D=3D    by 0x13C401: main (in /usr/bin/perl)
>
>
>
> (Note that I built Tcl/Tk with threads, since that is how Debian/Ubuntu T=
cl/Tk are built; not yet sure if that affects this issue. Using system Perl=
 vs self-compiled Perl should not be a factor, since Travis CI uses Perlbre=
w whereas I've used the system Perl.)
>
>
> Christopher A. Chavez