#!/usr/bin/perl -w
#
# find_badblocks.pl
#
# Copyright (C) 2002-2004 Blair Zajac.  All rights reserved.
# Author: Blair Zajac <blair@orcaware.com>.
#
# $URL$
# $LastChangedDate$
# $LastChangedBy$
# $LastChangedRevision$
#
# Distributed under the terms of the GNU General Public License,
# version 2, which is available for download at
# http://www.gnu.org/licenses/gpl.html.  I, Blair Zajac, am willing to
# consider licensing this script under different terms.  If you are
# interested, please feel free to contact me.
#
# This script is used to find bad blocks on all the locally attached
# disks on a Linux system.  It determines the default block size used
# in each partition and uses this when it runs badblocks with the -b
# command line option so that blocks identified by badblocks can
# correctly be mapped to filesystem blocks and hence inodes.
#
# This script takes a -p command line option which specifies the
# number of times to scan the partitions for bad blocks, similar to
# badblocks' -p command line option.  However, while badblocks will
# skip any previously identified bad blocks on the current scan,
# find_badblocks.pl runs badblocks the specified number of times, so
# all blocks will be scanned the same number of times.  This allows
# the user to gauge how bad the bad blocks are if there are N scans
# and the same badblock is found M (<N) times.  If the filesystem is
# an ext2 or ext3 filesystem, then bad blocks stored in the
# filesystem's bad block inode will still be skipped.
#
# On my RedHat systems, I simply copy this file into /etc/cron.weekly
# for it to run on a weekly basis.

$| = 1;

# Only Perl versions 5.7.3 or greater have a POSIX module that defines
# _SC_PAGESIZE if the system defines it.
use 5.007_003;

use strict;
use Carp;
use File::Temp   0.12 qw(tempdir);
use Getopt::Long 2.26;
use IPC::Run     0.62 qw(start);
use POSIX             qw(sysconf _SC_PAGESIZE);
use Symbol;

# Check now if we are root.
if ($> != 0) {
  die "$0 must be run as root.\n";
}

# These are configurable parameters.

# Locations of programs.
my $badblocks = '/sbin/badblocks';
my $dumpe2fs  = '/sbin/dumpe2fs';
my $tune2fs   = '/sbin/tune2fs';

# The number of passes to take on a single partition.
my $opt_number_passes = 2;

# Set this to 1 to print verbose messages to standard output.
my $opt_verbose;

# Set this to the default blocksize to use to check for bad blocks.
my $opt_default_blocksize = 4096;

# This is the number of bytes in a block as reported by
# /proc/partitions.
sub PARTITION_TABLE_BLOCKSIZE () { 1024 }

GetOptions('blocksize=i' => \$opt_default_blocksize,
           'passes=i'    => \$opt_number_passes,
           'verbose'     => \$opt_verbose) or
  die "usage: $0 [-b default_block_size] [-p number_passes] [-v]\n";

# Check for valid command line parameters.
unless ($opt_number_passes > 0) {
  die "$0: -passes must be greater than 0.\n";
}

unless ($opt_default_blocksize > 0) {
  die "$0: -blocksize must be greater than 0.\n";
}

# The blocksize must be a power of 2.  Check this by shifting the
# blocksize to the right by one bit until the least significant bit is
# 1, and then check if there are any other bits set.
unless (&is_power_two($opt_default_blocksize)) {
  die "$0: -blocksize must be a power of 2.\n";
}

# Get the system's page size and check that it is a power of two.
my $pagesize = sysconf(_SC_PAGESIZE);
unless (defined $pagesize and $pagesize =~ /^\d+$/ and $pagesize > 0) {
  die "$0: internal error: sysconf(_SC_PAGESIZE) did not return an ",
      "integer > 0.\n";
}
unless (&is_power_two($pagesize)) {
  die "$0: internal error: page size $pagesize is not a power of 2.\n";
}

# Check for the existence of required programs.  Only badblocks is
# absolutely necessary, if any of the others, such as tune2fs, do not
# exist, then the information they would have provided will be
# skipped.
my %program_exists;
if ($opt_verbose) {
  print "Looking for programs to use.\n";
}
foreach my $program ($badblocks, $dumpe2fs, $tune2fs) {
  if ($opt_verbose) {
    print "  Looking for $program.\n";
  }
  unless (-e $program) {
    if ($program eq $badblocks) {
      die "$0: $program does not exist.\n";
    }
    if ($opt_verbose) {
      print "    $program does not exist.\n";
    }
    next;
  }
  unless (-x $program) {
    if ($program eq $badblocks) {
      die "$0: $program is not executable.\n";
    }
    if ($opt_verbose) {
      print "    $program is not executable.\n";
    }
    next;
  }

  if ($opt_verbose) {
    print "    $program found and is executable.\n";
  }
  $program_exists{$program} = 1;
}

