tracefile: Converted to perl. Deals correctly with files containing space.
This commit is contained in:
Ole Tange
parent
dd29d1da52
commit
e13b1bba51
|
|
@ -14,7 +14,7 @@ B<timestamp> prepends stdin (standard input) with a timestamp.
|
|||
|
||||
=over 9
|
||||
|
||||
=item B<--delta>
|
||||
=item B<--delta> (default)
|
||||
|
||||
Regard start time as epoch and thus show difference between start time
|
||||
and now.
|
||||
|
|
@ -35,7 +35,7 @@ Output time format in ISO8601 (E.g. 2013-01-30T13:57:58.322).
|
|||
Output time format in ISO8601/time only (E.g. 13:57:58.322).
|
||||
|
||||
|
||||
=item B<--epoch>
|
||||
=item B<--epoch> (default)
|
||||
|
||||
Output time format as seconds since 1970-01-01T00:00:00 (E.g. 1359557768.423).
|
||||
|
||||
|
|
@ -50,7 +50,7 @@ B<vmstat 1 | timestamp>
|
|||
|
||||
=head2 Timestamp each step in setting up/tearing down ssh connection:
|
||||
|
||||
B<ssh localhost echo test | timestamp --delta --epoch>
|
||||
B<ssh -v localhost echo test 2>&1 | timestamp --delta --epoch>
|
||||
|
||||
|
||||
=head1 REPORTING BUGS
|
||||
|
|
|
|||
|
|
@ -1,24 +1,130 @@
|
|||
#!/bin/bash
|
||||
#!/usr/bin/perl
|
||||
|
||||
export _EXISTS=0
|
||||
export _NONEXISTS=0
|
||||
export _UNIQUE=0
|
||||
use Getopt::Long;
|
||||
|
||||
while true ; do
|
||||
case "$1" in
|
||||
-e|--exists) export _EXISTS=1; shift ;;
|
||||
-n|--nonexists) export _NONEXISTS=1; shift ;;
|
||||
-a|--all) export _EXISTS=1; export _NONEXISTS=1; shift ;;
|
||||
-u|--unique) export _UNIQUE=1; shift ;;
|
||||
*) break;
|
||||
esac
|
||||
done
|
||||
$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);
|
||||
|
||||
open(IN, "-|", "strace -ff -e trace=file @cmd 2>&1") || die;
|
||||
while(<IN>) {
|
||||
if(s/^[^\"]+"(([^\\"]|\\[\\"nt])*)".*/$1/) {
|
||||
# Matches the strace structure for a file
|
||||
my $file = shell_unquote($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;
|
||||
}
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
if [ "$_EXISTS" == "0" -a "$_NONEXISTS" == "0" ] ; then
|
||||
export _EXISTS=1
|
||||
export _NONEXISTS=1
|
||||
fi
|
||||
|
||||
strace -ff -e trace=file "$@" 2>&1 |
|
||||
perl -ne 's/^[^"]+"(([^\\"]|\\[\\"nt])*)".*/$1/ && do { '$_EXISTS' and -e $1 and (not '$_UNIQUE' or not $seen{$_}++) and print; '$_NONEXISTS' and ! -e $1 and (not '$_UNIQUE' or not $seen{$_}++) and print };'
|
||||
|
||||
|
|
|
|||
|
|
@ -43,6 +43,18 @@ List only files once.
|
|||
=back
|
||||
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
=head2 EXAMPLE: Find the missing package
|
||||
|
||||
Assume you have a program B<foo>. When it runs it fails with: I<foo:
|
||||
error: missing library>. It does not say with file is missing, but you
|
||||
have a hunch that you just need to install a package - you just do not
|
||||
know which one.
|
||||
|
||||
tracefile -n -u foo | apt-file -f search -
|
||||
|
||||
|
||||
=head1 REPORTING BUGS
|
||||
|
||||
Report bugs to <tange@gnu.org>.
|
||||
|
|
|
|||
Loading…
Reference in a new issue