xapian-maintainer-tools/profiling/strace-analyse

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (C) 2013,2014 Olly Betts
   4 #
   5 # Permission is hereby granted, free of charge, to any person obtaining a copy
   6 # of this software and associated documentation files (the "Software"), to
   7 # deal in the Software without restriction, including without limitation the
   8 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
   9 # sell copies of the Software, and to permit persons to whom the Software is
  10 # furnished to do so, subject to the following conditions:
  11 #
  12 # The above copyright notice and this permission notice shall be included in
  13 # all copies or substantial portions of the Software.
  14 #
  15 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  16 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  17 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  18 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  19 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  20 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
  21 # IN THE SOFTWARE.
  22
  23 use strict;
  24 use warnings;
  25
  26 # Usage:
  27 #
  28 # Run strace like so:
  29 #
  30 # strace -y -s0 -efdatasync,fsync,pread,pread64,pwrite,pwrite64 -o strace.log COMMAND ARGS...
  31 # ./strace-analyse strace.log
  32 #
  33 # Or for strace < 4.7:
  34 #
  35 # strace -s0 -eclose,dup,dup2,dup3,fdatasync,fsync,open,pread,pread64,pwrite,pwrite64 -o strace.log COMMAND ARGS...
  36 # ./strace-analyse strace.log
  37 #
  38 # Passing -s0 is optional, but doing so reduces the log size by stopping strace
  39 # from writing out any of the contents of blocks being read or written (default
  40 # is to write up to 32 bytes).
  41 #
  42 # You can also pass -r, -i, -t, -tt and/or -ttt - the script can parse out the
  43 # extra information these add, but it currently doesn't do anything with it.
  44
  45 # Track the filename currently corresponding to each fd (unless -y is used).
  46 my @fd = qw(STDIN STDOUT STDERR);
  47 while (<>) {
  48     my $systime;
  49     if (s/ <([0-9.]+)>$//) {
  50         # -T was used.
  51         $systime = 0 + $1;
  52     }
  53     my $time_t;
  54     if (s/^\s*([0-9.]+) //) {
  55         my $t = 0 + $1;
  56         if ($t < 1e9) {
  57             # -r was used - relative time since start of previous syscall.
  58         } else {
  59             # -ttt was used - seconds since epoch.
  60             $time_t = $t;
  61         }
  62     } elsif (s/^[0-9][0-9]:[0-9][0-9]:[0-9][0-9](?:\.[0-9]*)? //) {
  63         # -t or -tt was used.
  64     }
  65     my $addr;
  66     if (s/^\[([0-9a-f]+)\] //) {
  67         # -i was used: instruction pointer.
  68         $addr = $1;
  69     }
  70     if (/^pread(?:64)?\((\d+)(?:<(.*?)>)?, .*, (\d+), (\d+)\)/) {
  71         my ($fd, $path, $blocksize, $off) = ($1, $2, $3, $4);
  72         my $block = $off / $blocksize;
  73         $path //= $fd[$fd];
  74         print "read $block from $path\n";
  75     } elsif (/^pwrite(?:64)?\((\d+)(?:<(.*?)>)?, .*, (\d+), (\d+)\)/) {
  76         my ($fd, $path, $blocksize, $off) = ($1, $2, $3, $4);
  77         my $block = $off / $blocksize;
  78         $path //= $fd[$fd];
  79         print "write $block to $path\n";
  80     } elsif (/^open\("(.*)".* = (\d+)$/) {
  81         $fd[$2] = $1;
  82     } elsif (/^close\((\d+)\)/) {
  83         $fd[$1] = undef;
  84     } elsif (/^dup[23]?\((\d+)[^<].* = (\d+)/) {
  85         $fd[$2] = $fd[$1];
  86     } elsif (/^f(?:data)?sync\((\d+)(?:<(.*?)>)?\)/) {
  87         my $path = $2 // $fd[$1];
  88         print "sync $path\n";
  89     }
  90 }