Skip Menu |

This queue is for tickets about the Tk CPAN distribution.

Report information
The Basics
Id: 102648
Status: patched
Priority: 0/
Queue: Tk

People
Owner: Nobody in particular
Requestors: stefan.tauner [...] technikum-wien.at
Cc: CAC [...] cpan.org
AdminCc:

Bug Information
Severity: (no value)
Broken in:
  • 804.031
  • 804.033
Fixed in: (no value)



Subject: memory corruption/double free
Date: Mon, 9 Mar 2015 09:52:05 +0100
To: bug-Tk [...] rt.cpan.org
From: Stefan Tauner <stefan.tauner [...] technikum-wien.at>
Hi, the MWE below is killed on my machine after some "allowed" letters are entered (e.g. fff). It does not seem to be completely deterministic in terms of how it fails. Sometimes memory corruption is detected, sometimes it's a simple segfault. In my real application it produces a double free. I am using perl v5.18.2 and Tk 804.031 (both from Ubuntu 14.04). ==================================================================== use strict; use warnings; use Tk; my $mw = MainWindow -> new(); my $en_text; my $en = $mw->Entry(-textvariable => \$en_text, -validate => 'key', -validatecommand => \&en_validate)->pack; MainLoop; sub en_validate{ if ($_[1] =~ /[mMfF]/){ $en_text = uc $_[1]; $en->configure(-validate => 'key'); } return 1; } ==================================================================== Here is the full stack trace (without debugging symbols because I am lazy). Starting program: /usr/bin/perl mwe.pl [Thread debugging using libthread_db enabled] Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1". *** Error in `/usr/bin/perl': malloc(): memory corruption (fast): 0x0000000000c20043 *** Program received signal SIGABRT, Aborted. 0x00007ffff76c2cc9 in __GI_raise (sig=sig@entry=6) at ../nptl/sysdeps/unix/sysv/linux/raise.c:56 56 ../nptl/sysdeps/unix/sysv/linux/raise.c: No such file or directory. (gdb) bt #0 0x00007ffff76c2cc9 in __GI_raise (sig=sig@entry=6) at ../nptl/sysdeps/unix/sysv/linux/raise.c:56 #1 0x00007ffff76c60d8 in __GI_abort () at abort.c:89 #2 0x00007ffff76ff394 in __libc_message (do_abort=do_abort@entry=1, fmt=fmt@entry=0x7ffff780db28 "*** Error in `%s': %s: 0x%s ***\n") at ../sysdeps/posix/libc_fatal.c:175 #3 0x00007ffff770a0f7 in malloc_printerr (action=<optimized out>, str=0x7ffff780dec8 "malloc(): memory corruption (fast)", ptr=<optimized out>) at malloc.c:4996 #4 0x00007ffff770ce04 in _int_malloc (av=0x7ffff7a4a760 <main_arena>, bytes=8) at malloc.c:3359 #5 0x00007ffff770e7b0 in __GI___libc_malloc (bytes=8) at malloc.c:2891 #6 0x00007ffff7ae5865 in Perl_safesysmalloc () from /usr/lib/libperl.so.5.18 #7 0x00007ffff7ae5c58 in Perl_savepvn () from /usr/lib/libperl.so.5.18 #8 0x00007ffff7b15315 in Perl_sv_magicext () from /usr/lib/libperl.so.5.18 #9 0x00007ffff7b1548f in Perl_sv_magic () from /usr/lib/libperl.so.5.18 #10 0x00007ffff7aed09f in Perl_mg_copy () from /usr/lib/libperl.so.5.18 #11 0x00007ffff7afede4 in Perl_hv_common () from /usr/lib/libperl.so.5.18 #12 0x00007ffff7aff49e in Perl_hv_common_key_len () from /usr/lib/libperl.so.5.18 #13 0x00007ffff63f5680 in LangCallCallback () from /usr/lib/perl5/auto/Tk/Event/Event.so #14 0x00007ffff5d37618 in LangDoCallback () from /usr/lib/perl5/auto/Tk/Tk.so #15 0x00007ffff4228951 in ?? () from /usr/lib/perl5/auto/Tk/Entry/Entry.so #16 0x00007ffff4227823 in ?? () from /usr/lib/perl5/auto/Tk/Entry/Entry.so #17 0x00007ffff422b2fb in ?? () from /usr/lib/perl5/auto/Tk/Entry/Entry.so #18 0x00007ffff5d367fe in Call_Tk () from /usr/lib/perl5/auto/Tk/Tk.so #19 0x00007ffff5d2a824 in ?? () from /usr/lib/perl5/auto/Tk/Tk.so #20 0x00007ffff7b0a866 in Perl_pp_entersub () from /usr/lib/libperl.so.5.18 #21 0x00007ffff7b02e86 in Perl_runops_standard () from /usr/lib/libperl.so.5.18 #22 0x00007ffff7a94490 in Perl_call_sv () from /usr/lib/libperl.so.5.18 #23 0x00007ffff63f55a8 in LangCallCallback () from /usr/lib/perl5/auto/Tk/Event/Event.so #24 0x00007ffff5d3d38f in LangEventCallback () from /usr/lib/perl5/auto/Tk/Tk.so #25 0x00007ffff5d52477 in Tk_BindEvent () from /usr/lib/perl5/auto/Tk/Tk.so #26 0x00007ffff5d56c96 in TkBindEventProc () from /usr/lib/perl5/auto/Tk/Tk.so #27 0x00007ffff5d5a1cc in Tk_HandleEvent () from /usr/lib/perl5/auto/Tk/Tk.so #28 0x00007ffff5d5a6bc in ?? () from /usr/lib/perl5/auto/Tk/Tk.so #29 0x00007ffff63f66f7 in Tcl_ServiceEvent () from /usr/lib/perl5/auto/Tk/Event/Event.so #30 0x00007ffff63f6955 in Tcl_DoOneEvent () from /usr/lib/perl5/auto/Tk/Event/Event.so #31 0x00007ffff5d25b24 in ?? () from /usr/lib/perl5/auto/Tk/Tk.so #32 0x00007ffff7b0a866 in Perl_pp_entersub () from /usr/lib/libperl.so.5.18 #33 0x00007ffff7b02e86 in Perl_runops_standard () from /usr/lib/libperl.so.5.18 #34 0x00007ffff7a9b714 in perl_run () from /usr/lib/libperl.so.5.18 #35 0x0000000000400dd9 in main () Regards, -- Dipl.-Ing. Stefan Tauner Research and Development Embedded Systems Department University of Applied Sciences Technikum Wien Hoechstaedtplatz 6, 1200 Vienna, Austria T: +43 1 333 40 77-316 E: stefan.tauner@technikum-wien.at I: embsys.technikum-wien.at I: www.technikum-wien.at
On 2015-03-09 04:52:21, stefan.tauner@technikum-wien.at wrote: Show quoted text
> Hi, > > the MWE below is killed on my machine after some "allowed" letters are > entered (e.g. fff). It does not seem to be completely deterministic in > terms of how it fails. Sometimes memory corruption is detected, > sometimes it's a simple segfault. In my real application it produces a > double free. > > I am using perl v5.18.2 and Tk 804.031 (both from Ubuntu 14.04). > > ==================================================================== > use strict; > use warnings; > use Tk; > > my $mw = MainWindow -> new(); > my $en_text; > my $en = $mw->Entry(-textvariable => \$en_text, > -validate => 'key', > -validatecommand => \&en_validate)->pack; > MainLoop; > > sub en_validate{ > if ($_[1] =~ /[mMfF]/){ > $en_text = uc $_[1]; > $en->configure(-validate => 'key'); > } > return 1; > } > ==================================================================== > > Here is the full stack trace (without debugging symbols because I am > lazy). > > Starting program: /usr/bin/perl mwe.pl > [Thread debugging using libthread_db enabled] > Using host libthread_db library "/lib/x86_64-linux- > gnu/libthread_db.so.1". > *** Error in `/usr/bin/perl': malloc(): memory corruption (fast): > 0x0000000000c20043 *** > > Program received signal SIGABRT, Aborted. > 0x00007ffff76c2cc9 in __GI_raise (sig=sig@entry=6) at > ../nptl/sysdeps/unix/sysv/linux/raise.c:56 > 56 ../nptl/sysdeps/unix/sysv/linux/raise.c: No such file or > directory. > (gdb) bt > #0 0x00007ffff76c2cc9 in __GI_raise (sig=sig@entry=6) at > ../nptl/sysdeps/unix/sysv/linux/raise.c:56 > #1 0x00007ffff76c60d8 in __GI_abort () at abort.c:89 > #2 0x00007ffff76ff394 in __libc_message (do_abort=do_abort@entry=1, > fmt=fmt@entry=0x7ffff780db28 "*** Error in `%s': %s: 0x%s ***\n") at > ../sysdeps/posix/libc_fatal.c:175 > #3 0x00007ffff770a0f7 in malloc_printerr (action=<optimized out>, > str=0x7ffff780dec8 "malloc(): memory corruption (fast)", > ptr=<optimized out>) at malloc.c:4996 > #4 0x00007ffff770ce04 in _int_malloc (av=0x7ffff7a4a760 <main_arena>, > bytes=8) at malloc.c:3359 > #5 0x00007ffff770e7b0 in __GI___libc_malloc (bytes=8) at > malloc.c:2891 > #6 0x00007ffff7ae5865 in Perl_safesysmalloc () from > /usr/lib/libperl.so.5.18 > #7 0x00007ffff7ae5c58 in Perl_savepvn () from > /usr/lib/libperl.so.5.18 > #8 0x00007ffff7b15315 in Perl_sv_magicext () from > /usr/lib/libperl.so.5.18 > #9 0x00007ffff7b1548f in Perl_sv_magic () from > /usr/lib/libperl.so.5.18 > #10 0x00007ffff7aed09f in Perl_mg_copy () from > /usr/lib/libperl.so.5.18 > #11 0x00007ffff7afede4 in Perl_hv_common () from > /usr/lib/libperl.so.5.18 > #12 0x00007ffff7aff49e in Perl_hv_common_key_len () from > /usr/lib/libperl.so.5.18 > #13 0x00007ffff63f5680 in LangCallCallback () from > /usr/lib/perl5/auto/Tk/Event/Event.so > #14 0x00007ffff5d37618 in LangDoCallback () from > /usr/lib/perl5/auto/Tk/Tk.so > #15 0x00007ffff4228951 in ?? () from > /usr/lib/perl5/auto/Tk/Entry/Entry.so > #16 0x00007ffff4227823 in ?? () from > /usr/lib/perl5/auto/Tk/Entry/Entry.so > #17 0x00007ffff422b2fb in ?? () from > /usr/lib/perl5/auto/Tk/Entry/Entry.so > #18 0x00007ffff5d367fe in Call_Tk () from /usr/lib/perl5/auto/Tk/Tk.so > #19 0x00007ffff5d2a824 in ?? () from /usr/lib/perl5/auto/Tk/Tk.so > #20 0x00007ffff7b0a866 in Perl_pp_entersub () from > /usr/lib/libperl.so.5.18 > #21 0x00007ffff7b02e86 in Perl_runops_standard () from > /usr/lib/libperl.so.5.18 > #22 0x00007ffff7a94490 in Perl_call_sv () from > /usr/lib/libperl.so.5.18 > #23 0x00007ffff63f55a8 in LangCallCallback () from > /usr/lib/perl5/auto/Tk/Event/Event.so > #24 0x00007ffff5d3d38f in LangEventCallback () from > /usr/lib/perl5/auto/Tk/Tk.so > #25 0x00007ffff5d52477 in Tk_BindEvent () from > /usr/lib/perl5/auto/Tk/Tk.so > #26 0x00007ffff5d56c96 in TkBindEventProc () from > /usr/lib/perl5/auto/Tk/Tk.so > #27 0x00007ffff5d5a1cc in Tk_HandleEvent () from > /usr/lib/perl5/auto/Tk/Tk.so > #28 0x00007ffff5d5a6bc in ?? () from /usr/lib/perl5/auto/Tk/Tk.so > #29 0x00007ffff63f66f7 in Tcl_ServiceEvent () from > /usr/lib/perl5/auto/Tk/Event/Event.so > #30 0x00007ffff63f6955 in Tcl_DoOneEvent () from > /usr/lib/perl5/auto/Tk/Event/Event.so > #31 0x00007ffff5d25b24 in ?? () from /usr/lib/perl5/auto/Tk/Tk.so > #32 0x00007ffff7b0a866 in Perl_pp_entersub () from > /usr/lib/libperl.so.5.18 > #33 0x00007ffff7b02e86 in Perl_runops_standard () from > /usr/lib/libperl.so.5.18 > #34 0x00007ffff7a9b714 in perl_run () from /usr/lib/libperl.so.5.18 > #35 0x0000000000400dd9 in main () > > > Regards,
I can reproduce it --- fails also with Tk 804.033, and also on non-Linux platforms (e.g. FreeBSD).
This is indeed a double free, and is not specific to Perl/Tk (I can reproduce it in Tcl/Tk 8.6 by running the example using Tcl::pTk). Immediately after the first offending keystroke, the line