# Keep track of the number of errors seen.
my $number_errors = 0;

# Get the list of currently mounted partitions.
my %mount_devices = &get_mounted_partitions;

# Get the list of partitions used as swap partitions.
my %swap_devices = &get_swap_partitions;

# Get the list of all partitions on the system and the number of
# blocks in the partition.
my %partitions = &get_all_partitions;

# Go through all of the partitions and handle them.
if ($opt_verbose) {
  print "Scanning partitions for bad blocks.\n";
}
foreach my $device (sort keys %partitions) {
  if ($opt_verbose) {
    print "  Working on $device.\n";
  }

  # Get the blocksize and current badblocks for each partition.  First
  # look to see what kind of filesystem it is.  If it is a known
  # filesystem, then use the filesystem's default blocksize.
  my $blocksize;
  my @old_badblocks;
  if (my $ref = $mount_devices{$device}) {
    my $mount_point = $ref->{mount_point};
    my $mount_type  = $ref->{mount_type};

    if ($opt_verbose) {
      print "    $device mounts $mount_point of type $mount_type.\n";
    }
    if ($mount_type =~ /^ext(2|3)$/) {
      if ($program_exists{$tune2fs}) {
        my @command = ($tune2fs, '-l', $device);
        my ($status, @output) = &safe_read_from_pipe(@command);
        if ($status) {
          warn "$0: '@command' failed.\n";
          ++$number_errors;
        } else {
          foreach my $line (@output) {
            my @line = split(' ', $line);
            if (@line    == 3       and
                $line[0] eq 'Block' and
                $line[1] eq 'size:' and
                $line[2] =~ /^\d+$/) {
              $blocksize = $line[2];
              last;
            }
          }

          unless ($blocksize) {
            warn "$0: '@command' did not return blocksize.\n";
            ++$number_errors;
          }
        }
      } else {
        warn "$0: $device mounts $mount_point with $mount_type and ",
          "$tune2fs does not exist.\n";
        ++$number_errors;
      }

      if ($program_exists{$dumpe2fs}) {
        my @command = ($dumpe2fs, '-b', $device);
        my ($status, @output) = &safe_read_from_pipe(@command);
        if ($status) {
          warn "$0: '@command' failed.\n";
          ++$number_errors;
        } else {
          foreach my $line (@output) {
            next if $line =~ /dumpe2fs/;

            foreach my $word (split(' ', $line)) {
              if ($word =~ /^\d+$/) {
                push(@old_badblocks, $word);
              } else {
                warn "$0: '@command' line $. returned non digit block ",
                     "number '$word'.\n";
                ++$number_errors;
              }
            }
          }
        }
      } else {
        warn "$0: $device mounts $mount_point with $mount_type and ",
          "$dumpe2fs does not exist.\n";
        ++$number_errors;
      }
    }
  } elsif ($ref = $swap_devices{$device}) {
    $blocksize = $pagesize;
    @old_badblocks = ();
    if ($opt_verbose) {
      print "    $device is a swap partition.\n";
    }
  } else {
    @old_badblocks = ();
    if ($opt_verbose) {
      print "    $device does not mount a filesystem and is not used for ",
            "swap.\n";
    }
  }

  if ($blocksize) {
    if ($opt_verbose) {
      print "    Using blocksize of $blocksize.\n";
    }
  } else {
    my $partition_blocks = $partitions{$device};
    if ($partition_blocks < $opt_default_blocksize/PARTITION_TABLE_BLOCKSIZE) {
      if ($opt_verbose) {
        print "    Cannot determine blocksize, using ",
              PARTITION_TABLE_BLOCKSIZE, " bytes per block since partition ",
              "is $partition_blocks ", PARTITION_TABLE_BLOCKSIZE, "-byte ",
              "block(s) large.\n";
      }
      $blocksize = PARTITION_TABLE_BLOCKSIZE;
    } else {
      if ($opt_verbose) {
        print "    Cannot determine blocksize, using default of ",
              "$opt_default_blocksize bytes.\n";
      }
      $blocksize = $opt_default_blocksize;
    }
  }

  if ($opt_verbose) {
    if (@old_badblocks) {
      print "    System indicates ", scalar @old_badblocks, " existing bad ",
            "blocks.\n";
    } else {
      print "    No indication of existing badblocks.\n";
    }
  }

  # Run badblocks the specified number of times.  Keep track of the
  # new bad blocks and how many times they were identified.
  my %new_badblocks;
  for (1 .. $opt_number_passes) {
    # Put together the command to run badblocks.
    my $write_to_badblocks         = gensym;
    my $read_stdout_from_badblocks = gensym;
    my $read_stderr_from_badblocks = gensym;

    my @verbose = $opt_verbose ? qw(-v) : ();

    my @command = ([$badblocks,
                    @verbose,
                    '-b', $blocksize,
                    '-i', '-',
                    '-p', 0,
                    $device],
                   '<pipe',  $write_to_badblocks,
                   '>pipe',  $read_stdout_from_badblocks,
                   '2>pipe', $read_stderr_from_badblocks);

    my @readable_command = map { UNIVERSAL::isa($_, 'ARRAY') ? @$_ : $_ }
                           @command;

    if ($opt_verbose) {
      print "    Running @readable_command\n";
    }

    my $harness;
    eval {
      $harness = start @command;
    };
    if ($@ or !$harness) {
      if ($@) {
        warn "$0: cannot create harness with '@readable_command': $@\n";
      } else {
        warn "$0: cannot create harness with '@readable_command'.\n";
      }
      ++$number_errors;
      last;
    }

    # Send all of the already identified bad blocks to the program.
    foreach my $badblock (@old_badblocks) {
      print $write_to_badblocks "$badblock\n";
    }

    unless (close($write_to_badblocks)) {
      warn "$0: error in closing writing to '@readable_command': $!\n";
      ++$number_errors;
      last;
    }

    $harness->finish;

    # Read the new bad blocks from badblocks stdout.
    while (<$read_stdout_from_badblocks>) {
      foreach my $word (split) {
        if ($word =~ /^\d+$/) {
          ++$new_badblocks{$word};
        } else {
          warn "$0: '@readable_command' line $. returned non digit block ",
            "number '$word'.\n";
          ++$number_errors;
        }
      }
    }

    unless (close($read_stdout_from_badblocks)) {
      warn "$0: error in closing reading stdout '@readable_command': $!\n";
      ++$number_errors;
    }

    # Read any error messages from badblocks.
    my @error_messages;
    while (<$read_stderr_from_badblocks>) {
      s/^\s+//;
      s/\s+$//;
      next unless length $_;
      push(@error_messages, $_);
    }

    unless (close($read_stderr_from_badblocks)) {
      warn "$0: error in closing reading stderr '@readable_command': $!\n";
      ++$number_errors;
    }

    if (@error_messages) {
      if ($opt_verbose) {
        print "    Program generated messages on stderr:\n      ",
              join("\n      ", @error_messages), "\n";
      } else {
        warn "$0: '@readable_command' generated messages on stderr:\n  ",
             join("\n  ", @error_messages), "\n";
      }
    }
  }

  my @new_badblocks = sort {$a <=> $b} keys %new_badblocks;
  if (@new_badblocks) {
    ++$number_errors;

    my $indent = $opt_verbose ? '    ' : '';

    my $common = "Found bad blocks (using $blocksize byte blocks)";
    if ($opt_verbose) {
      print "$indent$common at:\n";
    } else {
      print "$0: $common on $device at:\n";
    }

    printf "%s%8s %s\n", $indent, 'Block #', 'Count';

    foreach my $badblock (@new_badblocks) {
      printf "%s%8d %4d\n", $indent, $badblock, $new_badblocks{$badblock};
    }
  }
}

