extfs/img: New file - support for MS-DOS disk images.

Author: twojstaryzdomu

src/vfs/extfs/helpers/Makefile.am

@@ -4,7 +4,7 @@ extfsdir = $(libexecdir)/@PACKAGE@/extfs.d
 EXTFS_MISC  = README README.extfs
 
 # Scripts hat don't need adaptation to the local system
-EXTFS_CONST = bpp changesetfs gitfs+ patchsetfs rpm trpm u7z uc1541
+EXTFS_CONST = bpp changesetfs gitfs+ img patchsetfs rpm trpm u7z uc1541
 
 # Scripts that need adaptation to the local system - source files
 EXTFS_IN    = 			\

src/vfs/extfs/helpers/img

@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+# VFS-wrapper for MS-DOS IMG files using mtools
+#
+# Written by twojstaryzdomu ([email protected]), 2011
+#
+
+my ( $cmd, $archive, @args )        = @ARGV;
+my $drive                           = 'b';
+my $actions                         = {
+  list                              => "mdir -f -i",
+  copyout                           => "mcopy -m -n -o -p -i",
+  copyin                            => "mcopy -m -n -o -p -i",
+  rm                                => "mdel -i",
+  mkdir                             => "mmd -i",
+  rmdir                             => "mrd -i",
+  test                              => "logger"
+};
+
+my $regex_list                      = qr"^(\S+)\s+(\S*)\s+(\S+)\s+(\d{4})-(\d{2})-(\d{2})\s+(\d{1,2}):(\d{1,2})(?:\s*)(\S+)*\s*$";
+
+sub print_debug {
+  print "@_\n" if exists $ENV{DEBUG};
+}
+
+sub run_cmd {
+  my $cmd                           = shift;
+  my @output                        = ( do { open( my $line, "$cmd | " ) or die "$0: Can't run $cmd"; <$line>; } );
+  print_debug "run_cmd $cmd";
+  return \@output;
+}
+
+sub default_handler {
+  my ( $cmd, $archive, @args )      = ( @_ );
+  if ( $cmd eq 'copyin' ) {
+    if ( my ( $name, $ext )         = $args[0] =~ /(\w+)\.(\w+)$/ ) {
+      die "filename $name.$ext too long to copy to $archive\n" if ( length( $name ) > 8 || length( $ext ) > 3 );
+    }
+    $args[0]                        = "::$args[0]";
+    @args                           = reverse @args;
+  }
+  elsif ( $cmd eq 'copyout' ) {
+    $args[0]                        = "::$args[0]";
+  }
+  my $output                        = run_cmd "$actions->{ $cmd } \'$archive\' @args";
+  if ( $cmd eq 'list' ) {
+    foreach ( @{ $output } ) {
+      chomp;
+      next if /^$/;
+      if ( my ( $name, $ext, $size, $year, $mon, $day, $hours, $mins, $longname ) = $_ =~ /$regex_list/ ) {
+        print_debug "list: name = $name, ext = $ext, size = $size, year = $year, mon = $mon, day = $day, hours = $hours, mins = $mins, longname = $longname";
+        next if ( $name eq '.' || $name eq '..' );
+        my $perms                   = $size ne '<DIR>'
+                                    ? '-rw-r--r--'
+                                    : 'drwxr-xr-x';
+        my $path                    = $longname ? "$args[0]/" . $longname
+                                                : uc( "$args[0]/" . $name )
+                                    . ( $ext ? ".$ext"
+                                             : "" );     
+        $secs                       = defined $secs ? $secs : "00";
+        printf "%-10s    1 %-8d %-8d %8s %s/%s/%s %s:%s:%s %s", $perms, $<,
+                                    $(, $size ne '<DIR>' ? $size : 0, $mon, $day, $year, $hours, $mins, $secs, $path
+                                    . "\n";
+        default_handler( $cmd, $archive, $path ) if ( $size eq '<DIR>' );
+      }
+      else {
+        print_debug "list: skipped: $_";
+      }
+    }
+  }
+}
+
+sub run {
+  my ( $archive, @args )            = ( @_ );
+  my $size_kb                       = ( -s $archive ) / 1024;
+  my $cmd                           = "dosbox -noautoexec -c \'IMGMOUNT -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c";
+  my $output                        = run_cmd "$cmd @args";
+}
+
+sub check_mtools {
+  my $cmd                           = shift;
+  my ( $tool )                      = $actions->{ $cmd } =~ /^(\w+)/;
+  foreach ( split( ":", $ENV{PATH} ) ) {
+    $found                          = 1 if -e "$_/$tool"
+  }
+  die "Cannot find command $cmd, are mtools installed?\n" unless $found;
+}
+
+print_debug "$0: cmd = $cmd; archive = $archive; args = @args";
+check_mtools( $cmd );
+die "$archive does not exist\n" unless -f "$archive";
+exists $actions->{ $cmd }           ? default_handler( $cmd, $archive, @args )
+                                    : die "mode $cmd not available\n";