mogfiledebug

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 mogfiledebug -- Dump gobs of information about a FID
   6
   7 =head1 SYNOPSIS
   8
   9     $ mogfiledebug --trackers=host --domain=foo --key=bar
  10     $ mogfiledebug --trackers=host --fid=1234
  11
  12 =head1 DESCRIPTION
  13
  14 Utility for troubleshooting problemic files in a mogilefs cluster. Also useful
  15 for verification or testing new setups.
  16
  17 Finds as much information about a file as it can. All of the paths, any queues
  18 it might be sitting in, etc. Will then test all of the paths, MD5 hash their
  19 contents, and check the file lengths. If you see errors about a FID in
  20 mogilefsd's logs plugging it through mogfiledebug should illuminate most of
  21 the potential issues.
  22
  23 This is also useful information for posting to the mailing list, along with
  24 the error you had.
  25
  26 =head1 OPTIONS
  27
  28 =over
  29
  30 =item --trackers=host1:7001,host2:7001
  31
  32 Use these MogileFS trackers to negotiate with.
  33
  34 =item --domain=<domain>
  35
  36 Set the MogileFS domain to use.
  37
  38 =item --key="<key>"
  39
  40 The key to inspect. Can be an arbitrary string.
  41
  42 =item --fid=<fid>
  43
  44 A numeric fid to inspect. Provide this as an alternative to a domain/key
  45 combination.
  46
  47 =item --paths=[print|stat|fetch]
  48
  49 Whether to print, stat, or fetch each path.
  50 The default is to fetch (and checksum) the contents of all paths.
  51
  52 =back
  53
  54 =head1 AUTHOR
  55
  56 Dormando E<lt>L<dormando@rydia.net>E<gt>
  57
  58 =head1 BUGS
  59
  60 None known. Could use more helpful prints, or a longer troubleshooting manual.
  61
  62 =head1 LICENSE
  63
  64 Licensed for use and redistribution under the same terms as Perl itself.
  65
  66 =cut
  67
  68 use strict;
  69 use warnings;
  70
  71 use lib './lib';
  72 use MogileFS::Utils;
  73 use Digest::MD5;
  74 use LWP::UserAgent;
  75
  76 my $util = MogileFS::Utils->new;
  77 my $usage = qq{--trackers=host --paths=action --domain=foo --key='/hello.jpg'
  78 If FID is known, but domain/key are not known:
  79 --trackers=host --fid=123456
  80 --paths=action, where action is 'print', 'stat', or 'fetch' (default)};
  81 my $c = $util->getopts($usage, qw/key=s fid=i paths=s/);
  82
  83 $c->{paths} ||= "fetch";
  84 if ($c->{paths} !~ /\A(print|stat|fetch)\z/) {
  85     print STDERR "$0 $usage\n";
  86     exit 1;
  87 }
  88
  89 my $arg;
  90 if ($c->{fid}) {
  91         $c->{domain} ||= 'mogfiledebug-unset';
  92         $arg = 'fid';
  93 } else {
  94         $arg = 'key';
  95 }
  96
  97 my $mogc = $util->client;
  98 my $details = $mogc->file_debug($arg => $c->{$arg});
  99 if ($mogc->errcode) {
 100     die "Error fetching fid info: " . $mogc->errstr;
 101 }
 102
 103 my %parts = ();
 104 my @paths = grep { $_ =~ m/^devpath_/ } keys %$details;
 105 while (my ($k, $v) = each %$details) {
 106     next if $k =~ m/^devpath_/;
 107     if ($k =~ s/^(\w+)_//) {
 108         $parts{$1}->{$k} = $v;
 109     }
 110 }
 111
 112 # If no paths, print something about that.
 113 if (!@paths) {
 114     print "No valid-ish paths found\n";
 115 } elsif ($c->{paths} eq 'print') {
 116     print "Paths...\n";
 117     for my $key (@paths) {
 118         my $path = $details->{$key};
 119         print " - ", $path, "\n";
 120     }
 121 } elsif ($c->{paths} eq 'stat') {
 122     my @results;
 123     # For each actual path, check its file status
 124     print "Checking status of paths...\n";
 125     for my $key (@paths) {
 126         my $path = $details->{$key};
 127         push(@results, stat_path($path));
 128     }
 129     emit_results(0, \%parts, \@results);
 130 } elsif ($c->{paths} eq 'fetch') {
 131     my @results;
 132     # For each actual path, fetch and calculate the MD5SUM.
 133     print "Fetching and summing paths...\n";
 134     for my $key (@paths) {
 135         my $path = $details->{$key};
 136         push(@results, fetch_path($path));
 137     }
 138     emit_results(1, \%parts, \@results);
 139 }
 140
 141 # print info from all of the queues. Raw is fine? failcount/etc.
 142 print "\nTempfile and/or queue rows...\n";
 143 my $found = 0;
 144 for my $type (qw/tempfile replqueue delqueue rebqueue fsckqueue/) {
 145     my $part = $parts{$type};
 146     next unless (defined $part);
 147     $found++;
 148     printf("- %12s\n", $type);
 149     while (my ($k, $v) = each %$part) {
 150         printf("  %20s: %20s\n", $k, $v);
 151     }
 152 }
 153 print "none.\n" unless $found;
 154
 155 # Print rest of file info like file_info
 156 if (my $fid = $parts{fid}) {
 157     print "\n- File Row:\n";
 158     for my $item (sort keys %$fid) {
 159         printf("  %8s: %20s\n", $item, $fid->{$item});
 160     }
 161 } else {
 162     print qq{- ERROR: No file row was found!
 163 File may have been deleted or never closed.
 164 See above for any matching rows from tempfile or delqueue.
 165 };
 166 }
 167
 168 if (my $devids = $details->{devids}) {
 169     print "\n- Raw devids: ", $devids, "\n";
 170 }
 171
 172 if (my $hash = $details->{checksum}) {
 173     print "\n- Stored checksum: ", $hash, "\n";
 174 }
 175
 176 sub fetch_path {
 177     my $path = shift;
 178     my $ua   = LWP::UserAgent->new;
 179     my $ctx  = Digest::MD5->new;
 180     $ua->timeout(10);
 181     my %toret = (length => 0);
 182
 183     my $sum_up = sub {
 184         $toret{length} += length($_[0]);
 185         $ctx->add($_[0]);
 186     };
 187     my $res = $ua->get($path, ':content_cb' => $sum_up,
 188         ':read_size_hint' => 32768);
 189
 190     $toret{hash}  = $ctx->hexdigest;
 191     $toret{res}   = $res->status_line;
 192     $toret{mtime} = $res->header("Last-Modified");
 193     $toret{path}  = $path;
 194     return \%toret;
 195 }
 196
 197 sub stat_path {
 198     my $path = shift;
 199     my $ua   = LWP::UserAgent->new;
 200     $ua->timeout(10);
 201
 202     my $res = $ua->head($path);
 203
 204     my %to_ret = (
 205         res    => $res->status_line,
 206         mtime  => $res->header("Last-Modified"),
 207         length => $res->header("Content-Length"),
 208         path   => $path,
 209     );
 210
 211     return \%to_ret;
 212 }
 213
 214 sub emit_results {
 215     my ($need_hash, $parts, $results) = @_;
 216
 217     my $hash; # detect if hashes don't match
 218     my $len = $parts->{fid}->{length};
 219     print "No length, cannot verify content length" unless defined $len;
 220     # No I don't have a good excuse for why this isn't one loop.
 221     for my $res (@$results) {
 222         print "\nResults for path: ", $res->{path}, "\n";
 223         if ($res->{res} =~ /404/) {
 224             print " - ERROR: File copy is missing: ", $res->{res}, "\n";
 225             next;
 226         }
 227
 228         if ($need_hash) {
 229             $hash ||= $res->{hash};
 230             if ($hash ne $res->{hash}) {
 231                 print " - ERROR: Hash does not match first path!\n";
 232             }
 233         }
 234
 235         if (defined $len && defined $res->{length} && $len != $res->{length}) {
 236             print " - ERROR: Length does not match file row!\n";
 237         }
 238         print " - MD5 Hash: ", $res->{hash}, "\n" if $need_hash;
 239         print " - Length: ", $res->{length}, "\n" if defined $res->{length};
 240         print " - Last-Modified: ", $res->{mtime}, "\n" if defined $res->{mtime};
 241         print " - HTTP result: ", $res->{res}, "\n";
 242     }
 243 }