Skip to content

Commit

Permalink
extfs/img: New file - support for MS-DOS disk images.
Browse files Browse the repository at this point in the history
  • Loading branch information
twojstaryzdomu committed Sep 4, 2021
1 parent 4973eb0 commit 4e3f651
Show file tree
Hide file tree
Showing 2 changed files with 93 additions and 1 deletion.
2 changes: 1 addition & 1 deletion src/vfs/extfs/helpers/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -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 = \
Expand Down
92 changes: 92 additions & 0 deletions src/vfs/extfs/helpers/img
Original file line number Diff line number Diff line change
@@ -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";

0 comments on commit 4e3f651

Please sign in to comment.