From 904c9ef7493ceafc2aca72f8addc574521b79971 Mon Sep 17 00:00:00 2001 From: Leeland Heins Date: Mon, 14 Jan 2019 10:39:07 -0600 Subject: [PATCH] Partial implementation of procat.pl --- ProDOS.pm | 287 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- procat.pl | 76 +++++++++++++++ 2 files changed, 353 insertions(+), 10 deletions(-) create mode 100644 procat.pl diff --git a/ProDOS.pm b/ProDOS.pm index bebe78d..7be4320 100644 --- a/ProDOS.pm +++ b/ProDOS.pm @@ -10,10 +10,66 @@ use Exporter::Auto; my $debug = 0; +# ProDOS file types +my %ftype = ( + # 00 Typeless file + 0x00 => ' ', + # 01 BAD Bad block(s) file + 0x01 => 'BAD', + # 04 TXT Text file (ASCII text, msb off) + 0x04 => 'TXT', + # 06 BIN Binary file (8-bit binary image) + 0x06 => 'BIN', + # 0f DIR Directory file + 0x0f => 'DIR', + # 19 ADB AppleWorks data base file + 0x19 => 'ADB', + # 1a AWP AppleWorks word processing file + 0x1a => 'AWP', + # 1b ASP AppleWorks spreadsheet file + 0x1b => 'ASP', + # ef PAS ProDOS PASCAL file + 0xef => 'PAS', + # f0 CMD ProDOS added command file + 0xf0 => 'CMD', + # f1-f8 User defined file types 1 through 8 + 0xf1 => 'UD1', + 0xf2 => 'UD2', + 0xf3 => 'UD3', + 0xf4 => 'UD4', + 0xf5 => 'UD5', + 0xf6 => 'UD6', + 0xf7 => 'UD7', + 0xf8 => 'UD8', + # fc BAS Applesoft BASIC program file + 0xfc => 'BAS', + # fd VAR Applesoft stored variables file + 0xfd => 'VAR', + # fe REL Relocatable object module file (EDASM) + 0xfe => 'REL', + # ff SYS ProDOS system file + 0xff => 'SYS', +); + +my %months = ( + 1, 'JAN', + 2, 'FEB', + 3, 'MAR', + 4, 'APR', + 5, 'MAY', + 6, 'JUN', + 7, 'JUL', + 8, 'AUG', + 9, 'SEP', + 10, 'OCT', + 11, 'NOV', + 12, 'DEC', +); + my $key_vol_dir_blk = 2; # -# Volume Directory Block +# Key Volume Directory Block # # 00-01 Previous Volume Directory Block # 02-03 Next Volume Directory Block @@ -36,7 +92,9 @@ my $key_vol_dir_blk = 2; # 27-28 BIT_MAP_POINTER # 29-2a TOTAL_BLOCKS # -my $vol_dir_blk_tmpl = 'vvCa15x8nnCCCCCvvv'; +my $key_vol_dir_blk_tmpl = 'vvCa15x8nnCCCCCvvva470'; + +my $vol_dir_blk_tmpl = 'vva504'; # # Volume Bit Map @@ -95,17 +153,81 @@ my $vol_bit_map_tmpl = 'C*'; # 21-24 LAST_MOD # 25-26 HEADER_POINTER # -my $file_desc_ent_tmpl = 'Ca15CnnnnnCCCa8nnCC'; +my $file_desc_ent_tmpl = 'Ca15Cvva3nnCCCvnnv'; -# Parse a Volume Directory Block -sub parse_vol_dir_blk { +my $key_dir_file_desc_ent_tmpl = ''; +for (my $i = 0; $i < 12; $i++) { + $key_dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl; +} + +my $dir_file_desc_ent_tmpl = ''; +for (my $i = 0; $i < 12; $i++) { + $dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl; +} + +sub date_convert { + my ($ymd, $hm) = @_; + + #my $cr1 = unpack "b16", hex($ymd); + + #print "cr1=$cr1\n"; + + #my $yy = substr($cr1, 0, 7); + #print "yy=$yy\n"; + #my $year = oct('0b' . $yy); + #print "year=$year\n"; + #my $mm = substr($cr1, 7, 4); + #print "mm=$mm\n"; + #my $mon = oct('0b' . $mm); + #print "mon=$mon\n"; + #my $dd = substr($cr1, 11, 5); + #print "dd=$dd\n"; + #my $day = oct('0b' . $dd); + #print "day=$day\n"; + + #my $cr2 = unpack "B16", $hm; + + #print "cr2=$cr2\n"; + + #my $hh = substr($cr2, 3, 5); + #my $hour = oct('0b' . $hh); + #print "hour=$hour\n"; + #my $mm = substr($cr2, 10, 6); + #my $min = oct('0b' . $mm); + #print "min=$min\n"; + + my $year = ($ymd & 0xfe00) >> 9; # bits 9-15 + my $mon = (($ymd & 0x01e0) >> 5) - 1; # bits 5-8 + my $day = $ymd & 0x001f; # bits 0-4 + my $hour = ($hm & 0x1f00) >> 8; # bits 8-12 + my $min = $hm & 0x003f; # bits 0-5 + + return "" if $day < 1; + + #$year += 1970; + $mon = 1 if $mon < 1; + $day = 1 if $day < 1; + #$year += 2000 if ($year < 50); + #$year += 1900 if ($year < 100); + + return sprintf("%-2d-%s-%02d %2d:%02d", $day, $months{$mon}, $year, $hour, $min); +} + +# Parse Key Volume Directory Block +sub parse_key_vol_dir_blk { my ($buf, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; - my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_yymmdd, $creation_hhmm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks) = unpack $vol_dir_blk_tmpl, $buf; + 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; + print sprintf("storage_type=%02x\n", $storage_type) if $debug; my $name_length = $storage_type_name_length & 0x0f; + print sprintf("name_length=%02x\n", $name_length) if $debug; + + my $volname = substr($volume_name, 0, $name_length); + if ($debug) { print sprintf("prv_vol_dir_blk=%04x\n", $prv_vol_dir_blk); print sprintf("nxt_vol_dir_blk=%04x\n", $nxt_vol_dir_blk); @@ -113,7 +235,10 @@ sub parse_vol_dir_blk { print sprintf("name_length=%02x\n", $name_length); print sprintf("volume_name=%s\n", $volume_name); print sprintf("volume_name=%s\n", substr($volume_name, 0, $name_length)); - print sprintf("creation=%04x%04x\n", $creation_yymmdd, $creation_hhmm); + print sprintf("creation=%04x %04x\n", $creation_ymd, $creation_hm); +print"\n"; + print sprintf("create_date=%s\n", date_convert($creation_ymd, $creation_hm)); +print"\n"; print sprintf("version=%02x\n", $version); print sprintf("min_version=%02x\n", $min_version); print sprintf("access=%02x\n", $access); @@ -124,13 +249,68 @@ sub parse_vol_dir_blk { print sprintf("total_blocks=%02x\n", $total_blocks); } - return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volume_name, $creation_yymmdd, $creation_hhmm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks; + my @flds = unpack $key_dir_file_desc_ent_tmpl, $dir_ents; + + 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 $name_length = $storage_type_name_length & 0x0f; + print sprintf("name_length=%02x\n", $name_length) if $debug; + my $file_name = shift @flds; + print sprintf("file_name=%s\n", $file_name) if $debug; + my $fname = substr($file_name, 0, $name_length); + print sprintf("fname=%s\n", $fname) if $debug; + my $file_type = shift @flds; + print sprintf("file_type=%02x\n", $file_type) if $debug; + my $key_pointer = shift @flds; + print sprintf("key_pointer=%04x\n", $key_pointer) if $debug; + my $blocks_used = shift @flds; + print sprintf("blocks_used=%04x\n", $blocks_used) if $debug; + my $eof = shift @flds; + #print sprintf("eof=%04x\n", $eof); + my $creation_ymd = shift @flds; + print sprintf("creation_ymd=%04x\n", $creation_ymd) if $debug; + my $creation_hm = shift @flds; + print sprintf("creation_hm=%04x\n", $creation_hm) if $debug; + my $cdate = date_convert($creation_ymd, $creation_hm); + print sprintf("create_date=%s\n", $cdate) if $debug; + my $version = shift @flds; + print sprintf("version=%02x\n", $version) if $debug; + my $min_version = shift @flds; + print sprintf("min_version=%02x\n", $min_version) if $debug; + my $access = shift @flds; + print sprintf("access=%02x\n", $access) if $debug; + my $aux_type = shift @flds; + print sprintf("aux_type=%02x\n", $aux_type) if $debug; + my $last_mod_ymd = shift @flds; + print sprintf("last_mod_ymd=%04x\n", $last_mod_ymd) if $debug; + my $last_mod_hm = shift @flds; + my $mdate = date_convert($last_mod_ymd, $last_mod_hm); + print sprintf("last_mod_hm=%04x\n", $last_mod_hm) if $debug; + my $header_pointer = shift @flds; + print sprintf("header_pointer=%04x\n", $header_pointer) if $debug; + if ($storage_type != 0) { + #print "pushing $file_name\n"; + push @files, { 'filename' => $fname, 'ftype' => $ftype{$file_type}, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type }; + } + } + + if ($debug) { + foreach my $file (@files) { + print "file=$file->{'filename'}\n"; + } + } + + return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $volname, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $bit_map_pointer, $total_blocks, @files; } # -# Get Volume Directory Block +# Get Key Volume Directory Block # -sub get_vol_dir_blk { +sub get_key_vol_dir_blk { my ($pofile, $dbg) = @_; $debug = 1 if defined $dbg && $dbg; @@ -138,6 +318,93 @@ sub get_vol_dir_blk { my $buf; if (read_blk($pofile, $key_vol_dir_blk, \$buf)) { + dump_blk($buf) if $debug; + return parse_key_vol_dir_blk($buf, $debug); + } + + return 0; +} + +# Parse Volume Directory Block +sub parse_vol_dir_blk { + my ($buf, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $dir_ents) = unpack $vol_dir_blk_tmpl, $buf; + + if ($debug) { + print sprintf("prv_vol_dir_blk=%04x\n", $prv_vol_dir_blk); + print sprintf("nxt_vol_dir_blk=%04x\n", $nxt_vol_dir_blk); + } + + my @flds = unpack $dir_file_desc_ent_tmpl, $dir_ents; + + 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 $file_name = shift @flds; + print sprintf("file_name=%s\n", $file_name) if $debug; + my $storage_type = $storage_type_name_length & 0xf0; + my $name_length = $storage_type_name_length & 0x0f; + my $fname = substr($file_name, 0, $name_length); + print sprintf("fname=%s\n", $fname) if $debug; + my $file_type = shift @flds; + print sprintf("file_type=%02x\n", $file_type) if $debug; + my $key_pointer = shift @flds; + print sprintf("key_pointer=%04x\n", $key_pointer) if $debug; + my $blocks_used = shift @flds; + print sprintf("blocks_used=%04x\n", $blocks_used) if $debug; + my $eof = shift @flds; + #print sprintf("eof=%04x\n", $eof); + my $creation_ymd = shift @flds; + print sprintf("creation_ymd=%04x\n", $creation_ymd) if $debug; + my $creation_hm = shift @flds; + print sprintf("creation_hm=%04x\n", $creation_hm) if $debug; + my $cdate = date_convert($creation_ymd, $creation_hm); + print sprintf("create_date=%s\n", $cdate) if $debug; + my $version = shift @flds; + print sprintf("version=%02x\n", $version) if $debug; + my $min_version = shift @flds; + print sprintf("min_version=%02x\n", $min_version) if $debug; + my $access = shift @flds; + print sprintf("access=%02x\n", $access) if $debug; + my $aux_type = shift @flds; + print sprintf("aux_type=%02x\n", $aux_type) if $debug; + my $last_mod_ymd = shift @flds; + print sprintf("last_mod_ymd=%04x\n", $last_mod_ymd) if $debug; + my $last_mod_hm = shift @flds; + print sprintf("last_mod_hm=%04x\n", $last_mod_hm) if $debug; + my $mdate = date_convert($last_mod_ymd, $last_mod_hm); + my $header_pointer = shift @flds; + print sprintf("header_pointer=%04x\n", $header_pointer) if $debug; + if ($storage_type != 0) { + #print "pushing $file_name\n"; + push @files, { 'filename' => $fname, 'ftype' => $ftype{$file_type}, 'used' => $blocks_used, 'mdate' => $mdate, 'cdate' => $cdate, 'atype' => $aux_type }; + } + } + + if ($debug) { + foreach my $file (@files) { + print "file=$file->{'filename'}\n"; + } + } + + return $prv_vol_dir_blk, $nxt_vol_dir_blk, @files; +} + +# +# Get Volume Directory Block +# +sub get_vol_dir_blk { + my ($pofile, $vol_dir_blk, $dbg) = @_; + + $debug = 1 if defined $dbg && $dbg; + + my $buf; + + if (read_blk($pofile, $vol_dir_blk, \$buf)) { dump_blk($buf) if $debug; return parse_vol_dir_blk($buf, $debug); } diff --git a/procat.pl b/procat.pl new file mode 100644 index 0000000..f059735 --- /dev/null +++ b/procat.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use strict; + +use ProDOS; + +my $debug = 0; + +my $blk = 0x0; + +while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { + if ($ARGV[0] eq '-d') { + $debug = 1; + shift; + } elsif ($ARGV[0] eq '-b' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) { + $blk = $ARGV[1]; + shift; + shift; + } +} + +my $pofile = shift or die "Must supply filename\n"; + +my $buf; + +#if (read_blk($pofile, $blk, \$buf)) { +# dump_blk($buf); + + #my @bytes = unpack "C512", $buf; + + #$bytes[8] = ord('H'); + #$bytes[9] = ord('E'); + #$bytes[10] = ord('L'); + #$bytes[11] = ord('L'); + #$bytes[12] = ord('O'); + #$bytes[13] = ord('!'); + + #my $buf = pack "C*", @bytes; + + #if (write_blk($pofile, $blk, $buf)) { + # if (read_blk($pofile, $blk, \$buf)) { + # dump_blk($buf); + # } else { + # print "Failed final read!\n"; + # } + #} else { + # print "Failed write!\n"; + #} +#} else { +# print "Failed initial read!\n"; +#} + + +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); + +print "/$volume_name\n\n"; + +print "NAME TYPE BLOCKS MODIFIED CREATED ENDFILE SUBTYPE\n\n"; + +foreach my $file (@files) { + print sprintf("%-15s %3s %7d %16s %16s\n", $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}); +} + +my $vol_dir_blk = $nxt_vol_dir_blk; + +while ($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, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug); + my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = get_vol_dir_blk($pofile, $vol_dir_blk, $debug); + foreach my $file (@files) { + print sprintf("%-15s %3s %7d %16s %16s\n", $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}); + } + $vol_dir_blk = $nxt_vol_dir_blk; +} + +1; +