$en_text = uc $_[1];

causes the Entry widget's string to be freed early while still being validated by en_validate. Output from valgrind:

$ valgrind --track-origins=yes perl -Mblib rt102648.pl
==28392== Memcheck, a memory error detector
==28392== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==28392== Using Valgrind-3.13.0 and LibVEX; rerun with -h for copyright info
==28392== Command: perl -Mblib rt102648.pl
==28392==
==28392== Invalid free() / delete / delete[] / realloc()
==28392==    at 0x48313D7: free (in /usr/lib/valgrind/vgpreload_memcheck-x86-linux.so)
==28392==    by 0x4848667: Tcl_Free (Event.xs:326)
==28392==    by 0x4848687: Tcl_DbCkfree (Event.xs:338)
==28392==    by 0x5697246: InsertChars (tkEntry.c:2261)
==28392==    by 0x5698805: EntryWidgetObjCmd (tkEntry.c:1039)
==28392==    by 0x55C9D03: Call_Tk (tkGlue.c:2260)
==28392==    by 0x55BD060: XS_Tk_WidgetMethod (Tk.xs:488)
==28392==    by 0x1DE82C: Perl_pp_entersub (in /usr/bin/perl)
==28392==    by 0x1D6396: Perl_runops_standard (in /usr/bin/perl)
==28392==    by 0x1489BD: Perl_call_sv (in /usr/bin/perl)
==28392==    by 0x484CFDC: LangCallCallback (pTkCallback.c:215)
==28392==    by 0x55D0C7B: LangEventCallback (tkGlue.c:4693)
==28392==  Address 0x5e4ac70 is 0 bytes inside a block of size 1 free'd
==28392==    at 0x48313D7: free (in /usr/lib/valgrind/vgpreload_memcheck-x86-linux.so)
==28392==    by 0x4848667: Tcl_Free (Event.xs:326)
==28392==    by 0x4848687: Tcl_DbCkfree (Event.xs:338)
==28392==    by 0x569708E: EntrySetValue (tkEntry.c:2552)
==28392==    by 0x56973B3: EntryTextVarProc (tkEntry.c:3350)
==28392==    by 0x55C60EE: Perl_Trace (tkGlue.c:3766)
==28392==    by 0x1BFB34: Perl_magic_setuvar (in /usr/bin/perl)
==28392==    by 0x1BBEA5: Perl_mg_set (in /usr/bin/perl)
==28392==    by 0x1D6C11: Perl_pp_sassign (in /usr/bin/perl)
==28392==    by 0x1D6396: Perl_runops_standard (in /usr/bin/perl)
==28392==    by 0x1489BD: Perl_call_sv (in /usr/bin/perl)
==28392==    by 0x484D02A: LangCallCallback (pTkCallback.c:200)
==28392==  Block was alloc'd at
==28392==    at 0x48321A6: calloc (in /usr/lib/valgrind/vgpreload_memcheck-x86-linux.so)
==28392==    by 0x48485F1: Tcl_Alloc (Event.xs:318)
==28392==    by 0x4848617: Tcl_DbCkalloc (Event.xs:332)
==28392==    by 0x5699DC8: Tk_EntryObjCmd (tkEntry.c:817)
==28392==    by 0x55C9D03: Call_Tk (tkGlue.c:2260)
==28392==    by 0x55CD402: XSTkCommand (tkGlue.c:3025)
==28392==    by 0x5694B02: XS_Tk_entry (Entry.xs:27)
==28392==    by 0x1DE82C: Perl_pp_entersub (in /usr/bin/perl)
==28392==    by 0x1D6396: Perl_runops_standard (in /usr/bin/perl)
==28392==    by 0x150D89: perl_run (in /usr/bin/perl)
==28392==    by 0x1254C3: main (in /usr/bin/perl)
[…]
==28392== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)
 

I have not thought about how this could be improved. The documentation already warns: "In general, the textVariable and validateCommand can be dangerous to mix". I'm not sure that means this double free is expected behavior and should be tolerated, though.
I have reported this to Tcl/Tk along with a Tcl syntax example script: https://core.tcl-lang.org/tk/info/40e4bf6198
The upstream issue has been fixed in the upcoming Tcl/Tk 8.6.11 release. I have opened a PR to apply the fix to Perl/Tk: https://github.com/eserte/perl-tk/pull/68
On 2020-09-09 21:48:51, CAC wrote: Show quoted text
> The upstream issue has been fixed in the upcoming Tcl/Tk 8.6.11 > release. I have > opened a PR to apply the fix to Perl/Tk: > https://github.com/eserte/perl-tk/pull/68
Thanks, available in git as commit 8c5654af635c4b6cc537c618de7243a79c847fe2 Will be part of the next Perl/Tk release.