exit $number_errors ? 1 : 0;

# Get the list of all partitions on the system.
sub get_all_partitions {
  my %p;
  my $partitions_listing = '/proc/partitions';
  if ($opt_verbose) {
    print "Opening $partitions_listing to determine all partitions.\n";
  }
  unless (open(PARTITIONS, $partitions_listing)) {
    die "$0: cannot open '$partitions_listing' for reading: $!\n";
  }
  while (<PARTITIONS>) {
    s/^\s+//;
    s/\s+$//;
    next unless $_;
    next if /major/;

    my @line = split;
    unless (@line == 15) {
      warn "$0: line $. of '$partitions_listing' has incorrect number of ",
        "columns.\n";
      ++$number_errors;
      next;
    }

    my ($number_blocks, $device) = @line[2,3];

    unless ($device =~ m,^/dev/,) {
      $device = "/dev/$device";
    }

    unless (-e $device) {
      warn "$0: found partition on $device which does not exist.\n";
      ++$number_errors;
      next;
    }

    # Skip devices that do not end in \d, as these represent the
    # entire disk.
    unless ($device =~ /\d$/) {
      if ($opt_verbose) {
        print "  Skipping $device since it represents the entire disk.\n";
      }
      next;
    }

    if ($opt_verbose) {
      print "  Found $device.\n";
    }

    $p{$device} = $number_blocks;
  }
  close(PARTITIONS) or
    die "$0: error in closing '$partitions_listing' for reading: $!\n";

  %p;
}

