#! /usr/bin/perl -w

use strict;
use Symbol;
use File::stat;

my $STDOUT = Symbol::gensym;    # to avoid 'bareword' warnings
my $STDERR = Symbol::gensym;

sub usage {
  my ($status) = @_;
  my $msg = <<EoF;
Usage:
  $0 ls  some/image.iso/findspec
  $0 cp  source/genfilespec dest/genfilespec
  $0 cat some/genfilespec

A "generalized file spec" can be either a plain file in the Unix
filesystem, or it can be a file within an ISO 9660 image.  In the
latter case, the syntax treats the ISO image as if it were a
directory, so it will be of the form pathto/some.iso/inner/file, where
pathto/some.iso tells where to find the ISO image, and inner/file is
the name of the file within the ISO image.

Options:
  --dry-run     do almost all error checking, but don't actually 
  --regex       use perl-style (not shell-style) regular expressions
  --file        include plain files (as opposed to directories) in matches
  --dir         include directories in matches

The default is both --file --dir.

We support wildcards for the inner part of the genfilespec, i.e.  the
part that is _within_ the ISO image.  We do not support wildcards for
the outer part.

Copying a file _to_ the interior of an ISO image only works
in cases where it can overwrite a pre-existing file.  The
pre-existing version must have the exact same size (same number of
bytes) as the new version.

EoF
  $status = $status || 0;
  my $ouch = $status ? $STDERR : $STDOUT;
  print $ouch $msg;
  exit $status;
}

my $dry_run = 0;
my $sector = 2048;
my $re_mode = 0;
my $file_mode = 0;
my $dir_mode = 0;

# Return a list of strings.
# For each file that matches the given wildcard,
# return a string: size, starting-sector, name.
# If the offset is zero, it's a plain linux file.
# Otherwise, the name is relative to the ISO image.
sub find_file_w {
  my ($img, $shellpatt) = @_;

  my $inch = Symbol::gensym;
  open($inch, '<', $img)
    || die "Cannot determine type of file '$img'\n";
  my $buf;
  my $is_iso = 0;
  seek($inch, 32769, 0);
  read($inch, $buf, 5);
  if ($buf eq 'CD001') {
    seek($inch, 38913, 0);
    read($inch, $buf, 10);
    if ($buf ne 'NSR0') {
      $is_iso = 1;
    }
  }

  my @rslt = ();
  if (!$is_iso) {
    if ($shellpatt ne '') {
      die "File '$img' is neither a Unix directory nor ISO image.\n";
    }
    my $filestat = stat($inch)
      || die "Could not stat file '$img'\n";
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks) = @$filestat;
    push @rslt, sprintf("%12s %10s %s%s",
       $size, 0, $img, '');
    return @rslt;
  }
  close $inch;

  my $re_patt = '.?';    # default: match absolutely anything

# Now make the shellpatt work _somewhat_ like File::fnmatch,
# but with jsd extension to allow "**" to match slashes,
# so that directory paths
  if (defined $shellpatt && $shellpatt ne '') {
    if ($re_mode) {
      $re_patt = $shellpatt;
    } else {
      $re_patt = $shellpatt;
      $re_patt =~ s'<'<lt>'g;
      $re_patt =~ s'[*][*]'<starstar>'g;
      $re_patt =~ s'[.]'<dot>'g;
      $re_patt =~ s'[*]'[^/]*'g;
      $re_patt =~ s'[?]'[^/]'g;
      $re_patt =~ s'[+]'[+]'g;
      $re_patt =~ s'<dot>'[.]'g;
      $re_patt =~ s'<starstar>'.*'g;          # jsd extension
      $re_patt =~ s'<lt>'<'g;
      $re_patt = "^$re_patt\$";
    }
  }

