From dfe7a42c9a2ee835a7a413c97c71348d2de72f04 Mon Sep 17 00:00:00 2001 From: Leeland Heins Date: Wed, 16 Jan 2019 10:55:54 -0600 Subject: [PATCH] Added proread.pl --- ProDOS.pm | 191 +++++++++++++++++++++++++++++++++++++++++++++++++---- proread.pl | 64 ++++++++++++++++++ 2 files changed, 241 insertions(+), 14 deletions(-) create mode 100644 proread.pl diff --git a/ProDOS.pm b/ProDOS.pm index 984fcb8..10f45e7 100644 --- a/ProDOS.pm +++ b/ProDOS.pm @@ -560,7 +560,7 @@ sub parse_key_vol_dir_blk { my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, $dir_ents) = unpack $key_vol_dir_blk_tmpl, $buf; - my $storage_type = $storage_type_name_length & 0xf0; + my $storage_type = ($storage_type_name_length & 0xf0) >> 4; my $name_length = $storage_type_name_length & 0x0f; my $volname = substr($volume_name, 0, $name_length); @@ -570,7 +570,7 @@ sub parse_key_vol_dir_blk { my @files = (); for (my $i = 0; $i < 12; $i++) { my $storage_type_name_length = shift @flds; - my $storage_type = $storage_type_name_length & 0xf0; + my $storage_type = ($storage_type_name_length & 0xf0) >> 4; my $name_length = $storage_type_name_length & 0x0f; my $file_name = shift @flds; my $fname = substr($file_name, 0, $name_length); @@ -598,7 +598,7 @@ sub parse_key_vol_dir_blk { if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; - push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; + push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer, 'storage_type' => $storage_type }; } } @@ -636,9 +636,9 @@ sub parse_vol_dir_blk { my @files = (); for (my $i = 0; $i < 12; $i++) { my $storage_type_name_length = shift @flds; - my $file_name = shift @flds; - my $storage_type = $storage_type_name_length & 0xf0; + my $storage_type = ($storage_type_name_length & 0xf0) >> 4; my $name_length = $storage_type_name_length & 0x0f; + my $file_name = shift @flds; my $fname = substr($file_name, 0, $name_length); my $file_type = shift @flds; my $key_pointer = shift @flds; @@ -664,7 +664,7 @@ sub parse_vol_dir_blk { if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; - push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; + push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer, 'storage_type' => $storage_type }; } } @@ -697,7 +697,7 @@ sub parse_subdir_hdr_blk { my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $foo, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, $dir_ents) = unpack $subdir_hdr_blk_tmpl, $buf; - my $storage_type = $storage_type_name_length & 0xf0; + my $storage_type = ($storage_type_name_length & 0xf0) >> 4; my $name_length = $storage_type_name_length & 0x0f; my $subdir_nm = substr($subdir_name, 0, $name_length); @@ -707,9 +707,9 @@ sub parse_subdir_hdr_blk { my @files = (); for (my $i = 0; $i < 12; $i++) { my $storage_type_name_length = shift @flds; - print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length) if $debug; - my $storage_type = $storage_type_name_length & 0xf0; - print sprintf("storage_type=%02x\n", $storage_type) if $debug; + my $storage_type = ($storage_type_name_length & 0xf0) >> 4; + print sprintf("storage_type_name_length=%02x\n", $storage_type_name_length); + print sprintf("storage_type=%02x\n", $storage_type); my $name_length = $storage_type_name_length & 0x0f; print sprintf("name_length=%02x\n", $name_length) if $debug; my $file_name = shift @flds; @@ -740,7 +740,7 @@ sub parse_subdir_hdr_blk { if ($storage_type != 0) { my $f_type = $ftype{$file_type}; $f_type = sprintf("\$%02x", $file_type) unless defined $f_type; - push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer }; + push @files, { 'filename' => $fname, 'ftype' => $f_type, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type, 'atype' => $atype, 'access' => $access, 'eof' => $endfile, 'keyptr' => $key_pointer, 'storage_type' => $storage_type }; } } @@ -838,22 +838,179 @@ sub cat { } } +# Parse master index block (tree file) +sub parse_master_ind_blk { + my ($buf, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; +} + +# Get master index block (tree file) sub get_master_ind_blk { - my ($pofile, $blk, $dbg) = @_; + my ($pofile, $master_ind_blk, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + print "pofile=$pofile master_ind_blk=$master_ind_blk\n"; + + my $buf; + + my @blocks = (); + + if (read_blk($pofile, $master_ind_blk, \$buf)) { + dump_blk($buf) if $debug; + } + + return @blocks; } +# Parse index block (sapling file) +sub parse_ind_blk { + my ($buf, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; +} + +# Get index block (sapling file) sub get_ind_blk { - my ($pofile, $blk, $dbg) = @_; + my ($pofile, $ind_blk, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + print "pofile=$pofile ind_blk=$ind_blk\n"; + + my $buf; + + my @blocks = (); + + if (read_blk($pofile, $ind_blk, \$buf)) { + dump_blk($buf) if $debug; + my (@lo) = unpack "C256", $buf; + #foreach my $byte (@lo) { + # print sprintf("%02x ", $byte); + #} + #print "\n"; + my (@hi) = unpack "x256C256", $buf; + #foreach my $byte (@hi) { + # print sprintf("%02x ", $byte); + #} + #print "\n"; + for (my $b = 0; $b < 256; $b++) { + #print sprintf("lo=%02x hi=%02x\n", $lo[$b], $hi[$b]); + my $blk = ($hi[$b] << 8) | $lo[$b]; + #print sprintf("blk=%04x\n", $blk); + push @blocks, $blk; + } + } + + return @blocks; } +# +# Find a file +# sub find_file { my ($pofile, $filename, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + print "pofile=$pofile filename=$filename\n"; + + my $storage_type = 0; + my $file_type = 0x00; + my $key_pointer = 0x00; + my $blocks_used = 0x00; + + my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, @files) = get_key_vol_dir_blk($pofile, $debug); + + my $found_it = 0; + foreach my $file (@files) { + #print "file=$file->{'filename'}\n"; + if ($file->{'filename'} eq $filename) { + #print "FOUND IT!\n"; + $found_it = 1; + $storage_type = $file->{'storage_type'}; + $file_type = $file->{'ftype'}; + $key_pointer = $file->{'keyptr'}; + $blocks_used = $file->{'used'}; + last; + } + } + + if (! $found_it) { + my $vol_dir_blk = $nxt_vol_dir_blk; + + while ($vol_dir_blk) { + my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug); + + foreach my $file (@files) { + #print "file=$file->{'filename'}\n"; + if ($file->{'filename'} eq $filename) { + #print "FOUND IT!\n"; + $found_it = 1; + $storage_type = $file->{'storage_type'}; + $file_type = $file->{'ftype'}; + $key_pointer = $file->{'keyptr'}; + $blocks_used = $file->{'used'}; + last; + } + } + $vol_dir_blk = $nxt_vol_dir_blk; + last if $found_it; + } + } + + return $storage_type, $file_type, $key_pointer, $blocks_used; } +# +# Read a file +# sub read_file { - my ($pofile, $filename, $dbg) = @_; + my ($pofile, $filename, $mode, $conv, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + print "pofile=$pofile filename=$filename mode=$mode conv=$conv\n"; + + my ($storage_type, $file_type, $key_pointer, $blocks_used) = find_file($pofile, $filename, $debug); + + my $buf; + + print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used\n"; + # Seedling file, only 1 block + if ($storage_type == 1) { + if (read_blk($pofile, $key_pointer, \$buf)) { + #dump_blk($buf) if $debug; + dump_blk($buf); + } + # Sapling file, 2-256 blocks + } elsif ($storage_type == 2) { + my @blks = get_ind_blk($pofile, $key_pointer, $debug); + + my $buf2; + + my $blkno = 1; + foreach my $blk (@blks) { + #print "blkno=$blkno blk=$blk\n"; + if (read_blk($pofile, $blk, \$buf2)) { + #dump_blk($buf2) if $debug; + dump_blk($buf2); + } + last if $blkno++ == $blocks_used - 1; + } + # Tree file, 257+ blocks + } elsif ($storage_type == 3) { + my @blks = get_master_ind_blk($pofile, $key_pointer, $debug); + ##FIXME -- need to handle Tree files here. + } else { + print "Not a regular file!\n"; + } } +# +# Parse volume bit map +# sub parse_vol_bit_map { my ($buf, $dbg) = @_; @@ -871,6 +1028,9 @@ sub parse_vol_bit_map { return @blocks; } +# +# Get volume bit map +# sub get_vol_bit_map { my ($pofile, $dbg) = @_; @@ -910,6 +1070,9 @@ sub get_vol_bit_map { return @blocks; } +# +# Display blocks free map +# sub freemap { my ($pofile, $dbg) = @_; diff --git a/proread.pl b/proread.pl new file mode 100644 index 0000000..8024c79 --- /dev/null +++ b/proread.pl @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +# +# proread.pl: +# +# Utility to read a file out of an Apple II ProDOS .po disk image. +# +# 20190116 LSH +# + +use strict; + +use ProDOS; + +my $mode = 'T'; +my $conv = 1; +my $debug = 0; + +while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { + # Mode + if ($ARGV[0] eq '-m' && defined $ARGV[1] && $ARGV[1] ne '') { + # Text + if ($ARGV[1] eq 'T') { + $mode = 'T'; + $conv = 1; + # Integer BASIC + } elsif ($ARGV[1] eq 'I') { + $mode = 'I'; + $conv = 0; + # Applesoft + } elsif ($ARGV[1] eq 'A') { + $mode = 'A'; + $conv = 0; + # Binary + } elsif ($ARGV[1] eq 'B') { + $mode = 'B'; + $conv = 0; + # S + } elsif ($ARGV[1] eq 'S') { + $mode = 'S'; + $conv = 0; + } else { + die "Unknown mode for -m, must be T, I, A, B or S\n"; + } + shift; + shift; + # Convert (carriage return to linefeed) + } elsif ($ARGV[0] eq '-c') { + $conv = 0; + shift; + # Debug + } elsif ($ARGV[0] eq '-d') { + $debug = 1; + shift; + } +} + +my $pofile = shift or die "Must supply filename\n"; +my $filename = shift or die "Must supply filename\n"; + +read_file($pofile, $filename, $mode, $conv, $debug); + +1; +