From dc356f7ee8ba4ea084c79c9e6c4b4f7e335ff697 Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Sun, 5 Sep 2021 04:22:36 +0200 Subject: [PATCH 1/7] extfs/img: New file - support for MS-DOS disk images. --- misc/mc.ext.in | 4 ++ src/vfs/extfs/helpers/Makefile.am | 2 +- src/vfs/extfs/helpers/img | 94 +++++++++++++++++++++++++++++++ 3 files changed, 99 insertions(+), 1 deletion(-) create mode 100755 src/vfs/extfs/helpers/img diff --git a/misc/mc.ext.in b/misc/mc.ext.in index e821900b8f..d71b4fc518 100644 --- a/misc/mc.ext.in +++ b/misc/mc.ext.in @@ -288,6 +288,10 @@ shell/.deba Open=%cd %p/deba:// View=%view{ascii} @EXTHELPERSDIR@/package.sh view deba +# MS-DOS disk image +shell/i/.img + Open=%cd %p/img:// + # ISO9660 shell/i/.iso Open=%cd %p/iso9660:// diff --git a/src/vfs/extfs/helpers/Makefile.am b/src/vfs/extfs/helpers/Makefile.am index f1ea0acc32..e46f6068d6 100644 --- a/src/vfs/extfs/helpers/Makefile.am +++ b/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 = \ diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img new file mode 100755 index 0000000000..6ea2de17ae --- /dev/null +++ b/src/vfs/extfs/helpers/img @@ -0,0 +1,94 @@ +#!/usr/bin/env perl +# VFS-wrapper for MS-DOS IMG files using mtools +# +# Written by twojstaryzdomu (twojstaryzdomu@users.noreply.github.com), 2021 +# + +my ( $cmd, $archive, @args ) = @ARGV; +die "$archive does not exist\n" unless -f "$archive"; +my $size_kb = ( -s $archive ) / 1024; +my $drive = 'b'; + +my $actions = { + list => "mdir -f -i \'$archive\'", + copyout => "mcopy -m -n -o -p -i \'$archive\'", + copyin => "mcopy -m -n -o -p -i \'$archive\'", + rm => "mdel -i \'$archive\'", + mkdir => "mmd -i \'$archive\'", + rmdir => "mrd -i \'$archive\'", + run => "dosbox -noautoexec -c \'IMGMOUNT -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c", + test => "logger \'$archive\'" +}; + +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 check_mtools { + my $cmd = shift; + my ( $tool ) = $actions->{ $cmd } =~ /^(\w+)/; + foreach ( split( ":", $ENV{PATH} ) ) { + return 1 if -e "$_/$tool" + } + return; +} + +sub default_handler { + my ( $cmd, $archive, @args ) = ( @_ ); + print_debug "default_handler: @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 } @args"; + if ( $cmd eq 'list' ) { + my $exec = check_mtools( run ) + ? 'rwxr-xr-x' + : 'rw-r--r--'; + 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 '' + ? '-' + : 'd' ) + . ( ( $ext eq 'exe' || $ext eq 'com' || $ext eq 'bat' ) + ? $exec + : 'rw-r--r--' ); + 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 '' ? $size : 0, $mon, $day, $year, $hours, $mins, $secs, $path + . "\n"; + default_handler( $cmd, $archive, $path ) if ( $size eq '' ); + } + else { + print_debug "list: skipped: $_"; + } + } + } +} + +print_debug "$0: cmd = $cmd; archive = $archive; args = @args"; +die "Cannot find command $cmd, are mtools installed?\n" unless check_mtools( $cmd ); +exists $actions->{ $cmd } ? default_handler( $cmd, $archive, @args ) + : die "mode $cmd not available\n"; From 28a96487a138a054b5f0eef079a81181322c973a Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Tue, 7 Sep 2021 11:16:37 +0200 Subject: [PATCH 2/7] extfs/img: Lister improvements. Use single run of mdir instead of recursive. Improved support for long filenames. Allow leading spaces in filenames. Support for extfs test. --- src/vfs/extfs/helpers/img | 43 +++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index 6ea2de17ae..1510823104 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -10,7 +10,7 @@ my $size_kb = ( -s $archive ) / 1024; my $drive = 'b'; my $actions = { - list => "mdir -f -i \'$archive\'", + list => "mdir -s -f -i \'$archive\'", copyout => "mcopy -m -n -o -p -i \'$archive\'", copyin => "mcopy -m -n -o -p -i \'$archive\'", rm => "mdel -i \'$archive\'", @@ -20,7 +20,8 @@ my $actions = { test => "logger \'$archive\'" }; -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*$"; +my $regex_dir = qr"(?<=^Directory for ::/)(.*)$"; +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?(.*)$"; sub print_debug { print "@_\n" if exists $ENV{DEBUG}; @@ -55,40 +56,48 @@ sub default_handler { elsif ( $cmd eq 'copyout' ) { $args[0] = "::$args[0]"; } - my $output = run_cmd "$actions->{ $cmd } @args"; + my $input = run_cmd "$actions->{ $cmd } @args"; if ( $cmd eq 'list' ) { + my $output = {}; my $exec = check_mtools( run ) - ? 'rwxr-xr-x' - : 'rw-r--r--'; - foreach ( @{ $output } ) { + ? '-rwxr-xr-x' + : '-rw-r--r--'; + my $dir; + foreach ( @{ $input } ) { chomp; next if /^$/; + if ( /$regex_dir/ ) { + $dir = "$1"; + next; + } 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"; + print_debug "list: dir = $dir, 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 '' - ? '-' - : 'd' ) - . ( ( $ext eq 'exe' || $ext eq 'com' || $ext eq 'bat' ) + my $perms = $size eq '' + ? 'drwxr-xr-x' + : ( $ext eq 'exe' || $ext eq 'com' || $ext eq 'bat' ) ? $exec - : 'rw-r--r--' ); - my $path = $longname - ? "$args[0]/$longname" - : uc( "$args[0]/$name" . ( $ext ? ".$ext" : "" ) ); + : '-rw-r--r--'; + my $path = ( $dir ? "/$dir/" : "/" ) + . ( $longname ? $longname : $name ) + . ( $ext ? ".$ext" : "" ); + $path = uc( $path ) unless $longname; $secs = defined $secs ? $secs : "00"; - printf "%-10s 1 %-8d %-8d %8s %s/%s/%s %s:%s:%s %s", $perms, $<, + print_debug "list: path = $path"; + $output->{ $path } = sprintf "%-10s 1 %-8d %-8d %8s %s/%s/%s %s:%s:%s %s", $perms, $<, $(, $size ne '' ? $size : 0, $mon, $day, $year, $hours, $mins, $secs, $path . "\n"; - default_handler( $cmd, $archive, $path ) if ( $size eq '' ); } else { print_debug "list: skipped: $_"; } } + print foreach map { $output->{ $_ } } sort keys %{ $output }; } } print_debug "$0: cmd = $cmd; archive = $archive; args = @args"; +$actions->{ $cmd } = $ENV{MC_TEST_EXTFS_LIST_CMD} if exists $ENV{MC_TEST_EXTFS_LIST_CMD}; die "Cannot find command $cmd, are mtools installed?\n" unless check_mtools( $cmd ); exists $actions->{ $cmd } ? default_handler( $cmd, $archive, @args ) : die "mode $cmd not available\n"; From 2339394cfafdd5d1c9f127cb767d7d1c2395ce0b Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Tue, 7 Sep 2021 11:23:12 +0200 Subject: [PATCH 3/7] extfs/img: Fixed capitalising dos short name path components. Refactored quoting & input parameter processing. Removed short name copy restrictions. --- src/vfs/extfs/helpers/img | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index 1510823104..2d3481db5b 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -4,6 +4,8 @@ # Written by twojstaryzdomu (twojstaryzdomu@users.noreply.github.com), 2021 # +# Undefine to disable upper-casing short names +my $uc = 1; my ( $cmd, $archive, @args ) = @ARGV; die "$archive does not exist\n" unless -f "$archive"; my $size_kb = ( -s $archive ) / 1024; @@ -46,15 +48,9 @@ sub check_mtools { sub default_handler { my ( $cmd, $archive, @args ) = ( @_ ); print_debug "default_handler: @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' ) { + if ( $cmd =~ /^copy(\S+)/ ) { $args[0] = "::$args[0]"; + @args = reverse @args if ( $1 eq 'in' ); } my $input = run_cmd "$actions->{ $cmd } @args"; if ( $cmd eq 'list' ) { @@ -67,7 +63,14 @@ sub default_handler { chomp; next if /^$/; if ( /$regex_dir/ ) { - $dir = "$1"; + @dir = split( "/", $1 ); + if ( $uc ) { + foreach ( 0 .. $#dir ) { + my $udir = uc( $dir[$_] ); + $dir[$_] = $udir if exists $output->{ join( "/", @dir[0..$_-1] ) . "/$udir" }; + } + } + $dir = join( "/", @dir ); next; } if ( my ( $name, $ext, $size, $year, $mon, $day, $hours, $mins, $longname ) = $_ =~ /$regex_list/ ) { @@ -78,10 +81,11 @@ sub default_handler { : ( $ext eq 'exe' || $ext eq 'com' || $ext eq 'bat' ) ? $exec : '-rw-r--r--'; + $name = uc( $name ) if $uc; my $path = ( $dir ? "/$dir/" : "/" ) - . ( $longname ? $longname : $name ) - . ( $ext ? ".$ext" : "" ); - $path = uc( $path ) unless $longname; + . ( $longname + ? $longname + : $name . ( $ext ? ".$ext" : "" ) ); $secs = defined $secs ? $secs : "00"; print_debug "list: path = $path"; $output->{ $path } = sprintf "%-10s 1 %-8d %-8d %8s %s/%s/%s %s:%s:%s %s", $perms, $<, @@ -96,7 +100,12 @@ sub default_handler { } } +sub quote { + map { '"' . $_ . '"' } @_ +} + print_debug "$0: cmd = $cmd; archive = $archive; args = @args"; +@args = quote( @args ); $actions->{ $cmd } = $ENV{MC_TEST_EXTFS_LIST_CMD} if exists $ENV{MC_TEST_EXTFS_LIST_CMD}; die "Cannot find command $cmd, are mtools installed?\n" unless check_mtools( $cmd ); exists $actions->{ $cmd } ? default_handler( $cmd, $archive, @args ) From 2b7e1e744146e16bc5f224a07ce3e8279923f940 Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Tue, 7 Sep 2021 18:03:58 +0200 Subject: [PATCH 4/7] extfs/img: Overwrite conflicting files/directories during mkdir. --- src/vfs/extfs/helpers/img | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index 2d3481db5b..efa5f57dcd 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -16,7 +16,7 @@ my $actions = { copyout => "mcopy -m -n -o -p -i \'$archive\'", copyin => "mcopy -m -n -o -p -i \'$archive\'", rm => "mdel -i \'$archive\'", - mkdir => "mmd -i \'$archive\'", + mkdir => "mmd -D o -i \'$archive\'", rmdir => "mrd -i \'$archive\'", run => "dosbox -noautoexec -c \'IMGMOUNT -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c", test => "logger \'$archive\'" From 8297995cb162b13d77fa5afd124884248e6c97f5 Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Tue, 7 Sep 2021 18:12:49 +0200 Subject: [PATCH 5/7] extfs/img: Always delete recursively. --- src/vfs/extfs/helpers/img | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index efa5f57dcd..3214d810a4 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -15,7 +15,7 @@ my $actions = { list => "mdir -s -f -i \'$archive\'", copyout => "mcopy -m -n -o -p -i \'$archive\'", copyin => "mcopy -m -n -o -p -i \'$archive\'", - rm => "mdel -i \'$archive\'", + rm => "mdeltree -i \'$archive\'", mkdir => "mmd -D o -i \'$archive\'", rmdir => "mrd -i \'$archive\'", run => "dosbox -noautoexec -c \'IMGMOUNT -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c", From 7d054cae50c025f256500736f36a1c70615fb6ef Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Tue, 7 Sep 2021 18:18:51 +0200 Subject: [PATCH 6/7] extfs/img: Lower case dos command. --- src/vfs/extfs/helpers/img | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index 3214d810a4..9962f5cb12 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -18,7 +18,7 @@ my $actions = { rm => "mdeltree -i \'$archive\'", mkdir => "mmd -D o -i \'$archive\'", rmdir => "mrd -i \'$archive\'", - run => "dosbox -noautoexec -c \'IMGMOUNT -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c", + run => "dosbox -noautoexec -c \'imgmount -size $size_kb $drive: \'$archive\'\' -c '$drive:\' -c", test => "logger \'$archive\'" }; From c1b8c2249c834588bbd2e183587849982136886c Mon Sep 17 00:00:00 2001 From: twojstaryzdomu Date: Wed, 8 Sep 2021 16:14:19 +0200 Subject: [PATCH 7/7] extfs/img: Refactored mdir parsing with MTOOLS_DOTTED_DIR. --- src/vfs/extfs/helpers/img | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/vfs/extfs/helpers/img b/src/vfs/extfs/helpers/img index 9962f5cb12..2c5b514440 100755 --- a/src/vfs/extfs/helpers/img +++ b/src/vfs/extfs/helpers/img @@ -23,7 +23,9 @@ my $actions = { }; my $regex_dir = qr"(?<=^Directory for ::/)(.*)$"; -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?(.*)$"; +# Required for regex +$ENV{MTOOLS_DOTTED_DIR} = 1; +my $regex_list = qr"^(\S+)\s+(\S+)\s+(\d{4})-(\d{2})-(\d{2})\s+(\d{1,2}):(\d{1,2})\s\s?(.*)$"; sub print_debug { print "@_\n" if exists $ENV{DEBUG}; @@ -73,19 +75,17 @@ sub default_handler { $dir = join( "/", @dir ); next; } - if ( my ( $name, $ext, $size, $year, $mon, $day, $hours, $mins, $longname ) = $_ =~ /$regex_list/ ) { - print_debug "list: dir = $dir, name = $name, ext = $ext, size = $size, year = $year, mon = $mon, day = $day, hours = $hours, mins = $mins, longname = $longname;"; - next if ( $name eq '.' || $name eq '..' ); + if ( my ( $filename, $size, $year, $mon, $day, $hours, $mins, $longname ) = $_ =~ /$regex_list/ ) { + print_debug "list: dir = $dir, filename = $filename, size = $size, year = $year, mon = $mon, day = $day, hours = $hours, mins = $mins, longname = $longname;"; + next if ( $filename =~ /^\.\.?$/ ); my $perms = $size eq '' ? 'drwxr-xr-x' - : ( $ext eq 'exe' || $ext eq 'com' || $ext eq 'bat' ) + : $filename =~ /\.(?:exe|bat|com)$/i ? $exec : '-rw-r--r--'; - $name = uc( $name ) if $uc; + $filename = uc( $filename ) if $uc; my $path = ( $dir ? "/$dir/" : "/" ) - . ( $longname - ? $longname - : $name . ( $ext ? ".$ext" : "" ) ); + . ( $longname ? $longname : $filename ); $secs = defined $secs ? $secs : "00"; print_debug "list: path = $path"; $output->{ $path } = sprintf "%-10s 1 %-8d %-8d %8s %s/%s/%s %s:%s:%s %s", $perms, $<,