ReleaseScripts/scripts/valgrindMemcheckGraph.pl

0001 #!/usr/bin/env perl
0002 # Created: June 2007
0003 # Author: Gioivanni Petrucciani, INFN Pisa
0004 #
0005 use strict;
0006 use warnings;
0007 use Data::Dumper;
0008 use Date::Format;
0009 use Getopt::Long;
0010
0011 my $mstart = qr/^==\d+== (\S.*? bytes) in \S+ blocks are (.*?) in loss (record \S+ of \S+)/;
0012 my $mtrace = qr/^==\d+== \s+(?:at|by)\s.*?:\s+(.*?)\s\((.*)\)/;
0013 my $version = undef; #"CMSSW_1_5_0_pre3";
0014 my @showstoppers = qq(libFWCoreFramework);
0015
0016 my %presets = (
0017     'trash' => [ '__static_initialization_and_destruction_0', 'G__exec_statement', 'dlopen\@\@GLIBC_2', '_dl_lookup_symbol_x' ],
0018     'fwk' => [ qw(EventSetup  ESProd  castor  ROOT  Pool  Reflex  PluginManager  RFIO  xerces  G_) ],
0019     'tom'  =>  [ qw(EventSetup ESProd castor ROOT Pool Reflex PluginManager RFIO xerces G_ libGraf createES),
0020                  qw(Streamer python static MessageLogger ServiceRegistry) ],
0021     'prod' => [ '::(produce|filter)\(\s*edm::Event\s*&' , '::analyze\(\s*(?:const\s+)?edm::Event(?:\s+const)?\s*&' ],
0022     'prod1' => [ '::produce\(\s*\w+(?:\s+const)?\s*&\w*\s*\)' ],
0023     'prod1+' => [ '::produce\(\s*\w+(?:\s+const)?\s*&\w*\s*\)', 'edm::eventsetup::DataProxyTemplate<'  ],
0024 );
0025 my $preset_names = join(', ', sort(keys(%presets)));
0026
0027 my @trace = (); my @libs = (); my @presets = (); my @dump_presets = ();
0028 my $help = '';  my $all = ''; my $onecolumn = ''; my $outdir = $ENV{'HOME'} . "/public_html/leaks";
0029
0030 GetOptions(
0031         'rel|release|r=s' => \$version,
0032         'libs|l=s' => \@libs,
0033         'trace|t=s' => \@trace,
0034         'stopper|showstopper'=> \@showstoppers,
0035         'onecolumn|1' => \$onecolumn,
0036         'all|a' => \$all,
0037         'preset=s'   => \@presets,
0038         'dump-preset=s'   => \@dump_presets,
0039         'out=s' => \$outdir,
0040         'help|h|?' => \$help);
0041
0042 if ($help) {
0043         print <<_END;
0044    Usage: valgrindMemcheckParser.pl [ --rel RELEASE ]
0045                  [ --libs lib1,lib2,-lib3 ]
0046                  [ --trace match1,match2,-match3 ]
0047                  [ --stopper lib1,lib2 ]
0048                  [ --preset name,name,-name,+name,... ]
0049                  [ --all ]
0050                  [ --onecolumn ]
0051                  [ --out dir ]
0052                  logfile [ logfile2 logfile3 ... ]
0053
0054   It will output a set of files in a single folder, specified through '--out' option
0055
0056   If no input file is specified, reads from standard input.
0057
0058   It needs a graphviz dot program with PNG support, you can get mine from AFS with:
0059     export LD_LIBRARY_PATH=/afs/cern.ch/user/g/gpetrucc/scratch0/graphviz/lib:\${LD_LIBRARY_PATH}
0060     export PATH=/afs/cern.ch/user/g/gpetrucc/scratch0/graphviz/bin:\${PATH}
0061
0062   FILTERS
0063     --libs: coma-separated list of libs to require in the library stack trace
0064             (or to exclude, if prefixed by a "-").
0065             Can be used multiple times.
0066             Abbreviation is "-l"
0067     --trace: coma-separated list of regexps to match in the stack trace
0068              (or to exclude, if prefixed by a "-").
0069              Can be used multiple times.
0070              Abbreviation is "-t"
0071     --stopper: coma-separated list of libs to cut the stack trace at;
0072                libFWCoreFramework.so is in by default.
0073                set it to "none" to never break stack trace.
0074                use full library name.
0075     --preset: use a specified preset filter for exclusion or inclusion.
0076         filter names are $preset_names
0077         --preset name : require at least one of the regexps in "name" to match
0078                         in the stack trace
0079         --preset +name: requires all the regexp to match the in each stack trace
0080                         (not all on the same stack trace element, of course)
0081         --preset -name: exclude the event if at least one regexp in name matches
0082                         in the stack trace
0083         to get the contents of a preset use "--dump-preset name"
0084
0085     --all: show all leaks, skipping any filter
0086              Abbreviation is "-a"
0087
0088     Note: you can use PERL regexps in "libs", "trace"
0089
0090   HTML & LINKING OPTIONS
0091     --onecolunm: output things in one column, avoiding the column with the library name,
0092                  for easier cut-n-paste in savannah
0093                  an alias is "-1"
0094     --rel: CMSSW_*, or "nightly" (default: $version) to set LXR links
0095            aliases are "--release" and "-r"
0096     --link-files: if set to true (default is false), links to Uppercase identifiers are
0097                   made using filename search instead of identifier search)
0098       [NOT IMPLEMENTED]
0099
0100   HELP
0101     --help : prints this stuff (also -h, -?)
0102     --dump-preset name: dumps the content of a preset and exit
0103     --out  : output path (defaults to  ~/public_html/leaks/)
0104 _END
0105     exit;
0106 }
0107 if (@dump_presets) {
0108     foreach my $ps (@dump_presets) {
0109         print "Preset $ps: \n";
0110         print map("\t * '$_'\n", @{$presets{$ps}});
0111         print "\n";
0112     }
0113     exit;
0114 }
0115
0116 #if ($version eq 'nightly') { $version = time2str('%Y-%m-%d',time()); }
0117 @libs = split(/,/, join(',',@libs));
0118 @trace = split(/,/, join(',',@trace));
0119 @presets = split(/,/, join(',',@presets));
0120 @showstoppers= split(/,/, join(',',@showstoppers));
0121 if (grep($_ eq 'none', @showstoppers)) { @showstoppers = (); }
0122 my @trace_in  = map (qr($_), grep ( $_ !~ m/^-/, @trace ));
0123 my @trace_out = map (qr($_), grep ( s/^-//g, @trace ));
0124 my @libs_in   = map (qr($_), grep ( $_ !~ m/^-/, @libs ));
0125 my @libs_out  = map (qr($_), grep ( s/^-//g, @libs ));
0126 my %stopmap = (); foreach (@showstoppers) { $stopmap{$_} = 1; }
0127 my %presets_c = ();
0128 foreach my $ps (keys(%presets)) { $presets_c{$ps} = [ map(qr($_), @{$presets{$ps}}) ] ; }
0129 my @leaks = ();
0130
0131 sub cfilter {
0132     my @trace = @{$_->{'trace'}};
0133     my $rx;
0134     foreach $rx (@trace_in ) { return 0 unless ( grep( $_->[0] =~ $rx, @trace) ); }
0135     foreach $rx (@trace_out) { return 0 if     ( grep( $_->[0] =~ $rx, @trace) ); }
0136     foreach $rx (@libs_in )  { return 0 unless ( grep( $_->[1] =~ $rx, @trace) ); }
0137     foreach $rx (@libs_out)  { return 0 if     ( grep( $_->[1] =~ $rx, @trace) ); }
0138     foreach my $ps (@presets) {
0139         my ($op, $name) = ($ps =~ m/^([+\-]?)(\S+)/);
0140         if ($op eq '') {
0141             my $ok = 0;
0142             foreach $rx (@{$presets_c{$name}}) {
0143                 if ( grep( $_->[0] =~ $rx, @trace) ) { $ok = 1; last; }
0144             }
0145             return 0 unless $ok;
0146         } elsif ($op eq '-') {
0147             foreach $rx (@{$presets_c{$name}}) {
0148                 return 0 if     ( grep( $_->[0] =~ $rx, @trace) );
0149             }
0150         } elsif ($op eq '+') {
0151             foreach $rx (@{$presets_c{$name}}) {
0152                 return 0 unless ( grep( $_->[0] =~ $rx, @trace) );
0153             }
0154         }
0155     }
0156     return 1;
0157 }
0158
0159 sub realsize {
0160         my ($num) = ($_[0] =~ m/^([0-9,]+)/) or return 0;
0161         $num =~ s/,//g;
0162         return eval($num);
0163 }
0164 sub fformat {
0165         my $vstring = (defined($version) ? "v=$version;" : "");
0166         my $func = &escapeHTML($_[0]);
0167         $func =~ s!(\b[A-Z]\w\w\w\w+)!<a class='obj' href='http://cmssdt.cern.ch/SDT/lxr/ident?${vstring}i=$1'>$1</a>!g;
0168         $func =~ s!::(\w+)\(!::<a class='func' href='http://cmssdt.cern.ch/SDT/lxr/ident?${vstring}i=$1'>$1</a>(!g;
0169         return $func;
0170 }
0171 sub escapeHTML {
0172         my $data=$_[0];
0173         $data =~ s!&!&amp;!g;
0174         $data =~ s!<!&lt;!g;
0175         $data =~ s!>!&gt;!g;
0176         $data =~ s!"!&quot;!g;
0177         return $data;
0178 }
0179
0180 BEGIN {
0181     my $id = 0;
0182     sub toId { return sprintf("ID\%04d", $id++);  }
0183 }
0184
0185 my %legend = ();
0186 sub pretty {
0187         my ($func, $id, $count, $size) = @_;
0188         my ($nm) = ($func =~ m/^\s*([^\s\(']+)/);
0189         $nm = "Unknown" unless $nm;
0190         $nm .= sprintf('\n(%d leaks/ %.0f bytes)', $count, $size);
0191         $legend{$id} = $func;
0192         return $nm;
0193 }
0194
0195 while (<>) {
0196   if (/$mstart/) {
0197         my ($size, $status, $record) = ($1, $2, $3);
0198         #print STDERR "\nLoss size=$size, status=$status\n" if $#leaks < 20;
0199
0200         my %libs = (); my @trace = ();
0201         while (<>) {
0202                 my ($func, $lib) = /$mtrace/ or last;
0203                 #$lib =~ s/^in \S+\/((?:lib|plugin)\w+)\.so/$1/ or next;
0204                 $lib =~ s/^in \S+\/((?:lib|plugin)\w+)\.so/$1/; # or $lib = "";
0205                 last if $stopmap{$lib};
0206                 $libs{$lib} = 1; push @trace, [$func, $lib];
0207                 die "I'm not defined" unless (defined($func) and defined($lib));
0208                 #print STDERR "   lib=$lib, func=$func\n"  if $#leaks < 20;
0209         }
0210
0211         push @leaks, { 'size'=>$size, 'realsize' => realsize($size), 'status'=>$status, 'record'=>$record, 'libs'=>[keys(%libs)], 'trace'=>\@trace};
0212   }
0213 }
0214
0215
0216 #print STDERR Dumper(\@leaks);
0217 my @gleaks = ($all ? @leaks : grep ( cfilter($_), @leaks));
0218 my @sleaks = sort {$b->{'realsize'} <=> $a->{'realsize'}} @gleaks ;
0219 my $count = scalar(@sleaks);
0220 print STDERR "Selected $count leaks of " , scalar(@leaks) , ".\n";
0221
0222 my %leak_map = ();
0223
0224 my $idx = 0;
0225 foreach my $l (@sleaks) {
0226         my %L = %{$l}; $idx++;
0227         my $top = undef;
0228         foreach my $sf (reverse(@{$L{'trace'}})) {
0229                 my $func = $sf->[0];
0230                 next if $func =~ /operator\s+new/;
0231
0232                 unless (defined($leak_map{$func})) {
0233                         $leak_map{$func} = { 'count'=>0, 'size'=> 0, 'links'=>{}, 'depcount'=>0, 'id'=>toId($func), 'items'=>{} };
0234                 }
0235
0236                 $leak_map{$func}->{'count'}++;
0237                 $leak_map{$func}->{''}++;
0238                 $leak_map{$func}->{'size'} += $L{'realsize'};
0239
0240                 $leak_map{$func}->{'items'}->{$idx} = 1;
0241
0242                 if (defined($top)) {
0243                     $leak_map{$func}->{'links'}->{$top} = 1;
0244                     $leak_map{$top}->{'depcount'}++;
0245                 }
0246                 $top = $func;
0247         }
0248 }
0249
0250 mkdir $outdir unless (-d $outdir);
0251
0252 open DOT, "> $outdir/leak.dot";
0253 print DOT "digraph G { \n";
0254 #print DOT "\trankdir=LR\n";
0255 foreach my $func (keys(%leak_map)) {
0256         if (!defined($leak_map{$func})) { die "BOH ? $func " . Dumper(\%leak_map); }
0257         my %L = %{$leak_map{$func}};
0258         my $nm = pretty($func,$L{'id'},$L{'count'},$L{'size'});
0259         my $col = ($leak_map{$func}->{'count'} > $leak_map{$func}->{'depcount'} ? 'orange' : 'green');
0260         my $url = "#" .  $L{'id'};
0261         print DOT "\t", sprintf('%s [ shape=rect label="%s" style=filled fillcolor=%s URL="%s"] ', $L{'id'}, $nm, $col, $url), "\n";
0262         foreach my $link (keys(%{$L{'links'}})) {
0263                 print DOT "\t\t",  $L{'id'}, " -> ", $leak_map{$link}->{'id'}, "\n";
0264         }
0265 }
0266 print DOT "}\n";
0267 close DOT;
0268
0269 open CSS, "> $outdir/valgrindMemcheckParser.css";
0270 print CSS <<EOF;
0271 th.header { font-size: large; color: red; text-align: left; padding-top: 1em;}
0272 td.libs   { font-size: normal; color: ; padding-left: 2em; }
0273 tr.trace  { font-size: small; }
0274 td.func   { font-family: "Courier New", "courier", monospace; text-indent: -2em; padding-left: 2.5em; }
0275 td.lib    { font-family: "Courier New", "courier", monospace; color: navy;}
0276 a         { text-decoration: none; }
0277 a.obj     { color: #007700; }
0278 a.func    { color: #000077; }
0279 a:hover  { text-decoration: underline; }
0280 EOF
0281 close CSS;
0282
0283 open HTM, "> $outdir/index.html";
0284
0285 my $imgmap = join('', qx(dot -Tcmapx < $outdir/leak.dot));
0286 system("dot -Tpng -o $outdir/leak.png < $outdir/leak.dot");
0287
0288 my $footer = "Done at " . scalar(localtime());
0289
0290 print HTM <<EOF;
0291 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
0292    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
0293 <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
0294 <head>
0295         <title>Valgrind MemCheck Graph </title>
0296         <link rel='stylesheet' type='text/css' href='valgrindMemcheckParser.css' />
0297 </head>
0298 <body>
0299         <h1>Valgrind MemCheck Graph ($count leaks)</h1>
0300
0301 <h3>Overview</h3>
0302 <ul>
0303         <li><a href="#plot">Leak graph</a></li>
0304         <li><a href="#legend">Graph legend</a></li>
0305         <li><a href="#detail">Leak details</a></li>
0306 </ul>
0307 <h1><a name="plot" id="plot">Plot</a> (<a href="leak.png">PNG</a>)</h1>
0308 <p style="text-align: center">
0309       <img src="leak.png" alt="Leak map" usemap="#G" />
0310       $imgmap
0311 </p>
0312 <h1><a name="legend" id="legend">Legend</a></h1>
0313 <dl>
0314 EOF
0315 foreach my $id (sort(keys(%legend))) {
0316         print HTM "\t<dt class='id'>Frame <a name=\"$id\" id=\"$id\">$id</a></dt>\n";
0317         print HTM "\t<dd class='func'>Function: <tt>" , fformat($legend{$id}), "</tt></dd>\n";
0318         print HTM "\t<dd class='refs'>Leaks: ",
0319                 join(', ', map(sprintf('<a href="#LK%04d" class="leak">#%d</a>', $_, $_),
0320                                 sort(keys(%{$leak_map{$legend{$id}}->{'items'}}))
0321                            )), "</dd>\n";
0322 }
0323 print HTM <<EOF;
0324 </dl>
0325
0326 <h1><a name="detail" id="detail">Detailed leak list</a></h1>
0327 <table width="100%">
0328 EOF
0329 $idx = 0;
0330 foreach my $l (@sleaks) {
0331         my %L = %{$l}; $idx++;
0332         my $colspan = ($onecolumn ? 1 : 2);
0333         my $id = sprintf("LK%04d", $idx);
0334         print HTM "<tr class='header'><th class='header' colspan='$colspan'><a name=\"$id\" id=\"$id\">Leak $idx</a>: $L{size} $L{status} ($L{record}) <a href=\"#$id\">[href]</a></th></tr>\n";
0335         foreach my $sf (@{$L{'trace'}}) {
0336                 print HTM "<tr class='trace'><td class='func'>"  . fformat($sf->[0]) . "</td>";
0337                 print HTM "<td class='lib'>" . $sf->[1]. "</td>" unless $onecolumn;
0338                 print HTM "</tr>\n";
0339         }
0340 }
0341 print HTM <<EOF;
0342 </table>
0343
0344 <p class='footer'>$footer</p>
0345 </body>
0346 </html>
0347 EOF
0348
0349