# Get the list of currently mounted partitions.
sub get_mounted_partitions {
  my %m;
  my $mtab_listing = '/etc/mtab';
  if ($opt_verbose) {
    print "Opening $mtab_listing to determine mounted partitions.\n";
  }
  unless (open(MOUNTED, $mtab_listing)) {
    die "$0: cannot open '$mtab_listing' for reading: $!\n";
  }
  while (<MOUNTED>) {
    # Remove extra words that may be in this file.
    s/\son\s/ /g;
    s/\stype\s/ /g;

    my @line = split;
    unless (@line > 2) {
      warn "$0: line $. of '$mtab_listing' is badly formatted.\n";
      ++$number_errors;
      next;
    }

    my ($device, $mount_point, $mount_type) = @line;
    $m{$device} = {mount_point => $mount_point,
                   mount_type  => $mount_type};

    if ($opt_verbose) {
      print "  Found $device mounting $mount_point of type $mount_type.\n";
    }
  }
  close(MOUNTED) or
    die "$0: error in closing '$mtab_listing' for reading: $!\n";

  %m;
}

# Get the list of partitions used as swap space.
sub get_swap_partitions {
  my %s;
  my $swap_listing = '/proc/swaps';
  if ($opt_verbose) {
    print "Opening $swap_listing to determine swap partitions.\n";
  }
  unless (open(SWAP, $swap_listing)) {
    die "$0: cannot open '$swap_listing' for reading: $!\n";
  }
  while (<SWAP>) {
    s/^\s+//;

    my @line = split;

    unless (@line > 1) {
      warn "$0: line $. of '$swap_listing' has too few columns.\n";
      ++$number_errors;
      next;
    }

    my ($device, $type) = @line;
    next unless $device =~ m#^/#;

    unless ($type eq 'partition') {
      if ($opt_verbose) {
        print "  Skipping $device used as a swap $type.\n";
      }
      next;
    }

    if ($opt_verbose) {
      print "  Found $device used as a swap $type.\n";
    }

    $s{$device} = 1;
  }
  close(SWAP) or
    die "$0: error in closing '$swap_listing' for reading: $!\n";
  %s;
}

sub is_power_two {
  unless (@_ == 1) {
    confess "$0: is_power_two passed incorrect number of arguments.\n";
  }

  my $value = shift;
  while (($value & 1) == 0) {
    $value >>= 1;
  }

  $value >>= 1;

  return $value == 0;
}

sub safe_read_from_pipe {
  unless (@_) {
    croak "$0: safe_read_from_pipe passed no arguments.\n";
  }
  my $pid = open(SAFE_READ, '-|');
  unless (defined $pid) {
    die "$0: cannot fork: $!\n";
  }
  unless ($pid) {
    open(STDERR, ">&STDOUT") or
      die "$0: cannot dup STDOUT: $!\n";
    exec(@_) or
      die "$0: cannot exec '@_': $!\n";
  }
  my @output;
  while (<SAFE_READ>) {
    chomp;
    push(@output, $_);
  }
  my $result = close(SAFE_READ);
  my $exit   = $? >> 8;
  my $signal = $? & 127;
  my $cd     = $? & 128 ? "with core dump" : "";
  if ($signal or $cd) {
    warn "$0: pipe from '@_' failed $cd: \$?=$exit signal=$signal\n";
    ++$number_errors;
  }
  if (wantarray) {
    return ($exit, @output);
  } else {
    return $exit;
  }
}