841 lines
22 KiB
Perl
841 lines
22 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
package ProDOS;
|
|
|
|
#
|
|
# ProDOS.pm:
|
|
#
|
|
# Module to access Apple II ProDOS volumes.
|
|
#
|
|
# 20190115 LSH
|
|
#
|
|
|
|
use strict;
|
|
|
|
use PO;
|
|
|
|
use Exporter::Auto;
|
|
|
|
my $debug = 0;
|
|
|
|
# ProDOS file types
|
|
my %ftype = (
|
|
# $0x Types: General
|
|
|
|
# 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',
|
|
# 07 FNT Apple /// Font
|
|
0x07 => 'FNT',
|
|
# 08 FOT HiRes/Double HiRes Graphics
|
|
0x08 => 'FOT',
|
|
# 09 BA3 Apple III BASIC Program
|
|
0x09 => 'BA3',
|
|
# 0A DA3 Apple III BASIC Data
|
|
0x0a => 'DA3',
|
|
# 0B WPF Generic Word Processing
|
|
0x0b => 'WPF',
|
|
# 0C SOS SOS System File
|
|
0x0c => 'SOS',
|
|
# f DIR Directory file
|
|
0x0f => 'DIR',
|
|
|
|
# $1x Types: Productivity
|
|
|
|
# 19 ADB AppleWorks data base file
|
|
0x19 => 'ADB',
|
|
# 1a AWP AppleWorks word processing file
|
|
0x1a => 'AWP',
|
|
# 1b ASP AppleWorks spreadsheet file
|
|
0x1b => 'ASP',
|
|
|
|
# $2x Types: Code
|
|
|
|
# $20 TDM Desktop Manager File
|
|
0x20 => 'TDM',
|
|
# $21 IPS Instant Pascal Source
|
|
0x21 => 'IPS',
|
|
# $22 UPV UCSD Pascal Volume
|
|
0x22 => 'UPV',
|
|
# $29 3SD SOS Directory
|
|
0x29 => '3SD',
|
|
# $2A 8SC Source Code
|
|
0x2a => '8SC',
|
|
# $2B 8OB Object Code
|
|
0x2b => '8OB',
|
|
|
|
# $2C 8IC Interpreted Code
|
|
0x2c => '8IC',
|
|
# $8003 - Apex Program File
|
|
|
|
# $2D 8LD Language Data
|
|
0x2d => '8LD',
|
|
# $2E P8C ProDOS 8 Code Module
|
|
0x2e => 'P8C',
|
|
|
|
# $4x Types: Miscellaneous
|
|
|
|
# $41 OCR Optical Character Recognition
|
|
0x41 => 'OCR',
|
|
# $42 FTD File Type Definitions
|
|
0x42 => 'FTD',
|
|
|
|
# $5x Types: Apple IIgs General
|
|
|
|
# $50 GWP Apple IIgs Word Processing
|
|
0x50 => 'GWP',
|
|
# $5445 - Teach
|
|
# $8001 - DeluxeWrite
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $51 GSS Apple IIgs Spreadsheet
|
|
0x51 => 'GSS',
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $52 GDB Apple IIgs Database
|
|
0x52 => 'GDB',
|
|
# $8010 - AppleWorks GS
|
|
# $8011 - AppleWorks GS Template
|
|
# $8013 - GSAS
|
|
|
|
# $53 DRW Object Oriented Graphics
|
|
0x53 => 'DRW',
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $54 GDP Apple IIgs Desktop Publishing
|
|
0x54 => 'GDP',
|
|
# $8002 - GraphicWriter
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $55 HMD HyperMedia
|
|
0x55 => 'HMD',
|
|
# $0001 - HyperCard GS
|
|
# $8001 - Tutor-Tech
|
|
# $8002 - HyperStudio
|
|
# $8003 - Nexus
|
|
|
|
# $56 EDU Educational Program Data
|
|
0x56 => 'EDU',
|
|
# $57 STN Stationery
|
|
0x57 => 'STN',
|
|
# $58 HLP Help File
|
|
0x58 => 'HLP',
|
|
|
|
# $59 COM Communications
|
|
0x59 => 'COM',
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $5A CFG Configuration
|
|
0x5a => 'CFG',
|
|
# $5B ANM Animation
|
|
0x5b => 'ANM',
|
|
# $5C MUM Multimedia
|
|
0x5c => 'MUM',
|
|
# $5D ENT Entertainment
|
|
0x5d => 'ENT',
|
|
# $5E DVU Development Utility
|
|
0x5e => 'DVU',
|
|
|
|
# $6x Types: PC Transporter
|
|
|
|
# $60 PRE PC Pre-Boot
|
|
0x60 => 'PRE',
|
|
# $6B BIO PC BIOS
|
|
0x6b => 'BIO',
|
|
# $66 NCF ProDOS File Navigator Command File
|
|
0x66 => 'NCF',
|
|
# $6D DVR PC Driver
|
|
0x6d => 'DVR',
|
|
# $6E PRE PC Pre-Boot
|
|
0x6e => 'PRE',
|
|
# $6F HDV PC Hard Disk Image
|
|
0x6f => 'HDV',
|
|
|
|
# $7x Types: Kreative Software
|
|
|
|
# $70 SN2 Sabine's Notebook 2.0
|
|
0x70 => 'SN2',
|
|
# $71 KMT
|
|
0x71 => 'KMT',
|
|
# $72 DSR
|
|
0x72 => 'DSR',
|
|
# $73 BAN
|
|
0x73 => 'BAN',
|
|
# $74 CG7
|
|
0x74 => 'CG7',
|
|
# $75 TNJ
|
|
0x75 => 'TNJ',
|
|
# $76 SA7
|
|
0x76 => 'SA7',
|
|
# $77 KES
|
|
0x77 => 'KES',
|
|
# $78 JAP
|
|
0x78 => 'JAP',
|
|
# $79 CSL
|
|
0x79 => 'CSL',
|
|
# $7A TME
|
|
0x7a => 'TME',
|
|
# $7B TLB
|
|
0x7b => 'TLB',
|
|
# $7C MR7
|
|
0x7c => 'MR7',
|
|
|
|
# $7D MLR Mika City
|
|
0x7d => 'MLR',
|
|
# $005C - Script
|
|
# $C7AB - Color Table
|
|
# $CDEF - Character Definition
|
|
|
|
# $7E MMM
|
|
0x7e => 'MMM',
|
|
# $7F JCP
|
|
0x7f => 'JCP',
|
|
|
|
# $8x Types: GEOS
|
|
|
|
# $80 GES System File
|
|
0x80 => 'GES',
|
|
# $81 GEA Desk Accessory
|
|
0x81 => 'GEA',
|
|
# $82 GEO Application
|
|
0x82 => 'GEO',
|
|
# $83 GED Document
|
|
0x83 => 'GED',
|
|
# $84 GEF Font
|
|
0x84 => 'GEF',
|
|
# $85 GEP Printer Driver
|
|
0x85 => 'GEP',
|
|
# $86 GEI Input Driver
|
|
0x86 => 'GEI',
|
|
# $87 GEX Auxiliary Driver
|
|
0x87 => 'GEX',
|
|
# $89 GEV Swap File
|
|
0x89 => 'GEV',
|
|
# $8B GEC Clock Driver
|
|
0x8b => 'GEC',
|
|
# $8C GEK Interface Card Driver
|
|
0x8c => 'GEK',
|
|
# $8D GEW Formatting Data
|
|
0x8d => 'GEW',
|
|
|
|
# $Ax Types: Apple IIgs BASIC
|
|
|
|
# $A0 WP WordPerfect
|
|
0xa0 => 'WP ',
|
|
# $AB GSB Apple IIgs BASIC Program
|
|
0xab => 'GSB',
|
|
# $AC TDF Apple IIgs BASIC TDF
|
|
0xac => 'TDF',
|
|
# $AD BDF Apple IIgs BASIC Data
|
|
0xad => 'BDF',
|
|
|
|
# $Bx Types: Apple IIgs System
|
|
|
|
# $B0 SRC Apple IIgs Source Code
|
|
0xb0 => 'SRC',
|
|
# $B1 OBJ Apple IIgs Object Code
|
|
0xb1 => 'OBJ',
|
|
# $B2 LIB Apple IIgs Library
|
|
0xb2 => 'LIB',
|
|
# $B3 S16 Apple IIgs Application Program
|
|
0xb3 => 'S16',
|
|
# $B4 RTL Apple IIgs Runtime Library
|
|
0xb4 => 'RTL',
|
|
# $B5 EXE Apple IIgs Shell Script
|
|
0xb5 => 'EXE',
|
|
# $B6 PIF Apple IIgs Permanent INIT
|
|
0xb6 => 'PIF',
|
|
# $B7 TIF Apple IIgs Temporary INIT
|
|
0xb7 => 'TIF',
|
|
# $B8 NDA Apple IIgs New Desk Accessory
|
|
0xb8 => 'NDA',
|
|
# $B9 CDA Apple IIgs Classic Desk Accessory
|
|
0xb9 => 'CDA',
|
|
# $BA TOL Apple IIgs Tool
|
|
0xba => 'TOL',
|
|
# $BB DRV Apple IIgs Device Driver
|
|
0xbb => 'DRV',
|
|
|
|
# $BC LDF Apple IIgs Generic Load File
|
|
0xbc => 'LDF',
|
|
# $4001 - Nifty List Module
|
|
# $4002 - Super Info Module
|
|
# $4004 - Twilight Module
|
|
# $4083 - Marinetti Link Layer Module
|
|
|
|
# $BD FST Apple IIgs File System Translator
|
|
0xbd => 'FST',
|
|
# $BF DOC Apple IIgs Document
|
|
0xbf => 'DOC',
|
|
|
|
# $Cx Types: Graphics
|
|
|
|
# $C0 PNT Apple IIgs Packed Super HiRes
|
|
0xc0 => 'PNT',
|
|
# $0001 - Packed Super HiRes
|
|
# $0002 - Apple Preferred Format
|
|
# $0003 - Packed QuickDraw II PICT
|
|
|
|
# $C1 PIC Apple IIgs Super HiRes
|
|
0xc1 => 'PIC',
|
|
# $0001 - QuickDraw PICT
|
|
# $0002 - Super HiRes 3200
|
|
|
|
# $C2 ANI PaintWorks Animation
|
|
0xc2 => 'ANI',
|
|
# $C3 PAL PaintWorks Palette
|
|
0xc3 => 'PAL',
|
|
# $C5 OOG Object-Oriented Graphics
|
|
0xc5 => 'OOG',
|
|
# $C6 SCR Script
|
|
0xc6 => 'SCR',
|
|
# $C7 CDV Apple IIgs Control Panel
|
|
0xc7 => 'CDV',
|
|
|
|
# $C8 FON Apple IIgs Font
|
|
0xc8 => 'FON',
|
|
# $0000 - QuickDraw Bitmap Font
|
|
# $0001 - Pointless TrueType Font
|
|
|
|
# $C9 FND Apple IIgs Finder Data
|
|
0xc9 => 'FND',
|
|
# $CA ICN Apple IIgs Icon File
|
|
0xca => 'ICN',
|
|
|
|
# $Dx Types: Audio
|
|
|
|
# $D5 MUS Music
|
|
0xd5 => 'MUS',
|
|
# $D6 INS Instrument
|
|
0xd6 => 'INS',
|
|
# $D7 MDI MIDI
|
|
0xd7 => 'MDI',
|
|
|
|
# $D8 SND Apple IIgs Audio
|
|
0xd8 => 'SND',
|
|
# $0000 - AIFF
|
|
# $0001 - AIFF-C
|
|
# $0002 - ASIF Instrument
|
|
# $0003 - Sound Resource
|
|
# $0004 - MIDI Synth Wave
|
|
# $8001 - HyperStudio Sound
|
|
|
|
# $DB DBM DB Master Document
|
|
0xdb => 'DBM',
|
|
|
|
# $Ex Types: Miscellaneous
|
|
|
|
# $E0 LBR Archive
|
|
0xe0 => 'LBR',
|
|
# $0000 - ALU
|
|
# $0001 - AppleSingle
|
|
# $0002 - AppleDouble Header
|
|
# $0003 - AppleDouble Data
|
|
# $8000 - Binary II
|
|
# $8001 - AppleLink ACU
|
|
# $8002 - ShrinkIt
|
|
|
|
# $E2 ATK AppleTalk Data
|
|
0xe2 => 'ATK',
|
|
# $FFFF - EasyMount Alias
|
|
|
|
# $EE R16 EDASM 816 Relocatable Code
|
|
0xee => 'R16',
|
|
# ef PAS ProDOS PASCAL file
|
|
0xef => 'PAS',
|
|
|
|
# $Fx Types: System
|
|
|
|
# f0 CMD ProDOS added command file
|
|
0xf0 => 'CMD',
|
|
# f1-f8 User defined file types 1 through 8
|
|
0xf1 => 'OVL',
|
|
0xf2 => 'UD2',
|
|
0xf3 => 'UD3',
|
|
0xf4 => 'UD4',
|
|
0xf5 => 'BAT',
|
|
0xf6 => 'UD6',
|
|
0xf7 => 'UD7',
|
|
0xf8 => 'PRG',
|
|
|
|
# $F9 P16 ProDOS-16 System File
|
|
0xf9 => 'P16',
|
|
|
|
# fa INT Integer BASIC Program
|
|
0xfa => 'INT',
|
|
# fb IVR Integer BASIC Variables
|
|
0xfb => 'IVR',
|
|
# 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',
|
|
);
|
|
|
|
#
|
|
# Months for catalog date format.
|
|
#
|
|
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',
|
|
);
|
|
|
|
# Default key volume directory block.
|
|
my $key_vol_dir_blk = 2;
|
|
|
|
#
|
|
# Key Volume Directory Block
|
|
#
|
|
# 00-01 Previous Volume Directory Block
|
|
# 02-03 Next Volume Directory Block
|
|
#
|
|
# Volumne Directory Header
|
|
#
|
|
# 04 STORAGE_TYPE/NAME_LENGTH
|
|
# fx where x is length of VOLUME_NAME
|
|
# 05-13 VOLUME_NAME
|
|
# 14-1b Not used
|
|
# 1c-1f CREATION
|
|
# 0-1 yyyyyyymmmmddddd year/month/day
|
|
# 2-3 000hhhhh00mmmmmm hours/minues
|
|
# 20 VERSION
|
|
# 21 MIN_VERSION
|
|
# 22 ACCESS
|
|
# 23 ENTRY_LENGTH
|
|
# 24 ENTRIES_PER_BLOCK
|
|
# 25-26 FILE_COUNT
|
|
# 27-28 BIT_MAP_POINTER
|
|
# 29-2a TOTAL_BLOCKS
|
|
#
|
|
my $key_vol_dir_blk_tmpl = 'vvCa15x8vvCCCCCvvva470';
|
|
|
|
my $vol_dir_blk_tmpl = 'vva504';
|
|
|
|
#
|
|
# Volume Bit Map
|
|
#
|
|
my $vol_bit_map_tmpl = 'C*';
|
|
|
|
#
|
|
# File Descriptive Entries
|
|
#
|
|
# 00 STORAGE_TYPE/NAME_LENGTH
|
|
# 0x Deleted entry. Available for reuse.
|
|
# 1x File is a seedling file (only one block)
|
|
# 2x File is a sapling file (2-256 blocks)
|
|
# 3x File is a tree file (257-32768 blocks)
|
|
# dx File is a subdirectory
|
|
# ex Reserved for Subdirectory Header entry
|
|
# fx Reserved for Volume Directory Header entry
|
|
# x is the length of FILE_NAME
|
|
# 01-0f FILE_NAME
|
|
# 10 FILE_TYPE
|
|
# 00 Typeless file
|
|
# 01 BAD Bad block(s) file
|
|
# 04 TXT Text file (ASCII text, msb off)
|
|
# 06 BIN Binary file (8-bit binary image)
|
|
# 0f DIR Directory file
|
|
# 19 ADB AppleWorks data base file
|
|
# 1a AWP AppleWorks word processing file
|
|
# 1b ASP AppleWorks spreadsheet file
|
|
# ef PAS ProDOS PASCAL file
|
|
# f0 CMD ProDOS added command file
|
|
# f1-f8 User defined file types 1 through 8
|
|
# fc BAS Applesoft BASIC program file
|
|
# fd VAR Applesoft stored variables file
|
|
# fe REL Relocatable object module file (EDASM)
|
|
# ff SYS ProDOS system file
|
|
# 11-12 KEY_POINTER
|
|
# 13-14 BLOCKS_USED
|
|
# 15-17 EOF
|
|
# 18-1b CREATION
|
|
# 0-1 yyyyyyymmmmddddd year/month/day
|
|
# 2-3 000hhhhh00mmmmmm hours/minues
|
|
# 1c VERSION
|
|
# 1d MIN_VERSION
|
|
# 1e ACCESS
|
|
# 80 File may be destroyed
|
|
# 40 File may be renamed
|
|
# 20 File has changed since last backup
|
|
# 02 File may be written to
|
|
# 01 File may be read
|
|
# 1f-20 AUX_TYPE
|
|
# TXT Random access record length (L from OPEN)
|
|
# BIN Load address for binary image (A from BSAVE)
|
|
# BAS Load address for program image (when SAVEd)
|
|
# VAR Address of compressed variables inmage (when STOREd)
|
|
# SYS Load address for system program (usually $2000)
|
|
# 21-24 LAST_MOD
|
|
# 25-26 HEADER_POINTER
|
|
#
|
|
my $file_desc_ent_tmpl = 'Ca15Cvva3vvCCCvvvv';
|
|
|
|
my $key_dir_file_desc_ent_tmpl = '';
|
|
my $subdir_hdr_file_desc_ent_tmpl = '';
|
|
for (my $i = 0; $i < 12; $i++) {
|
|
$key_dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
|
$subdir_hdr_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
|
}
|
|
|
|
my $dir_file_desc_ent_tmpl = '';
|
|
my $subdir_file_desc_ent_tmpl = '';
|
|
for (my $i = 0; $i < 12; $i++) {
|
|
$dir_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
|
$subdir_file_desc_ent_tmpl .= $file_desc_ent_tmpl;
|
|
}
|
|
|
|
#
|
|
# Subdirectory Header
|
|
#
|
|
# 00-01 Previous Subdirectory Block
|
|
# 02-03 Next Subdirectory Block
|
|
#
|
|
# 04 STORAGE_TYPE/NAME_LENGTH
|
|
# ex where x is length of SUBDIR NAME
|
|
#
|
|
# 05-13 SUBDIR_NAME
|
|
# 14 Must contain $75
|
|
# 15-1b Reserved for future use
|
|
# 1c-1f CREATION
|
|
# 0-1 yyyyyyymmmmddddd year/month/day
|
|
# 2-3 000hhhhh00mmmmmm hours/minues
|
|
# 20 VERSION
|
|
# 21 MIN_VERSION
|
|
# 22 ACCESS
|
|
# 23 ENTRY_LENGTH
|
|
# 24 ENTRIES_PER_BLOCK
|
|
# 25-26 FILE_COUNT
|
|
# 27-28 PARENT_POINTER
|
|
# 29 PARENT_ENTRY
|
|
# 2a PARENT_ENTRY_LENGTH
|
|
#
|
|
my $subdir_hdr_blk_tmpl = 'vvCa15Cx7vvCCCCCvvCCa469';
|
|
|
|
|
|
#
|
|
# Convert a ProDOS date to DD-MMM-YY string.
|
|
#
|
|
sub date_convert {
|
|
my ($ymd, $hm) = @_;
|
|
|
|
return "<NO DATE>" unless (defined $ymd && defined $hm && $ymd != 0);
|
|
|
|
my $year = ($ymd & 0xfe00) >> 9; # bits 9-15
|
|
my $mon = ($ymd & 0x01e0) >> 5; # 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
|
|
$mon = 0 if $mon > 12;
|
|
|
|
return "<NO DATE>" if $mon < 1;
|
|
|
|
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_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 $name_length = $storage_type_name_length & 0x0f;
|
|
|
|
my $volname = substr($volume_name, 0, $name_length);
|
|
|
|
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;
|
|
my $storage_type = $storage_type_name_length & 0xf0;
|
|
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;
|
|
my $blocks_used = shift @flds;
|
|
my $eof = shift @flds;
|
|
my ($e1, $e2, $e3) = unpack "C*", $eof;
|
|
my $endfile = (($e3 << 16) + ($e2 << 8) + $e1);
|
|
my $creation_ymd = shift @flds;
|
|
my $creation_hm = shift @flds;
|
|
my $cdate = date_convert($creation_ymd, $creation_hm);
|
|
my $version = shift @flds;
|
|
my $min_version = shift @flds;
|
|
my $access = shift @flds;
|
|
my $aux_type = shift @flds;
|
|
my $atype = '';
|
|
if ($file_type == 0x06) {
|
|
$atype = sprintf("A=\$%04X", $aux_type);
|
|
}
|
|
my $last_mod_ymd = shift @flds;
|
|
my $last_mod_hm = shift @flds;
|
|
my $mdate = date_convert($last_mod_ymd, $last_mod_hm);
|
|
my $header_pointer = shift @flds;
|
|
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 };
|
|
}
|
|
}
|
|
|
|
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 Key Volume Directory Block
|
|
#
|
|
sub get_key_vol_dir_blk {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
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;
|
|
|
|
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;
|
|
my $file_name = shift @flds;
|
|
my $storage_type = $storage_type_name_length & 0xf0;
|
|
my $name_length = $storage_type_name_length & 0x0f;
|
|
my $fname = substr($file_name, 0, $name_length);
|
|
my $file_type = shift @flds;
|
|
my $key_pointer = shift @flds;
|
|
my $blocks_used = shift @flds;
|
|
my $eof = shift @flds;
|
|
my ($e1, $e2, $e3) = unpack "C*", $eof;
|
|
my $endfile = (($e3 << 16) + ($e2 << 8) + $e1);
|
|
my $creation_ymd = shift @flds;
|
|
my $creation_hm = shift @flds;
|
|
my $cdate = date_convert($creation_ymd, $creation_hm);
|
|
my $version = shift @flds;
|
|
my $min_version = shift @flds;
|
|
my $access = shift @flds;
|
|
my $aux_type = shift @flds;
|
|
my $atype = '';
|
|
if ($file_type == 0x06) {
|
|
$atype = sprintf("A=\$%04X", $aux_type);
|
|
}
|
|
my $last_mod_ymd = shift @flds;
|
|
my $last_mod_hm = shift @flds;
|
|
my $mdate = date_convert($last_mod_ymd, $last_mod_hm);
|
|
my $header_pointer = shift @flds;
|
|
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 };
|
|
}
|
|
}
|
|
|
|
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);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
# Parse Key Volume Directory Block
|
|
sub parse_subdir_hdr_blk {
|
|
my ($buf, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
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 $name_length = $storage_type_name_length & 0x0f;
|
|
|
|
my $subdir_nm = substr($subdir_name, 0, $name_length);
|
|
|
|
my @flds = unpack $subdir_hdr_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;
|
|
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;
|
|
my $blocks_used = shift @flds;
|
|
my $eof = shift @flds;
|
|
my ($e1, $e2, $e3) = unpack "C*", $eof;
|
|
my $endfile = (($e3 << 16) + ($e2 << 8) + $e1);
|
|
my $creation_ymd = shift @flds;
|
|
my $creation_hm = shift @flds;
|
|
my $cdate = date_convert($creation_ymd, $creation_hm);
|
|
my $version = shift @flds;
|
|
my $min_version = shift @flds;
|
|
my $access = shift @flds;
|
|
my $aux_type = shift @flds;
|
|
my $atype = '';
|
|
if ($file_type == 0x06) {
|
|
$atype = sprintf("A=\$%04X", $aux_type);
|
|
}
|
|
my $last_mod_ymd = shift @flds;
|
|
my $last_mod_hm = shift @flds;
|
|
my $mdate = date_convert($last_mod_ymd, $last_mod_hm);
|
|
my $header_pointer = shift @flds;
|
|
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 };
|
|
}
|
|
}
|
|
|
|
return $prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_nm, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @files;
|
|
}
|
|
|
|
sub get_subdir_hdr {
|
|
my ($pofile, $subdir_blk, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my $buf;
|
|
|
|
if (read_blk($pofile, $subdir_blk, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
return parse_subdir_hdr_blk($buf, $debug);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub list_files {
|
|
my ($pofile, $pre, $dirname, $files) = @_;
|
|
|
|
print "$pre/$dirname\n";
|
|
|
|
foreach my $file (@{$files}) {
|
|
my $lck = ' ';
|
|
if ($file->{'access'} == 0x01) {
|
|
$lck = '*';
|
|
}
|
|
print sprintf("$pre%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'});
|
|
|
|
if ($file->{'ftype'} eq 'DIR') {
|
|
my $subdir_blk = $file->{'keyptr'};
|
|
|
|
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug);
|
|
|
|
list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles);
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Get disk catalog.
|
|
#
|
|
sub cat {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
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) {
|
|
my $lck = ' ';
|
|
if ($file->{'access'} == 0x01) {
|
|
$lck = '*';
|
|
}
|
|
print sprintf("%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'});
|
|
|
|
if ($file->{'ftype'} eq 'DIR') {
|
|
my $subdir_blk = $file->{'keyptr'};
|
|
|
|
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug);
|
|
my $pre = ' ';
|
|
list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles);
|
|
}
|
|
}
|
|
|
|
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) {
|
|
my $lck = ' ';
|
|
if ($file->{'access'} == 0x01) {
|
|
$lck = '*';
|
|
}
|
|
print sprintf("%s%-15s %3s %7d %16s %16s %7s %s\n", $lck, $file->{'filename'}, $file->{'ftype'}, $file->{'used'}, $file->{'mdate'}, $file->{'cdate'}, $file->{'eof'}, $file->{'atype'});
|
|
|
|
if ($file->{'ftype'} eq 'DIR') {
|
|
my $subdir_blk = $file->{'keyptr'};
|
|
|
|
my ($prv_vol_dir_blk, $nxt_vol_dir_blk, $storage_type_name_length, $subdir_name, $creation_ymd, $creation_hm, $version, $min_version, $access, $entry_length, $entries_per_block, $file_count, $parent_pointer, $parent_entry, $parent_entry_length, @subfiles) = get_subdir_hdr($pofile, $subdir_blk, $debug);
|
|
|
|
my $pre = ' ';
|
|
list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles);
|
|
}
|
|
}
|
|
$vol_dir_blk = $nxt_vol_dir_blk;
|
|
}
|
|
}
|
|
|
|
1;
|
|
|