tangent icon

Summarize reads and writes in dtruss output

tangent | PRO | 09/04/16 03:48:36 AM UTC | 0 ⭐ | 634 👁️ | Never ⏰ | []
Perl |

2.64 KB

|

None

|

0 👍

/

0 👎

#!/usr/bin/env perl -w
########################################################################
# sum-io - Given one or more files containing dtruss output and a
#          pattern matching the file name(s) you are interested in,
#          report the number of bytes written to and read from the
#          matched file(s) according to dtruss.
#
# To collect suitable output, say something like this:
#
#    $ sudo dtruss -p $(pgrep TargetProgram) 2>&1 | tee results
#
# Hit Ctrl-C when you've collected sufficient results.  (The tee(1) lets
# you monitor TargetProgram to see when it stops issuing interesting
# syscalls.)  Then run this script on the results file:
#
#    $ sum-io file_re results
#
# The file_re argument can be any Perl regex.
#
# Created 2016.09.03 by Warren Young
#
# LICENSE: https://creativecommons.org/licenses/by-sa/3.0/
########################################################################
 
use File::Basename;
use List::MoreUtils qw(uniq);
use Number::Format qw(format_bytes);
 
my ($file_re, @dtruss_results) = @ARGV;
die "usage: $0 <filename-regex> <dtruss-results> [more-results...]\n\n"
        unless length($file_re) && @dtruss_results;
 
my (%read, %written, $target_fd, $target_fn) = (0, 0);
for my $results (@dtruss_results) {
    open my $rf, '<', $results
            or die "Cannot read dtruss result file $results: $!\n";
 
    while (<$rf>) {
        my ($sc, $path, $ret) = /^(\w+)\((".*\\0")?.*= (\d+)/;
        next unless length($sc) && length($ret);
 
        if ($sc eq 'open' && /$file_re/) {
            # Save the return value of open(2) as the target FD.  The
            # base conversion is necessary because dtruss prints syscall
            # results as dec but syscall integer *args* as hex.  Grrr.
            $target_fd = sprintf("0x%X", int($ret));
            $target_fn = basename(substr $path, 1, -3);
        }
        elsif ($target_fd) {
            # Does this look like a syscall involving the target file?
            my ($call_fd) = /^\w+\((0x[0-9A-F]+)/;
            if ($call_fd && $call_fd eq $target_fd) {
                if ($sc eq 'close') {
                    # The target file is closed now.  Forget it.
                    undef $target_fd;
                    undef $target_fn;
                }
                elsif ($sc =~ /read/) {
                    $read{$target_fn} += $ret;
                }
                elsif ($sc =~ /write/) {
                    $written{$target_fn} += $ret;
                }
                # else, syscall is uninteresting
            }
        }
        # else, haven't found the open(2) call for the target file yet
    }
 
    close $rf;
}
 
for my $f (uniq(sort(keys %read, keys %written))) {
    my ($r, $w) = ($read{$f}, $written{$f});
    if ($r or $w) {
        print "Data I/O for file $f:\n";
        print "    ", format_bytes($read{$f}), " read\n" if $r;
        print "    ", format_bytes($written{$f}), " written\n" if $w;
    }
}

Comments