#!/usr/bin/perl use Getopt::Long; $Global::progname = "tracefile"; Getopt::Long::Configure("bundling","pass_through"); get_options_from_array(\@ARGV) || die_usage(); if(not ($opt::exists or $opt::nonexists or $opt::all)) { $opt::all = 1; } my @cmd = shell_quote(@ARGV); my $dir = "."; open(IN, "-|", "strace -ff -e trace=file @cmd 2>&1") || die; while() { if(/chdir."(([^\\"]|\\[\\"nt])*)".\s*=\s*0/) { $dir = $1; } # [pid 30817] stat("transpose/100000files.tar.gz", {st_mode=S_IFREG|0644, st_size=140853248, ...}) = 0 if(s/^[^\"]+"(([^\\"]|\\[\\"nt])*)".*/$1/) { # Matches the strace structure for a file my $file = shell_unquote($1); # Relative to $dir $file =~ s:^([^/]):$dir/$1:; my $print = 0; if($opt::all or ($opt::exists and -e $file) or ($opt::nonexists and not -e $file)) { $print = 1; } if($opt::unique and $seen{$file}++) { $print = 0; } $print and print $file,"\n"; } } sub options_hash { # Returns a hash of the GetOptions config return ("debug|D" => \$opt::debug, "uniq|unique|u" => \$opt::unique, "exists|exist|e" => \$opt::exists, "nonexists|nonexist|non-exists|non-exist|n" => \$opt::nonexists, "all|a" => \$opt::all, ); } sub get_options_from_array { # Run GetOptions on @array # Returns: # true if parsing worked # false if parsing failed # @array is changed my $array_ref = shift; # A bit of shuffling of @ARGV needed as GetOptionsFromArray is not # supported everywhere my @save_argv; my $this_is_ARGV = (\@::ARGV == $array_ref); if(not $this_is_ARGV) { @save_argv = @::ARGV; @::ARGV = @{$array_ref}; } my @retval = GetOptions(options_hash()); if(not $this_is_ARGV) { @{$array_ref} = @::ARGV; @::ARGV = @save_argv; } return @retval; } sub shell_unquote { # Unquote strings from shell_quote # Returns: # string with shell quoting removed my @strings = (@_); my $arg; for my $arg (@strings) { if(not defined $arg) { $arg = ""; } $arg =~ s/'\n'/\n/g; # filenames with '\n' is quoted using \' $arg =~ s/\\([\002-\011\013-\032])/$1/g; $arg =~ s/\\([\#\?\`\(\)\{\}\*\>\<\~\|\; \"\!\$\&\'])/$1/g; $arg =~ s/\\\\/\\/g; } return wantarray ? @strings : "@strings"; } sub shell_quote { my @strings = (@_); for my $a (@strings) { $a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\*\>\<\~\|\; \"\!\$\&\'\202-\377])/\\$1/g; $a =~ s/[\n]/'\n'/g; # filenames with '\n' is quoted using \' } return wantarray ? @strings : "@strings"; } sub die_usage { # Returns: N/A usage(); wait_and_exit(255); } sub usage { # Returns: N/A print join ("\n", "Usage:", "$Global::progname [-u] [-a] [-n] [-e] command [arguments]", "", "See 'man $Global::progname' for details", ""); } sub warning { my @w = @_; my $fh = $Global::original_stderr || *STDERR; my $prog = $Global::progname || "tracefile"; print $fh $prog, ": Warning: ", @w; } sub error { my @w = @_; my $fh = $Global::original_stderr || *STDERR; my $prog = $Global::progname || "tracefile"; print $fh $prog, ": Error: ", @w; }