#!/usr/bin/perl -w
########################################################################
## 'lodisk' lets you mount partitions within partitioned disk images, ##
## such as one might create with a command like 'dd if=/dev/hda       ##
## of=disk.img'.  You can also perform other commands than 'mount',   ##
## such as 'fsck' or 'mkfs'.                                          ##
########################################################################
## Besides perl, 'lodisk' requires 'sfdisk' and (for commands other   ##
## than 'mount') 'losetup'.  These are in the 'util-linux' package.   ##
########################################################################

sub xq { open PIPE, '-|', @_; my @res = <PIPE>; close PIPE ? @res : undef; }

sub usage
{
  die <<END
usage:
  IMPORTANT NOTE:
  The first partition-number is '1'.  '0' refers to the entire device.

  $0 mount      [options] disk-image-file partition-number directory
  $0 mkfs.ext3  [options] disk-image-file partition-number
  $0 mkswap     [options] disk-image-file partition-number
  $0 fsck       [options] disk-image-file partition-number
  $0 tune2fs    [options] disk-image-file partition-number
  $0 resize2fs  [options] disk-image-file partition-number
  $0 [c|s]fdisk [options] disk-image-file
  $0 luksformat [options] disk-image-file
END
}

my $c = shift or usage;
$c =~ m/^(mount|mkfs\.ext3|mkfs\.ntfs|mkswap|fsck|tune2fs|resize2fs|[cs]?fdisk|luksformat)$/
  or usage;
my $d = pop or usage if $c eq 'mount';
(my $n = pop || usage) =~ m/^\d+$/ or usage unless $c =~ /[cs]?fdisk|luksformat/;
my $f = pop or usage;
my @opt = @ARGV;

-f $f && -r _    or die "$0: $f: $!\n";
-d $d            or die "$0: $d: $!\n"         if $c eq 'mount';

my @offset = (0);
if ($n||=0) {
  @ptable = xq qw(sfdisk -uS -d), $f    or die "$0: sfdisk: $!\n";
  for (@ptable) {
    m/^\s*\Q${f}\E(\d+) : start= *(\d+), size= *(\d+),/ or next;
    $offset[$1] = $2 * 512;
    $length[$1] = $3 * 512;
    ####################################################################
    # The only reasonable way to express lengths is BYTES, for fuck's  #
    # sake!  "Blocks"?  "Sectors"?  WTF?  Where is 'sector' even       #
    # defined?                                                         #
    ####################################################################
  }
  $offset[$n] or die "$0: partition $n not found in $f\n";
}

if ($c eq 'mount') {
  # TODO: combine options
  exec 'mount', @opt, '-o', "loop,offset=$offset[$n]", $f, $d;
  die "$0: exec(mount ...): $!\n";
} else {
  $dev = &losetup($offset[$n], $f);
  my @cmd;
  if ($c eq 'mkfs.ext3') {
    ####################################################################
    # mke2fs(8) documentation is wrong with respect to my installed    #
    # mke2fs.  Observed behavior on my system is that without          #
    # user-specified block size, "blocks-count" argument specifies     #
    # kilobytes, even when automatically selected block size is not    #
    # 1024.  This is sane, unlike the documented behavior (which would #
    # force us to specify block size or format an unknown length of    #
    # disk), so it is probably just bad docs.  Still, make sure with   #
    # an extra call to mkfs.ext3:                                      #
    ####################################################################
    my @l = xq qw(mkfs.ext3 -n -F), @opt, $dev, int($length[$n]/1024)
      or die "$0: mkfs.ext3: $!\n";
    for (join '', @l) {
      m/^Block size=(\d+).*^\d+ inodes, (\d+) blocks/ms or die;
      $1 * $2 le $length[$n] or die "$1 * $2 != $length[$n]";
    }
    ####################################################################
    # mkfs(8) specifies the last argument as 'blocks' also.  But mkfs  #
    # does not even accept an argument to set block size! Nor does it  #
    # specify how to ascertain the block size.  Since allowing 'mkfs'  #
    # here would overwrite a region of undocumented length, I haven't  #
    # included it.                                                     #
    ####################################################################

    @cmd = ($c, @opt, $dev, int($length[$n] / 1024));
  } elsif ($c eq 'mkfs.ntfs') {
    my @l = xq qw(mkfs.ntfs -n -F), @opt, $dev, int($length[$n]/1024)
      or die "$0: mkfs.ntfs: $!\n";
    @cmd = ($c, @opt, $dev, int($length[$n] / 1024));
  } elsif ($c eq 'mkswap') {
    @cmd = ($c, @opt, $dev, int($length[$n] / 1024));
  } elsif ($c =~ m/^(fsck|[cs]?fdisk|tune2fs|luksformat)$/) {
    @cmd = ($c, @opt, $dev);
  } elsif ($c eq 'resize2fs') {
    @cmd = ($c, @opt, $dev, int($length[$n] / 512) . "s");
  } else {
    die 'impossible';
  }

  ($r = system @cmd) == 0 or warn("$0: system(@cmd): $?\n");
  &losetdown;
  exit($r ? $r >> 8 : 0);
}

sub losetdown
{
  system(qw(losetup -d), $dev) == 0 or die ("$0: losetup -d $dev: $?\n");
}

sub losetup
{
  ($offset, $file) = @_;
  $dev = qx(losetup -f) or die "$0: losetup -f: [$?] $!\n";
  chomp($dev);

  system(qw(losetup -o), $offset, $dev, $file) == 0
    or die "$0: losetup $dev: [$?] $!\n";
  $SIG{__DIE__} = \&losetdown;
  return $dev;
}