Add mogfiledebug utility

Useful for dumping information in troubleshooting errors, or getting mailing
list support.

MANIFEST

@@ -12,3 +12,4 @@ mogfetch
 mogfileinfo
 moglistfids
 moglistkeys
+mogfiledebug

Makefile.PL

@@ -10,7 +10,7 @@ WriteMakefile(
     ABSTRACT                    => 'MogileFS utilities',
     EXE_FILES                   => ['mogtool', 'mogadm', 'mogstats',
         'mogupload', 'mogfetch', 'mogdelete', 'mogfileinfo', 'moglistkeys',
-        'moglistfids',
+        'moglistfids', 'mogfiledebug',
                                    ],
     PREREQ_PM                   => {
         'LWP::Simple'      => 0,

lib/MogileFS/Utils.pm

@@ -134,6 +134,8 @@ L<moglistkeys>
 
 L<moglistfids>
 
+L<mogfiledebug>
+
 L<mogtool> (DEPRECATED: Do not use!)
 
 =head1 SUMMARY

mogfiledebug

@@ -0,0 +1,172 @@
+#!/usr/bin/perl
+
+=head1 NAME
+
+mogfiledebug -- Dump gobs of information about a FID
+
+=head1 SYNOPSIS
+
+    $ mogfiledebug --trackers=host --domain=foo --key=bar
+    $ mogfiledebug --trackers=host --fid=1234
+
+=head1 DESCRIPTION
+
+Utility for troubleshooting problemic files in a mogilefs cluster. Also useful
+for verification or testing new setups.
+
+Finds as much information about a file as it can. All of the paths, any queues
+it might be sitting in, etc. Will then test all of the paths, MD5 hash their
+contents, and check the file lengths. If you see errors about a FID in
+mogilefsd's logs plugging it through mogfiledebug should illuminate most of
+the potential issues.
+
+This is also useful information for posting to the mailing list, along with
+the error you had.
+
+=head1 OPTIONS
+
+=over
+
+=item --trackers=host1:7001,host2:7001
+
+Use these MogileFS trackers to negotiate with.
+
+=item --domain=<domain>
+
+Set the MogileFS domain to use.
+
+=item --key="<key>"
+
+The key to inspect. Can be an arbitrary string.
+
+=item --fid=<fid>
+
+A numeric fid to inspect. Provide this as an alternative to a domain/key
+combination.
+
+=back
+
+=head1 AUTHOR
+
+Dormando E<lt>L<[email protected]>E<gt>
+
+=head1 BUGS
+
+None known. Could use more helpful prints, or a longer troubleshooting manual.
+
+=head1 LICENSE
+
+Licensed for use and redistribution under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+
+use lib './lib';
+use MogileFS::Utils;
+use Digest::MD5;
+use LWP::UserAgent;
+
+my $util = MogileFS::Utils->new;
+my $usage = "--trackers=host --domain=foo --key='/hello.jpg'";
+# FIXME: add "nofetch" mode that just prints paths?
+my $c = $util->getopts($usage, qw/key=s fid=i/);
+
+my $mogc = $util->client;
+
+my $arg = $c->{fid} ? 'fid' : 'key';
+my $details = $mogc->file_debug($arg => $c->{$arg});
+if ($mogc->errcode) {
+    die "Error fetching fid info: " . $mogc->errstr;
+}
+
+my %parts = ();
+my @paths = grep { $_ =~ m/^devpath_/ } keys %$details;
+while (my ($k, $v) = each %$details) {
+    next if $k =~ m/^devpath_/;
+    if ($k =~ s/^(\w+)_//) {
+        $parts{$1}->{$k} = $v;
+    }
+}
+
+# If no paths, print something about that.
+if (@paths) {
+    my @results;
+    # For each actual path, fetch and calculate the MD5SUM.
+    print "Fetching and summing paths...\n";
+    for my $key (@paths) {
+        my $path = $details->{$key};
+        push(@results, fetch_path($path));
+    }
+    my $hash; # detect if hashes don't match
+    my $len = $parts{fid}->{length};
+    print "No length, cannot verify content length" unless defined $len;
+    # No I don't have a good excuse for why this isn't one loop.
+    for my $res (@results) {
+        print "Results for path: ", $res->{path}, "\n";
+        $hash = $res->{hash} unless $hash;
+        if ($hash ne $res->{hash}) {
+            print " - ERROR: Hash does not match first path!\n";
+        }
+        if (defined $len && $len != $res->{length}) {
+            print " - ERROR: Length does not match file row!\n";
+        }
+        print " - Hash: ", $res->{hash}, "\n";
+        print " - Length: ", $res->{length}, "\n";
+        print " - HTTP result: ", $res->{res}, "\n";
+    }
+} else {
+    print "No valid-ish paths found\n";
+}
+
+# print info from all of the queues. Raw is fine? failcount/etc.
+print "Tempfile and/or queue rows...\n";
+my $found = 0;
+for my $type (qw/tempfile replqueue delqueue rebqueue fsckqueue/) {
+    my $part = $parts{$type};
+    next unless (defined $part);
+    $found++;
+    printf("- %12s\n", $type);
+    while (my ($k, $v) = each %$part) {
+        printf("  %20s: %20s\n", $k, $v);
+    }
+}
+print "none.\n" unless $found;
+
+# Print rest of file info like file_info
+if (my $fid = $parts{fid}) {
+    print "- File Row:\n";
+    for my $item (sort keys %$fid) {
+        printf("  %8s: %20s\n", $item, $fid->{$item});
+    }
+} else {
+    print qq{- ERROR: No file row was found!
+File may have been deleted or never closed.
+See above for any matching rows from tempfile or delqueue.
+};
+}
+
+if (my $devids = $details->{devids}) {
+    print " - Raw devids: ", $devids, "\n";
+}
+
+sub fetch_path {
+    my $path = shift;
+    my $ua   = LWP::UserAgent->new;
+    my $ctx  = Digest::MD5->new;
+    $ua->timeout(10);
+    my %toret = ();
+
+    my $sum_up = sub {
+        $toret{length} += length($_[0]);
+        $ctx->add($_[0]);
+    };
+    my $res = $ua->get($path, ':content_cb' => $sum_up,
+        ':read_size_hint' => 32768);
+
+    $toret{hash}  = $ctx->hexdigest;
+    $toret{res}   = $res->status_line;
+    $toret{path}  = $path;
+    return \%toret;
+}