From 2598055fcbed9c1bc7ef9adedcd77442e613d4d6 Mon Sep 17 00:00:00 2001 From: Ole Tange Date: Tue, 8 Jan 2019 02:17:35 +0100 Subject: [PATCH] tracefile: --read + --write support. --- tracefile/tracefile | 143 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 131 insertions(+), 12 deletions(-) diff --git a/tracefile/tracefile b/tracefile/tracefile index b57bbff..daee2e0 100755 --- a/tracefile/tracefile +++ b/tracefile/tracefile @@ -6,9 +6,9 @@ tracefile - list files being accessed =head1 SYNOPSIS -B [-adefnu] I +B [-adefnruw] I -B [-adefnu] -p I +B [-adefnruw] -p I =head1 DESCRIPTION @@ -48,7 +48,7 @@ List only existing files. =item B<--file> -List only files. +List only normal files. =item B<-n> @@ -71,6 +71,21 @@ Trace process id. List only files once. + +=item B<-r> + +=item B<--read> + +List only files being access for reading. + + +=item B<-w> + +=item B<--write> + +List only files being access for writing. + + =back @@ -98,7 +113,7 @@ Report bugs to . =head1 AUTHOR -Copyright (C) 2012,2016,2017 Ole Tange, http://ole.tange.dk and Free +Copyright (C) 2012-2019 Ole Tange, http://ole.tange.dk and Free Software Foundation, Inc. @@ -227,7 +242,7 @@ $Global::progname = "tracefile"; Getopt::Long::Configure("bundling","require_order"); get_options_from_array(\@ARGV) || die_usage(); - +init_functions(); if(not ($opt::exists or $opt::nonexists or $opt::all or $opt::dir or $opt::file)) { $opt::all = 1; } @@ -241,15 +256,30 @@ 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/) { + # [pid 30817] stat("t/tar.gz", {st_mode=S_IFREG|0644, st_size=140853248, ...}) = 0 + # openat(AT_FDCWD, "/tmp/a", O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK, 0666) = 3 + if(/^(\[[^]]\])? # Match pid + \s*([^\" ]+) # function + [(] # ( + [^"]* # E.g. AT_FDCWD + " # " + (([^\\"]|\\[\\"nt])*) # content of string with \n \" \t \\ + "(.*)/x) # Rest + { # Matches the strace structure for a file - my $file = shell_unquote($1); + my $function = $2; + my $file = shell_unquote($3); + my $addinfo = $5; # Relative to $dir $file =~ s:^([^/]):$dir/$1:; + my $read = readfunc($function,$addinfo); + my $write = writefunc($function,$addinfo); my $print = 1; - if(($opt::dir and not -d $file) + if(($opt::read and not $read) + or + ($opt::write and not $write) + or + ($opt::dir and not -d $file) or ($opt::file and not -f $file) or @@ -262,6 +292,69 @@ while() { } $print and print $file,"\n"; } + +} + +{ + my %warned; + my %funcs; + + sub init_functions { + # function name => r/w/rw/n/? + # r = read + # w = write + # rw = read+write + # n = neither (false match) + # ? = TODO figure out what they do + %funcs = + qw(access r acct ? chdir r chmod w chown w chown16 w + chroot r creat w execv r execve r execveat r faccessat + r fanotify_mark ? fchmodat w fchownat w fstat r fstat64 + r fstatat64 r fstatfs r fstatfs64 r futimesat r getcwd + r getxattr r inotify_add_watch r link w linkat w + listxattr r lstat r lstat64 r mkdir w mkdirat w mknod w + mknodat w mount r name_to_handle_at ? newfstatat r + oldfstat r oldlstat r oldstat r open rw openat rw + osf_fstatfs r osf_statfs r osf_utimes r perror n pivotroot r + printargs ? printf n quotactl ? readlink r readlinkat r + removexattr w rename w renameat w renameat2 w rmdir w + setxattr w stat r stat64 r statfs r statfs64 r statx r + swapoff w swapon w symlink w symlinkat w truncate w + truncate64 w umount r umount2 r unlink w unlinkat w + uselib r utime w utimensat w utimes w); + } + + sub readfunc { + # The call is a call that would work on a RO file system + my($func,$info) = @_; + if($func eq "open" or $func eq "openat") { + return ($info=~/O_RDONLY/); + } + if($funcs{$func}) { + return ($funcs{$func} eq "r"); + } else { + $warned{$func}++ or + warning("'$func' is unknown. Please report at", + "https://gitlab.com/ole.tange/tangetools/issues"); + return 0; + } + } + + sub writefunc { + # The call is a call that would need RW file system + my($func,$info) = @_; + if($func eq "open" or $func eq "openat") { + return ($info=~/O_WRONLY|O_APPEND|O_CREAT/); + } + if($funcs{$func}) { + return ($funcs{$func} eq "w"); + } else { + $warned{$func}++ or + warning("$func is unknown. Please report at", + "https://gitlab.com/ole.tange/tangetools/issues"); + return 0; + } + } } sub options_hash { @@ -273,6 +366,8 @@ sub options_hash { "uniq|unique|u" => \$opt::unique, "exists|exist|e" => \$opt::exists, "nonexists|nonexist|non-exists|non-exist|n" => \$opt::nonexists, + "read|r" => \$opt::read, + "write|w" => \$opt::write, "all|a" => \$opt::all, "pid|p=i" => \$opt::pid, ); @@ -349,7 +444,7 @@ sub warning { my @w = @_; my $fh = $Global::original_stderr || *STDERR; my $prog = $Global::progname || "tracefile"; - print $fh $prog, ": Warning: ", @w; + print $fh map { ($prog, ": Warning: ", $_, "\n"); } @w; } @@ -360,5 +455,29 @@ sub error { print $fh $prog, ": Error: ", @w; } - +sub my_dump(@) { + # Returns: + # ascii expression of object if Data::Dump(er) is installed + # error code otherwise + my @dump_this = (@_); + eval "use Data::Dump qw(dump);"; + if ($@) { + # Data::Dump not installed + eval "use Data::Dumper;"; + if ($@) { + my $err = "Neither Data::Dump nor Data::Dumper is installed\n". + "Not dumping output\n"; + ::status($err); + return $err; + } else { + return Dumper(@dump_this); + } + } else { + # Create a dummy Data::Dump:dump as Hans Schou sometimes has + # it undefined + eval "sub Data::Dump:dump {}"; + eval "use Data::Dump qw(dump);"; + return (Data::Dump::dump(@dump_this)); + } +}