1#! @PERL@
2eval "exec @PERL@ -S $0 $@"
3    if 0;
4# Copyright (C) 1997-2021 Free Software Foundation, Inc.
5# This file is part of the GNU C Library.
6# Based on the mtrace.awk script.
7
8# The GNU C Library is free software; you can redistribute it and/or
9# modify it under the terms of the GNU Lesser General Public
10# License as published by the Free Software Foundation; either
11# version 2.1 of the License, or (at your option) any later version.
12
13# The GNU C Library is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16# Lesser General Public License for more details.
17
18# You should have received a copy of the GNU Lesser General Public
19# License along with the GNU C Library; if not, see
20# <https://www.gnu.org/licenses/>.
21
22$VERSION = "@VERSION@";
23$PKGVERSION = "@PKGVERSION@";
24$REPORT_BUGS_TO = '@REPORT_BUGS_TO@';
25$progname = $0;
26
27sub usage {
28    print "Usage: mtrace [OPTION]... [Binary] MtraceData\n";
29    print "  --help       print this help, then exit\n";
30    print "  --version    print version number, then exit\n";
31    print "\n";
32    print "For bug reporting instructions, please see:\n";
33    print "$REPORT_BUGS_TO.\n";
34    exit 0;
35}
36
37# We expect two arguments:
38#   #1: the complete path to the binary
39#   #2: the mtrace data filename
40# The usual options are also recognized.
41
42arglist: while (@ARGV) {
43    if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver" ||
44	$ARGV[0] eq "--vers" || $ARGV[0] eq "--versi" ||
45	$ARGV[0] eq "--versio" || $ARGV[0] eq "--version") {
46	print "mtrace $PKGVERSION$VERSION\n";
47	print "Copyright (C) 2021 Free Software Foundation, Inc.\n";
48	print "This is free software; see the source for copying conditions.  There is NO\n";
49	print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
50	print "Written by Ulrich Drepper <drepper\@gnu.org>\n";
51
52	exit 0;
53    } elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel" ||
54	     $ARGV[0] eq "--help") {
55	&usage;
56    } elsif ($ARGV[0] =~ /^-/) {
57	print "$progname: unrecognized option `$ARGV[0]'\n";
58	print "Try `$progname --help' for more information.\n";
59	exit 1;
60    } else {
61	last arglist;
62    }
63}
64
65if ($#ARGV == 0) {
66    $binary="";
67    $data=$ARGV[0];
68} elsif ($#ARGV == 1) {
69    $binary=$ARGV[0];
70    $data=$ARGV[1];
71
72    if ($binary =~ /^.*[\/].*$/) {
73	$prog = $binary;
74    } else {
75	$prog = "./$binary";
76    }
77    # Set the environment variable LD_TRACE_PRELINKING to an empty string so
78    # that we trigger tracing but do not match with the executable or any of
79    # its dependencies.
80    if (open (LOCS, "env LD_TRACE_PRELINKING= $prog |")) {
81	while (<LOCS>) {
82	    chop;
83	    if (/^.*=> (.*) \((0x[0123456789abcdef]*), (0x[0123456789abcdef]*).*/) {
84		$locs{$1} = $2;
85		$rel{$1} = hex($2) - hex($3);
86	    }
87	}
88	close (LOCS);
89    }
90} else {
91    die "Wrong number of arguments, run $progname --help for help.";
92}
93
94sub location {
95    my $str = pop(@_);
96    return $str if ($str eq "");
97    if ($str =~ /.*[[](0x[^]]*)]:(.)*/) {
98	my $addr = $1;
99	my $fct = $2;
100	return $cache{$addr} if (exists $cache{$addr});
101	if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
102	    my $line = <ADDR>;
103	    chomp $line;
104	    close (ADDR);
105	    if ($line ne '??:0') {
106		$cache{$addr} = $line;
107		return $cache{$addr};
108	    }
109	}
110	$cache{$addr} = $str = "$fct @ $addr";
111    } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) {
112	my $prog = $1;
113	my $addr = $2;
114	my $searchaddr;
115	return $cache{$addr} if (exists $cache{$addr});
116	$searchaddr = sprintf "%#x", hex($addr) + $rel{$prog};
117	if ($binary ne "" && open (ADDR, "addr2line -e $prog $searchaddr|")) {
118	    my $line = <ADDR>;
119	    chomp $line;
120	    close (ADDR);
121	    if ($line ne '??:0') {
122		$cache{$addr} = $line;
123		return $cache{$addr};
124	    }
125	}
126	$cache{$addr} = $str = $addr;
127    } elsif ($str =~ /^.*[[](0x[^]]*)]$/) {
128	my $addr = $1;
129	return $cache{$addr} if (exists $cache{$addr});
130	if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
131	    my $line = <ADDR>;
132	    chomp $line;
133	    close (ADDR);
134	    if ($line ne '??:0') {
135		$cache{$addr} = $line;
136		return $cache{$addr};
137	    }
138	}
139	$cache{$addr} = $str = $addr;
140    }
141    return $str;
142}
143
144$nr=0;
145open(DATA, "<$data") || die "Cannot open mtrace data file";
146while (<DATA>) {
147    my @cols = split (' ');
148    my $n, $where;
149    if ($cols[0] eq "@") {
150	# We have address and/or function name.
151	$where=$cols[1];
152	$n=2;
153    } else {
154	$where="";
155	$n=0;
156    }
157
158    $allocaddr=$cols[$n + 1];
159    $howmuch=hex($cols[$n + 2]);
160
161    ++$nr;
162    SWITCH: {
163	if ($cols[$n] eq "+") {
164	    if (defined $allocated{$allocaddr}) {
165		printf ("+ %#0@XXX@x Alloc %d duplicate: %s %s\n",
166			hex($allocaddr), $nr, &location($addrwas{$allocaddr}),
167			$where);
168	    } elsif ($allocaddr =~ /^0x/) {
169		$allocated{$allocaddr}=$howmuch;
170		$addrwas{$allocaddr}=$where;
171	    }
172	    last SWITCH;
173	}
174	if ($cols[$n] eq "-") {
175	    if (defined $allocated{$allocaddr}) {
176		undef $allocated{$allocaddr};
177		undef $addrwas{$allocaddr};
178	    } else {
179		printf ("- %#0@XXX@x Free %d was never alloc'd %s\n",
180			hex($allocaddr), $nr, &location($where));
181	    }
182	    last SWITCH;
183	}
184	if ($cols[$n] eq "<") {
185	    if (defined $allocated{$allocaddr}) {
186		undef $allocated{$allocaddr};
187		undef $addrwas{$allocaddr};
188	    } else {
189		printf ("- %#0@XXX@x Realloc %d was never alloc'd %s\n",
190			hex($allocaddr), $nr, &location($where));
191	    }
192	    last SWITCH;
193	}
194	if ($cols[$n] eq ">") {
195	    if (defined $allocated{$allocaddr}) {
196		printf ("+ %#0@XXX@x Realloc %d duplicate: %#010x %s %s\n",
197			hex($allocaddr), $nr, $allocated{$allocaddr},
198			&location($addrwas{$allocaddr}), &location($where));
199	    } else {
200		$allocated{$allocaddr}=$howmuch;
201		$addrwas{$allocaddr}=$where;
202	    }
203	    last SWITCH;
204	}
205	if ($cols[$n] eq "=") {
206	    # Ignore "= Start".
207	    last SWITCH;
208	}
209	if ($cols[$n] eq "!") {
210	    # Ignore failed realloc for now.
211	    last SWITCH;
212	}
213    }
214}
215close (DATA);
216
217# Now print all remaining entries.
218@addrs= keys %allocated;
219$anything=0;
220if ($#addrs >= 0) {
221    foreach $addr (sort @addrs) {
222	if (defined $allocated{$addr}) {
223	    if ($anything == 0) {
224		print "\nMemory not freed:\n-----------------\n";
225		print ' ' x (@XXX@ - 7), "Address     Size     Caller\n";
226		$anything=1;
227	    }
228	    printf ("%#0@XXX@x %#8x  at %s\n", hex($addr), $allocated{$addr},
229		    &location($addrwas{$addr}));
230	}
231    }
232}
233print "No memory leaks.\n" if ($anything == 0);
234
235exit $anything != 0;
236