# We use a pipe to the 'isoinfo' program.
# We do this instead of either of the perl library modules
# that purport to parse ISO 9660 directories, because one
# of the modules produces quite unreliable results, while
# the other is prohibitively difficult for users to install.
  my $pipe = Symbol::gensym;
  my $cmd = "isoinfo -l -i $img";
  open($pipe, '-|', $cmd) ||
    die "Could not open pipe to '$cmd'\n";
  my $dirname = '';
  liner: while (my $line = <$pipe>) {
    chomp $line;
    if ($line eq '') {
      next liner;
    }
    my $isdir = ($line =~ m'^d');
    my $foundit = 0;
    if ($line =~ s'^Directory listing of '') {
      $dirname = $line;         # remember directory name ...
      $dirname =~ s'/$'';       # remove trailing slash if any
    } elsif ($isdir) {
      if ($dir_mode) {
        $foundit++;
      }
    } elsif ($line =~ m'^-') {
      if ($file_mode) {
        $foundit++;
      }
    } else {
      print $STDERR "Unrecognized 'isoinfo' line:\n";
      print $STDERR $line . "\n";
    }

# OK, we have an object of the right general type (file and/or directory)
# so let's see if it matches.
    if ($foundit) {
      my @stuff = split('[\[\]]', $line);
      my $basename = $stuff[2];
      $basename =~ s'^ *'';
      $basename =~ s' *$'';
      $basename =~ s';1$'';
      my $tmp = '/' . $basename;
      if ($tmp !~ m'/[.][.]?$') {
        my $fullname = $dirname . '/' . $basename;
        $fullname =~ s'^/'';    # filenames do not start with /
        $re_patt =~ s'/+'/'g;           ## collapse // to / everywhere
        if ($fullname =~ m"/?$re_patt"i) {
          my @krud = split(' ', $stuff[0]);
          my $size = $krud[4];
          my @sects = split(' ', $stuff[1]);
          my $sect0 = $sects[0];
          push @rslt, sprintf("%12s %10s %s%s",
             $size, $sect0, $fullname, $isdir ? '/' : '');
        }
      }
    }
  }
  my $status = close $pipe;
  if (!$status) {
    my $code = $? >> 8;
    print $STDERR "Pipe to '$cmd' failed with status $code\n";
    exit 1;
  }
  return @rslt;
}

# Scan a combo-filespec to find which part is
# the path to the iso image, and which is the
# pattern-spec for finding a file within the iso image.
sub split_path {
  my ($combo, $oknew) = @_;
  
  my $img;
  my @stuff = split('/', $combo);
  $img = '';
  findimg : for my $x ('once') {
    while (@stuff) {
      $img .= shift @stuff;
      if ($img eq '') {
        # nothing to do
      } elsif (-d $img) {
        #xx print "d: $img\n";
      } elsif (-f $img) {
        #xx print "f: $img\n";
        last findimg;
      } else {
        if (!@stuff && $oknew) {
          ## printf STDERR "New file: '$img'\n";
          last findimg;
        } else {
          die "No such file or directory '$img'\n";
        }
      }
      $img .= '/';
    }
    # Normally should not get here.
    die "No image file in '$img'\n";
  }
  my $shellpatt = join('/', @stuff);
  return( ($img, $shellpatt) );
}

sub open_file{
  my ($direction, $combo) = @_;
  $direction eq '<' || $direction eq '>' || die "bad call to open_file\n";
  my ($img, $patt) = split_path($combo, $direction eq '>');
  if ($patt ne '') {
    my @rslt = find_file_w($img, $patt);
    if (@rslt == 0) {
      die "Destination image '$img' contains no matches for '$patt'\n";
    }
    if (@rslt > 1) {
      die "Destination image '$img' contains "
       . "multiple matches for '$patt'\n";
    }
    my @stuff = split(' ', $rslt[0]);
    my $size = $stuff[0];
    my $where = $stuff[1];
    my $fn = $stuff[2];

    my $ch = Symbol::gensym;
    my $xdir = $direction;
    if ($xdir eq '>') {
      $xdir = '+<';             # reading AND writing
    }
    if ($dry_run) {
      $xdir = '<';
    }
    open ($ch, "$xdir:raw", $img)
     || die "Could not open $direction file '$img'\n";
    seek ($ch, $where*$sector, 0);
    return ($ch, $size);
  } else {
# here if plain Unix file, not inside an iso image
    my $ch = Symbol::gensym;
    if ($dry_run && $direction eq '>') {
      # skip it
    } else {
      open($ch, "$direction:raw", $img)
        || die "Could not open $direction file '$img'\n";
    }
    if ($direction eq '>') {
      return ($ch, -1);
    }
    my $filestat = stat($ch) 
      || die "Could not stat $direction file '$img'\n";
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks) = @$filestat;
    return ($ch, $size);
  }
}

sub do_cp {
    my ($src, $dest) = @_;
    my ($s_ch, $s_size) = open_file('<', $src);
    my ($d_ch, $d_size) = open_file('>', $dest);

    if ($d_size >= 0 && $s_size != $d_size) {
      print $STDERR "Size mismatch:\n";
      printf $STDERR ("%10s : %s\n", $s_size, $src);
      printf $STDERR ("%10s : %s\n", $d_size, $dest);
      exit(1);
    }
##    -r $src || die "Source '$src' is not readable\n";
##    -w $d_img || die "Image '$d_img' is not writable\n";

    if (!$dry_run) {
      my $buffer;
      my $rslt = read($s_ch, $buffer, $s_size);
      $rslt == $s_size || die "Bad read: $rslt not $s_size\n";
      print $d_ch $buffer;
    }
}

main: {
  open ($STDOUT, '>&', STDOUT);
  open ($STDERR, '>&', STDERR);
  my @positional = ();
  for my $arg (@ARGV) {
    if ($arg =~ m'^--?h') {
      usage;
      exit 0;
    } elsif ($arg =~ m'^--?dry') {
      $dry_run++;
    } elsif ($arg =~ m'^--?re') {
      $re_mode++;
    } elsif ($arg =~ m'^--?file') {
      $file_mode++;
    } elsif ($arg =~ m'^--?dir') {
      $dir_mode++;
    } elsif ($arg =~ m'^-') {
      print $STDERR "Unrecognized option '$arg'\n";
      usage(1);
    } else {
      push @positional, $arg;
    }
  }
  if (!($file_mode || $dir_mode)) {
    $file_mode = $dir_mode = 1;
  }

  while (@positional) {
    my $verb = shift @positional;
    if ($verb eq 'ls' || $verb eq 'list') {
      if (! @positional) {
        die "ls requires at least one argument\n";
      }
      while (@positional) {
        my $combo = shift @positional;
        my ($img, $shellpatt) = split_path($combo);
        for my $file (find_file_w($img, $shellpatt)) {
          print $file, "\n";
        }
      }
    } elsif ($verb eq 'cp' || $verb eq 'copy') {
      my $src = shift @positional;
      my $dest = shift @positional;
      if (!defined $dest) {
        die "cp requires two arguments\n";
      }
      do_cp($src, $dest);
    } elsif ($verb eq 'cat' ){
      if (!@positional) {
        die "cat requires one or more arguments\n";
      }
      while (@positional) {
        my $src = shift @positional;
        my ($ch, $size) = open_file('<', $src);
        if (!$dry_run) {
          my $buffer;
          my $rslt = read($ch, $buffer, $size);
          $rslt == $size || die "Bad read: $rslt not $size\n";
          print STDOUT $buffer;
        }
      }

    } elsif ($verb eq 'test' ){
      my $src = shift @positional;
      if (!defined $src) {
        die "test requires an argument\n";
      }
      my ($ch, $size) = open_file('<', $src);
      print "$src : $size\n";
    } else {
      print $STDERR "Unrecognized verb '$verb'\n";
      usage(1);
    }
  }
}