3242 lines
87 KiB
Perl
3242 lines
87 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
package ProDOS;
|
|
|
|
#
|
|
# ProDOS.pm:
|
|
#
|
|
# Module to access Apple II ProDOS volumes.
|
|
#
|
|
# 20190115 LSH
|
|
#
|
|
|
|
use strict;
|
|
|
|
use POSIX;
|
|
|
|
use PO;
|
|
|
|
use Exporter::Auto;
|
|
|
|
my $debug = 0;
|
|
|
|
# For free space counts.
|
|
my %ones_count = (
|
|
0x00 => 0, # 0000
|
|
0x01 => 1, # 0001
|
|
0x02 => 1, # 0010
|
|
0x03 => 2, # 0011
|
|
0x04 => 1, # 0100
|
|
0x05 => 2, # 0101
|
|
0x06 => 2, # 0110
|
|
0x07 => 3, # 0111
|
|
0x08 => 1, # 1000
|
|
0x09 => 2, # 1001
|
|
0x0a => 2, # 1010
|
|
0x0b => 3, # 1011
|
|
0x0c => 2, # 1100
|
|
0x0d => 3, # 1101
|
|
0x0e => 3, # 1110
|
|
0x0f => 4, # 1111
|
|
);
|
|
|
|
# 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',
|
|
# $66 NCF ProDOS File Navigator Command File
|
|
0x66 => 'NCF',
|
|
# $6B BIO PC BIOS
|
|
0x6b => 'BIO',
|
|
# $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',
|
|
);
|
|
|
|
# ProDOS file types (reverse)
|
|
my %typef = (
|
|
# $0x Types: General
|
|
|
|
# 00 Typeless file
|
|
' ' => 0x00,
|
|
# 01 BAD Bad block(s) file
|
|
'BAD' => 0x01,
|
|
# 04 TXT Text file (ASCII text, msb off)
|
|
'TXT' => 0x04,
|
|
# 06 BIN Binary file (8-bit binary image)
|
|
'BIN' => 0x06,
|
|
# 07 FNT Apple /// Font
|
|
'FNT' => 0x07,
|
|
# 08 FOT HiRes/Double HiRes Graphics
|
|
'FOT' => 0x08,
|
|
# 09 BA3 Apple III BASIC Program
|
|
'BA3' => 0x09,
|
|
# 0A DA3 Apple III BASIC Data
|
|
'DA3' => 0x0a,
|
|
# 0B WPF Generic Word Processing
|
|
'WPF' => 0x0b,
|
|
# 0C SOS SOS System File
|
|
'SOS' => 0x0c,
|
|
# f DIR Directory file
|
|
'DIR' => 0x0f,
|
|
|
|
# $1x Types: Productivity
|
|
|
|
# 19 ADB AppleWorks data base file
|
|
'ADB' => 0x19,
|
|
# 1a AWP AppleWorks word processing file
|
|
'AWP' => 0x1a,
|
|
# 1b ASP AppleWorks spreadsheet file
|
|
'ASP' => 0x1b,
|
|
|
|
# $2x Types: Code
|
|
|
|
# $20 TDM Desktop Manager File
|
|
'TDM' => 0x20,
|
|
# $21 IPS Instant Pascal Source
|
|
'IPS' => 0x21,
|
|
# $22 UPV UCSD Pascal Volume
|
|
'UPV' => 0x22,
|
|
# $29 3SD SOS Directory
|
|
'3SD' => 0x29,
|
|
# $2A 8SC Source Code
|
|
'8SC' => 0x2a,
|
|
# $2B 8OB Object Code
|
|
'8OB' => 0x2b,
|
|
|
|
# $2C 8IC Interpreted Code
|
|
'8IC' => 0x2c,
|
|
# $8003 - Apex Program File
|
|
|
|
# $2D 8LD Language Data
|
|
'8LD' => 0x2d,
|
|
# $2E P8C ProDOS 8 Code Module
|
|
'P8C' => 0x2e,
|
|
|
|
# $4x Types: Miscellaneous
|
|
|
|
# $41 OCR Optical Character Recognition
|
|
'OCR' => 0x41,
|
|
# $42 FTD File Type Definitions
|
|
'FTD' => 0x42,
|
|
|
|
# $5x Types: Apple IIgs General
|
|
|
|
# $50 GWP Apple IIgs Word Processing
|
|
'GWP' => 0x50,
|
|
# $5445 - Teach
|
|
# $8001 - DeluxeWrite
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $51 GSS Apple IIgs Spreadsheet
|
|
'GSS' => 0x51,
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $52 GDB Apple IIgs Database
|
|
'GDB' => 0x52,
|
|
# $8010 - AppleWorks GS
|
|
# $8011 - AppleWorks GS Template
|
|
# $8013 - GSAS
|
|
|
|
# $53 DRW Object Oriented Graphics
|
|
'DRW' => 0x53,
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $54 GDP Apple IIgs Desktop Publishing
|
|
'GDP' => 0x54,
|
|
# $8002 - GraphicWriter
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $55 HMD HyperMedia
|
|
'HMD' => 0x55,
|
|
# $0001 - HyperCard GS
|
|
# $8001 - Tutor-Tech
|
|
# $8002 - HyperStudio
|
|
# $8003 - Nexus
|
|
|
|
# $56 EDU Educational Program Data
|
|
'EDU' => 0x56,
|
|
# $57 STN Stationery
|
|
'STN' => 0x57,
|
|
# $58 HLP Help File
|
|
'HLP' => 0x58,
|
|
|
|
# $59 COM Communications
|
|
'COM' => 0x59,
|
|
# $8010 - AppleWorks GS
|
|
|
|
# $5A CFG Configuration
|
|
'CFG' => 0x5a,
|
|
# $5B ANM Animation
|
|
'ANM' => 0x5b,
|
|
# $5C MUM Multimedia
|
|
'MUM' => 0x5c,
|
|
# $5D ENT Entertainment
|
|
'ENT' => 0x5d,
|
|
# $5E DVU Development Utility
|
|
'DVU' => 0x5e,
|
|
|
|
# $6x Types: PC Transporter
|
|
|
|
# $60 PRE PC Pre-Boot
|
|
'PRE' => 0x60,
|
|
# $66 NCF ProDOS File Navigator Command File
|
|
'NCF' => 0x66,
|
|
# $6B BIO PC BIOS
|
|
'BIO' => 0x6b,
|
|
# $6D DVR PC Driver
|
|
'DVR' => 0x6d,
|
|
# $6E PRE PC Pre-Boot
|
|
'PRE' => 0x6e,
|
|
# $6F HDV PC Hard Disk Image
|
|
'HDV' => 0x6f,
|
|
|
|
# $7x Types: Kreative Software
|
|
|
|
# $70 SN2 Sabine's Notebook 2.0
|
|
'SN2' => 0x70,
|
|
# $71 KMT
|
|
'KMT' => 0x71,
|
|
# $72 DSR
|
|
'DSR' => 0x72,
|
|
# $73 BAN
|
|
'BAN' => 0x73,
|
|
# $74 CG7
|
|
'CG7' => 0x74,
|
|
# $75 TNJ
|
|
'TNJ' => 0x75,
|
|
# $76 SA7
|
|
'SA7' => 0x76,
|
|
# $77 KES
|
|
'KES' => 0x77,
|
|
# $78 JAP
|
|
'JAP' => 0x78,
|
|
# $79 CSL
|
|
'CSL' => 0x79,
|
|
# $7A TME
|
|
'TME' => 0x7a,
|
|
# $7B TLB
|
|
'TLB' => 0x7b,
|
|
# $7C MR7
|
|
'MR7' => 0x7c,
|
|
|
|
# $7D MLR Mika City
|
|
'MLR' => 0x7d,
|
|
# $005C - Script
|
|
# $C7AB - Color Table
|
|
# $CDEF - Character Definition
|
|
|
|
# $7E MMM
|
|
'MMM' => 0x7e,
|
|
# $7F JCP
|
|
'JCP' => 0x7f,
|
|
|
|
# $8x Types: GEOS
|
|
|
|
# $80 GES System File
|
|
'GES' => 0x80,
|
|
# $81 GEA Desk Accessory
|
|
'GEA' => 0x81,
|
|
# $82 GEO Application
|
|
'GEO' => 0x82,
|
|
# $83 GED Document
|
|
'GED' => 0x83,
|
|
# $84 GEF Font
|
|
'GEF' => 0x84,
|
|
# $85 GEP Printer Driver
|
|
'GEP' => 0x85,
|
|
# $86 GEI Input Driver
|
|
'GEI' => 0x86,
|
|
# $87 GEX Auxiliary Driver
|
|
'GEX' => 0x87,
|
|
# $89 GEV Swap File
|
|
'GEV' => 0x89,
|
|
# $8B GEC Clock Driver
|
|
'GEC' => 0x8b,
|
|
# $8C GEK Interface Card Driver
|
|
'GEK' => 0x8c,
|
|
# $8D GEW Formatting Data
|
|
'GEW' => 0x8d,
|
|
|
|
# $Ax Types: Apple IIgs BASIC
|
|
|
|
# $A0 WP WordPerfect
|
|
'WP ' => 0xa0,
|
|
# $AB GSB Apple IIgs BASIC Program
|
|
'GSB' => 0xab,
|
|
# $AC TDF Apple IIgs BASIC TDF
|
|
'TDF' => 0xac,
|
|
# $AD BDF Apple IIgs BASIC Data
|
|
'BDF' => 0xad,
|
|
|
|
# $Bx Types: Apple IIgs System
|
|
|
|
# $B0 SRC Apple IIgs Source Code
|
|
'SRC' => 0xb0,
|
|
# $B1 OBJ Apple IIgs Object Code
|
|
'OBJ' => 0xb1,
|
|
# $B2 LIB Apple IIgs Library
|
|
'LIB' => 0xb2,
|
|
# $B3 S16 Apple IIgs Application Program
|
|
'S16' => 0xb3,
|
|
# $B4 RTL Apple IIgs Runtime Library
|
|
'RTL' => 0xb4,
|
|
# $B5 EXE Apple IIgs Shell Script
|
|
'EXE' => 0xb5,
|
|
# $B6 PIF Apple IIgs Permanent INIT
|
|
'PIF' => 0xb6,
|
|
# $B7 TIF Apple IIgs Temporary INIT
|
|
'TIF' => 0xb7,
|
|
# $B8 NDA Apple IIgs New Desk Accessory
|
|
'NDA' => 0xb8,
|
|
# $B9 CDA Apple IIgs Classic Desk Accessory
|
|
'CDA' => 0xb9,
|
|
# $BA TOL Apple IIgs Tool
|
|
'TOL' => 0xba,
|
|
# $BB DRV Apple IIgs Device Driver
|
|
'DRV' => 0xbb,
|
|
|
|
# $BC LDF Apple IIgs Generic Load File
|
|
'LDF' => 0xbc,
|
|
# $4001 - Nifty List Module
|
|
# $4002 - Super Info Module
|
|
# $4004 - Twilight Module
|
|
# $4083 - Marinetti Link Layer Module
|
|
|
|
# $BD FST Apple IIgs File System Translator
|
|
'FST' => 0xbd,
|
|
# $BF DOC Apple IIgs Document
|
|
'DOC' => 0xbf,
|
|
|
|
# $Cx Types: Graphics
|
|
|
|
# $C0 PNT Apple IIgs Packed Super HiRes
|
|
'PNT' => 0xc0,
|
|
# $0001 - Packed Super HiRes
|
|
# $0002 - Apple Preferred Format
|
|
# $0003 - Packed QuickDraw II PICT
|
|
|
|
# $C1 PIC Apple IIgs Super HiRes
|
|
'PIC' => 0xc1,
|
|
# $0001 - QuickDraw PICT
|
|
# $0002 - Super HiRes 3200
|
|
|
|
# $C2 ANI PaintWorks Animation
|
|
'ANI' => 0xc2,
|
|
# $C3 PAL PaintWorks Palette
|
|
'PAL' => 0xc3,
|
|
# $C5 OOG Object-Oriented Graphics
|
|
'OOG' => 0xc5,
|
|
# $C6 SCR Script
|
|
'SCR' => 0xc6,
|
|
# $C7 CDV Apple IIgs Control Panel
|
|
'CDV' => 0xc7,
|
|
|
|
# $C8 FON Apple IIgs Font
|
|
'FON' => 0xc8,
|
|
# $0000 - QuickDraw Bitmap Font
|
|
# $0001 - Pointless TrueType Font
|
|
|
|
# $C9 FND Apple IIgs Finder Data
|
|
'FND' => 0xc9,
|
|
# $CA ICN Apple IIgs Icon File
|
|
'ICN' => 0xca,
|
|
|
|
# $Dx Types: Audio
|
|
|
|
# $D5 MUS Music
|
|
'MUS' => 0xd5,
|
|
# $D6 INS Instrument
|
|
'INS' => 0xd6,
|
|
# $D7 MDI MIDI
|
|
'MDI' => 0xd7,
|
|
|
|
# $D8 SND Apple IIgs Audio
|
|
'SND' => 0xd8,
|
|
# $0000 - AIFF
|
|
# $0001 - AIFF-C
|
|
# $0002 - ASIF Instrument
|
|
# $0003 - Sound Resource
|
|
# $0004 - MIDI Synth Wave
|
|
# $8001 - HyperStudio Sound
|
|
|
|
# $DB DBM DB Master Document
|
|
'DBM' => 0xdb,
|
|
|
|
# $Ex Types: Miscellaneous
|
|
|
|
# $E0 LBR Archive
|
|
'LBR' => 0xe0,
|
|
# $0000 - ALU
|
|
# $0001 - AppleSingle
|
|
# $0002 - AppleDouble Header
|
|
# $0003 - AppleDouble Data
|
|
# $8000 - Binary II
|
|
# $8001 - AppleLink ACU
|
|
# $8002 - ShrinkIt
|
|
|
|
# $E2 ATK AppleTalk Data
|
|
'ATK' => 0xe2,
|
|
# $FFFF - EasyMount Alias
|
|
|
|
# $EE R16 EDASM 816 Relocatable Code
|
|
'R16' => 0xee,
|
|
# ef PAS ProDOS PASCAL file
|
|
'PAS' => 0xef,
|
|
|
|
# $Fx Types: System
|
|
|
|
# f0 CMD ProDOS added command file
|
|
'CMD' => 0xf0,
|
|
# f1-f8 User defined file types 1 through 8
|
|
'OVL' => 0xf1,
|
|
'UD2' => 0xf2,
|
|
'UD3' => 0xf3,
|
|
'UD4' => 0xf4,
|
|
'BAT' => 0xf5,
|
|
'UD6' => 0xf6,
|
|
'UD7' => 0xf7,
|
|
'PRG' => 0xf8,
|
|
|
|
# $F9 P16 ProDOS-16 System File
|
|
'P16' => 0xf9,
|
|
|
|
# fa INT Integer BASIC Program
|
|
'INT' => 0xfa,
|
|
# fb IVR Integer BASIC Variables
|
|
'IVR' => 0xfb,
|
|
# fc BAS Applesoft BASIC program file
|
|
'BAS' => 0xfc,
|
|
# fd VAR Applesoft stored variables file
|
|
'VAR' => 0xfd,
|
|
# fe REL Relocatable object module file (EDASM)
|
|
'REL' => 0xfe,
|
|
# ff SYS ProDOS system file
|
|
'SYS' => 0xff,
|
|
);
|
|
|
|
# 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';
|
|
|
|
#
|
|
# Master Index Block (tree file)
|
|
#
|
|
my $master_ind_blk_lo_tmpl = 'C256';
|
|
my $master_ind_blk_hi_tmpl = 'x256C256';
|
|
|
|
#
|
|
# Index Block (tree file)
|
|
#
|
|
my $sub_ind_blk_lo_tmpl = 'C256';
|
|
my $sub_ind_blk_hi_tmpl = 'x256C256';
|
|
|
|
#
|
|
# 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);
|
|
}
|
|
|
|
#
|
|
# Get current date in ProDOS format.
|
|
#
|
|
sub current_date {
|
|
my ($s, $min, $h, $d, $m, $y, $w) = localtime();
|
|
my $year = substr(($y + 1900), 2, 2);
|
|
my $mon = $m + 1;
|
|
|
|
my $ymd = 0;
|
|
my $hm = 0;
|
|
|
|
#printf("year=%08b\n", $year);
|
|
#printf("mon=%08b\n", $mon);
|
|
#printf("d=%08b\n", $d);
|
|
|
|
#printf("h=%08b\n", $h);
|
|
#printf("min=%08b\n", $min);
|
|
|
|
# Year bits 9-15
|
|
$ymd |= ($year << 9);
|
|
#printf("ymd=%016b\n", $ymd);
|
|
# Mon bits 5-8
|
|
$ymd |= ($mon << 5);
|
|
#printf("ymd=%016b\n", $ymd);
|
|
# Day bits 0-4
|
|
$ymd |= $d;
|
|
#printf("ymd=%016b\n", $ymd);
|
|
|
|
# Hour bits 8-12
|
|
$hm |= ($h << 8);
|
|
#printf("hm=%016b\n", $hm);
|
|
# Min bits 0-5
|
|
$hm |= $min;
|
|
#printf("hm=%016b\n", $hm);
|
|
|
|
return $ymd, $hm;
|
|
}
|
|
|
|
# Parse Key Volume Directory Block
|
|
sub parse_key_vol_dir_blk {
|
|
my ($buf, $mode, $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) >> 4;
|
|
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) >> 4;
|
|
my $name_length = $storage_type_name_length & 0x0f;
|
|
if ($mode == 3) {
|
|
$name_length = 15;
|
|
}
|
|
my $file_name = shift @flds;
|
|
my $fname = substr($file_name, 0, $name_length);
|
|
if ($mode == 3) {
|
|
$fname =~ s/\s$//g;
|
|
$fname =~ s/\x00+$//g;
|
|
}
|
|
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 != 0x00) {
|
|
my $f_type = $ftype{$file_type};
|
|
$f_type = sprintf("\$%02x", $file_type) unless defined $f_type;
|
|
push @files, { 'prv' => $prv_vol_dir_blk, 'nxt' => $nxt_vol_dir_blk, '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, 'header_pointer' => $header_pointer, 'i' => $i };
|
|
} else {
|
|
if ($mode == 2) {
|
|
push @files, { 'storage_type' => 0, 'header_pointer' => $key_vol_dir_blk, 'i' => $i };
|
|
} elsif ($mode == 3) {
|
|
#print "filename='$fname'\n";
|
|
my $f_type = $ftype{$file_type};
|
|
$f_type = sprintf("\$%02x", $file_type) unless defined $f_type;
|
|
push @files, { 'prv' => $prv_vol_dir_blk, 'nxt' => $nxt_vol_dir_blk, '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, 'header_pointer' => $header_pointer, 'i' => $i };
|
|
}
|
|
}
|
|
}
|
|
|
|
#if ($mode == 2) {
|
|
# foreach my $file (@files) {
|
|
# next if $file->{'storage_type'} != 0;
|
|
# print "file=$file->{'header_pointer'} $file->{'i'}\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 Key Volume Directory Block
|
|
#
|
|
sub get_key_vol_dir_blk {
|
|
my ($pofile, $mode, $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, $mode, $debug);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
#
|
|
# Write Key Volume Directory Block
|
|
#
|
|
sub write_key_vol_dir_blk {
|
|
my ($pofile, $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) = @_;
|
|
|
|
my $buf = pack $key_vol_dir_blk_tmpl, ($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);
|
|
|
|
if (!write_blk($pofile, $key_vol_dir_blk, \$buf)) {
|
|
print "I/O Error writing block $key_vol_dir_blk\n";
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Write Volume Directory Block
|
|
#
|
|
sub write_vol_dir_blk {
|
|
my ($pofile, $vol_dir_blk, $prv_vol_dir_blk, $nxt_vol_dir_blk, $dir_ents) = @_;
|
|
|
|
my $buf = pack $vol_dir_blk_tmpl, ($prv_vol_dir_blk, $nxt_vol_dir_blk, $dir_ents);
|
|
|
|
|
|
if (!write_blk($pofile, $vol_dir_blk, \$buf)) {
|
|
print "I/O Error writing block $vol_dir_blk\n";
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Parse Volume Directory Block
|
|
#
|
|
sub parse_vol_dir_blk {
|
|
my ($buf, $mode, $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 $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;
|
|
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 != 0x00 || $mode == 3) {
|
|
my $f_type = $ftype{$file_type};
|
|
$f_type = sprintf("\$%02x", $file_type) unless defined $f_type;
|
|
push @files, { 'prv' => $prv_vol_dir_blk, 'nxt' => $nxt_vol_dir_blk, '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, 'header_pointer' => $header_pointer, 'i' => $i };
|
|
} else {
|
|
if ($mode == 2) {
|
|
push @files, { 'header_pointer' => $header_pointer, 'i' => $i };
|
|
}
|
|
}
|
|
}
|
|
|
|
return $prv_vol_dir_blk, $nxt_vol_dir_blk, @files;
|
|
}
|
|
|
|
#
|
|
# Get Volume Directory Block
|
|
#
|
|
sub get_vol_dir_blk {
|
|
my ($pofile, $vol_dir_blk, $mode, $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, $mode, $debug);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
# Parse Key Volume Directory Block
|
|
sub parse_subdir_hdr_blk {
|
|
my ($buf, $mode, $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) >> 4;
|
|
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;
|
|
my $storage_type = ($storage_type_name_length & 0xf0) >> 4;
|
|
printf("storage_type_name_length=%02x\n", $storage_type_name_length) if $debug;
|
|
printf("storage_type=%02x\n", $storage_type) if $debug;
|
|
my $name_length = $storage_type_name_length & 0x0f;
|
|
printf("name_length=%02x\n", $name_length) if $debug;
|
|
my $file_name = shift @flds;
|
|
my $fname = substr($file_name, 0, $name_length);
|
|
printf("fname=%s\n", $fname) if $debug;
|
|
my $file_type = shift @flds;
|
|
printf("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 != 0x00) {
|
|
my $f_type = $ftype{$file_type};
|
|
$f_type = sprintf("\$%02x", $file_type) unless defined $f_type;
|
|
push @files, { 'prv' => $prv_vol_dir_blk, 'nxt' => $nxt_vol_dir_blk, '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, 'header_pointer' => $header_pointer, 'i' => $i };
|
|
} else {
|
|
if ($mode == 2) {
|
|
push @files, { 'header_pointer' => $header_pointer, 'i' => $i };
|
|
} elsif ($mode == 3) {
|
|
my $f_type = $ftype{$file_type};
|
|
$f_type = sprintf("\$%02x", $file_type) unless defined $f_type;
|
|
push @files, { 'prv' => $prv_vol_dir_blk, 'nxt' => $nxt_vol_dir_blk, '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, 'header_pointer' => $header_pointer, 'i' => $i };
|
|
}
|
|
}
|
|
}
|
|
|
|
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, $mode, $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, $mode, $debug);
|
|
}
|
|
|
|
print "I/O Error reading block $subdir_blk\n";
|
|
|
|
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 = '*';
|
|
}
|
|
printf("$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, 1, $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, 1, $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 = '*';
|
|
}
|
|
printf("%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, 1, $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, 1, $debug);
|
|
foreach my $file (@files) {
|
|
my $lck = ' ';
|
|
if ($file->{'access'} == 0x01) {
|
|
$lck = '*';
|
|
}
|
|
printf("%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, 1, $debug);
|
|
|
|
my $pre = ' ';
|
|
list_files($pofile, ' ' . $pre, $subdir_name, \@subfiles);
|
|
}
|
|
}
|
|
$vol_dir_blk = $nxt_vol_dir_blk;
|
|
}
|
|
}
|
|
|
|
# Parse master index block (tree file)
|
|
sub parse_master_ind_blk {
|
|
my ($buf, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my @lo = unpack $master_ind_blk_lo_tmpl, $buf;
|
|
my @hi = unpack $master_ind_blk_hi_tmpl, $buf;
|
|
|
|
#print "lo=\n";
|
|
#my $l = 0;
|
|
#foreach my $lob (@lo) {
|
|
# print "\n" if !($l++ % 16);
|
|
# printf("%02x ", $lob);
|
|
#}
|
|
#print "\n";
|
|
|
|
#print "hi=\n";
|
|
#my $h = 0;
|
|
#foreach my $hib (@hi) {
|
|
# print "\n" if !($h++ % 16);
|
|
# printf("%02x ", $hib);
|
|
#}
|
|
#print "\n";
|
|
|
|
my @blocks = ();
|
|
|
|
#print "blks=\n";
|
|
foreach (my $blkno = 0; $blkno < 256; $blkno++) {
|
|
#my $v = ($hi[$blkno] << 8) | $lo[$blkno];
|
|
#printf("blkno=%d lo=%02x hi=%02x block=%04x\n", $blkno, $lo[$blkno], $hi[$blkno], $v);
|
|
#print "\n" if !($blkno++ % 16);
|
|
$blocks[$blkno] = ($hi[$blkno] << 8) | $lo[$blkno];
|
|
#printf("%04x ", $blocks[$blkno]);
|
|
}
|
|
#print "\n";
|
|
|
|
return @blocks;
|
|
}
|
|
|
|
# Get master index block (tree file)
|
|
sub get_master_ind_blk {
|
|
my ($pofile, $master_ind_blk, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
#print "pofile=$pofile master_ind_blk=$master_ind_blk\n";
|
|
|
|
my $buf;
|
|
|
|
if (read_blk($pofile, $master_ind_blk, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
} else {
|
|
print "I/O Error reading block $master_ind_blk\n";
|
|
}
|
|
|
|
return parse_master_ind_blk($buf, $debug);
|
|
}
|
|
|
|
# Parse sub index block (tree file)
|
|
sub parse_sub_ind_blk {
|
|
my ($buf, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my @lo = unpack $sub_ind_blk_lo_tmpl, $buf;
|
|
my @hi = unpack $sub_ind_blk_hi_tmpl, $buf;
|
|
|
|
#print "lo=\n";
|
|
#my $l = 0;
|
|
#foreach my $lob (@lo) {
|
|
# print "\n" if !($l++ % 16);
|
|
# printf("%02x ", $lob);
|
|
#}
|
|
#print "\n";
|
|
|
|
#print "hi=\n";
|
|
#my $h = 0;
|
|
#foreach my $hib (@hi) {
|
|
# print "\n" if !($h++ % 16);
|
|
# printf("%02x ", $hib);
|
|
#}
|
|
#print "\n";
|
|
|
|
my @blocks = ();
|
|
|
|
#print "subblks=\n";
|
|
foreach (my $blkno = 0; $blkno < 256; $blkno++) {
|
|
# print "\n" if !($blkno++ % 16);
|
|
$blocks[$blkno] = ($hi[$blkno] << 8) | $lo[$blkno];
|
|
# printf("%04x ", $blocks[$blkno]);
|
|
}
|
|
#print "\n";
|
|
|
|
return @blocks;
|
|
}
|
|
|
|
# Get sub index block (tree file)
|
|
sub get_sub_ind_blk {
|
|
my ($pofile, $sub_ind_blk, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
#print "pofile=$pofile sub_ind_blk=$sub_ind_blk\n";
|
|
|
|
my $buf;
|
|
|
|
my @blocks = ();
|
|
|
|
if (read_blk($pofile, $sub_ind_blk, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
#dump_blk($buf);
|
|
} else {
|
|
print "I/O Error reading block $sub_ind_blk\n";
|
|
}
|
|
|
|
return parse_sub_ind_blk($buf, $debug);
|
|
}
|
|
|
|
# Get index block (sapling file)
|
|
sub get_ind_blk {
|
|
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) {
|
|
# printf("%02x ", $byte);
|
|
#}
|
|
#print "\n";
|
|
my @hi = unpack "x256C256", $buf;
|
|
#foreach my $byte (@hi) {
|
|
# printf("%02x ", $byte);
|
|
#}
|
|
#print "\n";
|
|
for (my $b = 0; $b < 256; $b++) {
|
|
#printf("lo=%02x hi=%02x\n", $lo[$b], $hi[$b]);
|
|
my $blk = ($hi[$b] << 8) | $lo[$b];
|
|
#printf("blk=%04x\n", $blk);
|
|
push @blocks, $blk;
|
|
}
|
|
#print "blocks=\n";
|
|
#my $x = 0;
|
|
#foreach my $block (@blocks) {
|
|
# printf("%04x ", $block);
|
|
# $x++;
|
|
# print "\n" if !($x % 16);
|
|
#}
|
|
#print "\n";
|
|
} else {
|
|
print "I/O Error reading block $ind_blk\n";
|
|
}
|
|
|
|
return @blocks;
|
|
}
|
|
|
|
#
|
|
# Find empty file descriptive entry slot.
|
|
#
|
|
sub find_empty_fdescent {
|
|
my ($pofile, $subdir, $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, 2, $debug);
|
|
|
|
my @subdirs = ();
|
|
if ($subdir =~ /\//) {
|
|
@subdirs = split /\//, $subdir;
|
|
foreach my $subd (@subdirs) {
|
|
print "subd=$subd\n";
|
|
}
|
|
} else {
|
|
push @subdirs, $subdir;
|
|
}
|
|
##FIXME
|
|
|
|
if (! defined $subdir || $subdir eq '') {
|
|
# Must find a slot in the master directory.
|
|
print "Master directory\n";
|
|
my $found_it = 0;
|
|
foreach my $file (@files) {
|
|
next if ! defined $file->{'header_pointer'} || $file->{'header_pointer'} eq '';
|
|
next if ($file->{'storage_type'} != 0);
|
|
$found_it = 1;
|
|
print "Found empty slot header_pointer=$file->{'header_pointer'} slot=$file->{'i'}\n" if $debug;
|
|
return $file->{'header_pointer'}, $file->{'i'};
|
|
}
|
|
|
|
print "No space in master directory\n";
|
|
} else {
|
|
# If subdir not found then bag out.
|
|
print "Subdirectory $subdir\n";
|
|
##FIXME
|
|
}
|
|
|
|
print "No directory space available\n";
|
|
|
|
return 0, 0;
|
|
}
|
|
|
|
#
|
|
# Find a file
|
|
#
|
|
sub find_file {
|
|
my ($pofile, $filename, $mode, $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 $eof = 0x00;
|
|
my $header_pointer = '';
|
|
my $file_index = 0;
|
|
|
|
# Parse subdirectories
|
|
##FIXME -- needs to handle multiple subdirectory levels.
|
|
my $base_dir = '';
|
|
my $fname = '';
|
|
if ($filename =~ /^(\S+)\/(\S+)/) {
|
|
# Contains subdirs.
|
|
$base_dir = $1;
|
|
$fname = $2;
|
|
}
|
|
|
|
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, $mode, $debug);
|
|
|
|
my $found_it = 0;
|
|
foreach my $file (@files) {
|
|
if ($base_dir eq '') {
|
|
#print "file='$file->{'filename'}'\n";
|
|
#print "filename='$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'};
|
|
$eof = $file->{'eof'};
|
|
$header_pointer = $file->{'header_pointer'};
|
|
$file_index = $file->{'i'};
|
|
last;
|
|
#} else {
|
|
# print "NOT MATCH '$file->{'filename'}' '$filename'\n";
|
|
}
|
|
} else {
|
|
if ($file->{'filename'} eq $base_dir) {
|
|
#print "FOUND IT!\n";
|
|
$found_it = 1;
|
|
$storage_type = $file->{'storage_type'};
|
|
$file_type = $file->{'ftype'};
|
|
$key_pointer = $file->{'keyptr'};
|
|
$blocks_used = $file->{'used'};
|
|
$eof = $file->{'eof'};
|
|
$header_pointer = $file->{'header_pointer'};
|
|
$file_index = $file->{'i'};
|
|
|
|
# Now read the subdir(s) and look for the file.
|
|
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, $key_pointer, $mode, $debug);
|
|
|
|
foreach my $subfile (@subfiles) {
|
|
#print "filename=$subfile->{'filename'}\n";
|
|
if ($subfile->{'filename'} eq $fname) {
|
|
#print "FOUND IT!\n";
|
|
$found_it = 1;
|
|
$storage_type = $subfile->{'storage_type'};
|
|
$file_type = $subfile->{'ftype'};
|
|
$key_pointer = $subfile->{'keyptr'};
|
|
$blocks_used = $subfile->{'used'};
|
|
$eof = $subfile->{'eof'};
|
|
$header_pointer = $subfile->{'header_pointer'};
|
|
$file_index = $subfile->{'i'};
|
|
#} else {
|
|
# print "NOT MATCH\n";
|
|
}
|
|
}
|
|
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, $mode, $debug);
|
|
|
|
foreach my $file (@files) {
|
|
if ($base_dir eq '') {
|
|
#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'};
|
|
$eof = $file->{'eof'};
|
|
$header_pointer = $file->{'header_pointer'};
|
|
$file_index = $file->{'i'};
|
|
last;
|
|
#} else {
|
|
# print "NOT MATCH\n";
|
|
}
|
|
} else {
|
|
if ($file->{'filename'} eq $base_dir) {
|
|
#print "FOUND IT!\n";
|
|
$found_it = 1;
|
|
$storage_type = $file->{'storage_type'};
|
|
$file_type = $file->{'ftype'};
|
|
$key_pointer = $file->{'keyptr'};
|
|
$blocks_used = $file->{'used'};
|
|
$eof = $file->{'eof'};
|
|
$header_pointer = $file->{'header_pointer'};
|
|
$file_index = $file->{'i'};
|
|
|
|
# Now read the subdir(s) and look for the file.
|
|
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, $key_pointer, $mode, $debug);
|
|
|
|
foreach my $subfile (@subfiles) {
|
|
#print "filename=$subfile->{'filename'}\n";
|
|
if ($subfile->{'filename'} eq $fname) {
|
|
#print "FOUND IT!\n";
|
|
$found_it = 1;
|
|
$storage_type = $subfile->{'storage_type'};
|
|
$file_type = $subfile->{'ftype'};
|
|
$key_pointer = $subfile->{'keyptr'};
|
|
$blocks_used = $subfile->{'used'};
|
|
$eof = $subfile->{'eof'};
|
|
$header_pointer = $subfile->{'header_pointer'};
|
|
$file_index = $subfile->{'i'};
|
|
#} else {
|
|
# print "NOT MATCH\n";
|
|
}
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
$vol_dir_blk = $nxt_vol_dir_blk;
|
|
last if $found_it;
|
|
}
|
|
}
|
|
|
|
print "File not found\n" unless $found_it;
|
|
|
|
return $storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $file_index;
|
|
}
|
|
|
|
#
|
|
# Read a file
|
|
#
|
|
sub read_file {
|
|
my ($pofile, $filename, $mode, $conv, $text_conv, $output_file, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
$output_file = '' unless defined $output_file;
|
|
|
|
$debug = 1;
|
|
print "pofile=$pofile filename=$filename mode=$mode conv=$conv text_conv=$text_conv output_filename=$output_file\n" if $debug;
|
|
$debug = 0;
|
|
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof) = find_file($pofile, $filename, 1, $debug);
|
|
|
|
#print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof\n";
|
|
|
|
return 0 if $storage_type == 0;
|
|
|
|
my $buf;
|
|
|
|
my $ofh;
|
|
|
|
if ($output_file eq '') {
|
|
$ofh = \*STDOUT;
|
|
} else {
|
|
if (!open($ofh, ">$output_file")) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used\n" if $debug;
|
|
|
|
# Seedling file, only 1 block
|
|
if ($storage_type == 1) {
|
|
my $buf2;
|
|
|
|
if (read_blk($pofile, $key_pointer, \$buf2)) {
|
|
dump_blk($buf) if $debug;
|
|
my @bytes = unpack "C*", $buf2;
|
|
foreach my $byte (@bytes) {
|
|
# For text file translation.
|
|
last if $byte == 0x00 && $mode eq 'T';
|
|
# Translate \r to \n
|
|
$byte = 0x0a if $byte == 0x8d && $conv;
|
|
# Convert Apple II ASCII to standard ASCII (clear high bit)
|
|
$byte &= 0x7f if $mode eq 'T' || $text_conv;
|
|
#printf("%c", $byte & 0x7f);
|
|
printf("%c", $byte);
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $key_pointer\n";
|
|
}
|
|
# 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";
|
|
clear_buf(\$buf2);
|
|
if (read_blk($pofile, $blk, \$buf2)) {
|
|
dump_blk($buf2) if $debug;
|
|
my @bytes = unpack "C*", $buf2;
|
|
#my $x = 0;
|
|
#print "bytes=\n";
|
|
foreach my $byte (@bytes) {
|
|
# For text file translation.
|
|
last if $byte == 0x00 && $mode eq 'T';
|
|
# Translate \r to \n
|
|
$byte = 0x0a if $byte == 0x8d && $conv;
|
|
# Convert Apple II ASCII to standard ASCII (clear high bit)
|
|
$byte &= 0x7f if $mode eq 'T' || $text_conv;
|
|
print $ofh sprintf("%c", $byte);
|
|
#$x++;
|
|
#printf("%02x ", $byte);
|
|
#print "\n" if !($x % 16);
|
|
}
|
|
#print "\n";
|
|
#print "Wrote $x bytes\n";
|
|
} else {
|
|
print "I/O Error reading block $blk\n";
|
|
}
|
|
last if $blkno++ == $blocks_used - 1;
|
|
}
|
|
# Truncate file to size.
|
|
my $result = truncate $ofh, $eof;
|
|
# Tree file, 257+ blocks
|
|
} elsif ($storage_type == 3) {
|
|
my $buf2;
|
|
|
|
my @blks = get_master_ind_blk($pofile, $key_pointer, $debug);
|
|
|
|
#foreach my $blk (@blks) {
|
|
# print "blk=$blk\n";
|
|
# last if $blk == 0;
|
|
#}
|
|
my $blkno = 1;
|
|
foreach my $blk (@blks) {
|
|
#print "blkno=$blkno blk=$blk\n";
|
|
last if $blk == 0;
|
|
my @subblks = get_sub_ind_blk($pofile, $blk, $debug);
|
|
|
|
#foreach my $sblk (@subblks) {
|
|
# #print "sblk=$sblk\n";
|
|
# last if $sblk == 0;
|
|
#}
|
|
#die "ACK!\n";
|
|
|
|
foreach my $subblk (@subblks) {
|
|
last if $subblk == 0;
|
|
clear_buf(\$buf2);
|
|
if (read_blk($pofile, $subblk, \$buf2)) {
|
|
dump_blk($buf2) if $debug;
|
|
my @bytes = unpack "C*", $buf2;
|
|
#my $x = 0;
|
|
#print "bytes=\n";
|
|
foreach my $byte (@bytes) {
|
|
# For text file translation.
|
|
last if $byte == 0x00 && $mode eq 'T';
|
|
# Translate \r to \n
|
|
$byte = 0x0a if $byte == 0x8d && $conv;
|
|
# Convert Apple II ASCII to standard ASCII (clear high bit)
|
|
$byte &= 0x7f if $mode eq 'T' || $text_conv;
|
|
print $ofh sprintf("%c", $byte);
|
|
#$x++;
|
|
#printf("%02x ", $byte);
|
|
#print "\n" if !($x % 16);
|
|
}
|
|
#print "\n";
|
|
#print "Wrote $x bytes\n";
|
|
} else {
|
|
print "I/O Error reading block $subblk\n";
|
|
}
|
|
last if $blkno++ == $blocks_used - 1;
|
|
}
|
|
# Truncate file to size.
|
|
my $result = truncate $ofh, $eof;
|
|
}
|
|
} else {
|
|
print "Not a regular file!\n";
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Parse volume bit map
|
|
#
|
|
sub parse_vol_bit_map {
|
|
my ($buf, $dbg) = @_;
|
|
|
|
my @blocks = ();
|
|
|
|
my (@bytes) = unpack $vol_bit_map_tmpl, $buf;
|
|
|
|
foreach my $byte (@bytes) {
|
|
#printf("%02x ", $byte);
|
|
#printf("%08b ", $byte);
|
|
push @blocks, $byte;
|
|
}
|
|
print "\n";
|
|
|
|
return @blocks;
|
|
}
|
|
|
|
#
|
|
# Pack volume bit map
|
|
#
|
|
sub pack_vol_bit_map {
|
|
my ($bytes, $dbg) = @_;
|
|
|
|
my $buf = pack $vol_bit_map_tmpl, @{$bytes};
|
|
|
|
return $buf;
|
|
}
|
|
|
|
#
|
|
# Get volume bit map
|
|
#
|
|
sub get_vol_bit_map {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my ($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_vol_dir_blk($pofile, 1, $debug);
|
|
|
|
my $buf;
|
|
|
|
#printf("bit_map_pointer=%04x\n", $bit_map_pointer) if $debug;
|
|
|
|
# Need to use total_blocks to calculate the number of volume bit map blocks.
|
|
#printf("total_blocks=\$%04x\n", $total_blocks);
|
|
my $num_tracks = $total_blocks / 8;
|
|
#printf("num_tracks=%d\n", $num_tracks);
|
|
my $num_vol_bit_map_blks = ceil($num_tracks / 512.0);
|
|
#printf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
|
|
$num_vol_bit_map_blks = 1 if $num_vol_bit_map_blks < 1;
|
|
#printf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
|
|
|
|
my @blocks = ();
|
|
|
|
my $trk = 0;
|
|
for (my $blk = $bit_map_pointer; $blk < $bit_map_pointer + $num_vol_bit_map_blks; $blk++) {
|
|
clear_buf(\$buf);
|
|
if (read_blk($pofile, $bit_map_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
#dump_blk($buf);
|
|
my (@blks) = parse_vol_bit_map($buf, $debug);
|
|
foreach my $blk (@blks) {
|
|
#print "trk=$trk blk=$blk\n";
|
|
last if $trk++ >= $num_tracks;
|
|
#printf("%02x ", $blk);
|
|
push @blocks, $blk;
|
|
}
|
|
#print "\n";
|
|
} else {
|
|
print "I/O Error reading block $bit_map_pointer\n";
|
|
}
|
|
}
|
|
|
|
return @blocks;
|
|
}
|
|
|
|
sub write_vol_bit_map {
|
|
my ($pofile, $bitmaps, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
#print "in write_vol_bit map\n";
|
|
|
|
my ($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_vol_dir_blk($pofile, 1, $debug);
|
|
|
|
printf("bit_map_pointer=%04x\n", $bit_map_pointer) if $debug;
|
|
|
|
# Need to use total_blocks to calculate the number of volume bit map blocks.
|
|
#printf("total_blocks=\$%04x\n", $total_blocks);
|
|
my $num_tracks = $total_blocks / 8;
|
|
#printf("num_tracks=%d\n", $num_tracks);
|
|
my $num_vol_bit_map_blks = ceil($num_tracks / 512.0);
|
|
#printf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
|
|
$num_vol_bit_map_blks = 1 if $num_vol_bit_map_blks < 1;
|
|
#printf("num_vol_bit_map_blks=%d\n", $num_vol_bit_map_blks);
|
|
|
|
# Handle multiple vol bit map blocks
|
|
for (my $vbmb = 0; $vbmb < $num_vol_bit_map_blks; $vbmb++) {
|
|
my @bytes = splice @{$bitmaps}, 0, 512;
|
|
|
|
my $buf = pack $vol_bit_map_tmpl, @bytes;
|
|
|
|
if (!write_blk($pofile, $bit_map_pointer + $vbmb, \$buf)) {
|
|
print "I/O Error writing block " . ($bit_map_pointer + $vbmb) . "\n";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Count free blocks
|
|
#
|
|
sub freespace {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my (@blocks) = get_vol_bit_map($pofile, $debug);
|
|
|
|
my $free_blocks = 0;
|
|
foreach my $byte (@blocks) {
|
|
$free_blocks += $ones_count{($byte >> 4) & 0x0f}; # Blocks 7654
|
|
$free_blocks += $ones_count{$byte & 0x0f}; # Blocks 3210
|
|
}
|
|
|
|
return $free_blocks;
|
|
}
|
|
|
|
#
|
|
# Display blocks free map
|
|
#
|
|
sub freemap {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my (@blocks) = get_vol_bit_map($pofile, $debug);
|
|
|
|
print " 01234567\n";
|
|
print " +--------\n";
|
|
|
|
my $free_blocks = 0;
|
|
my $max_trk = scalar @blocks;
|
|
#print "max_trk=$max_trk\n";
|
|
my $trk = 0;
|
|
foreach my $byte (@blocks) {
|
|
my $bits = sprintf("%08b", $byte);
|
|
$bits =~ s/[0]/\*/g;
|
|
$bits =~ s/[1]/ /g;
|
|
printf("%2d |%s\n", $trk++, $bits);
|
|
$free_blocks += $ones_count{($byte >> 4) & 0x0f}; # Blocks 7654
|
|
$free_blocks += $ones_count{$byte & 0x0f}; # Blocks 3210
|
|
}
|
|
print "\nFree Blocks $free_blocks\n";
|
|
}
|
|
|
|
#
|
|
# Get list of free blocks
|
|
#
|
|
sub get_free_blocks {
|
|
my ($pofile, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
my (@blocks) = get_vol_bit_map($pofile, $debug);
|
|
|
|
my @free_blocks = ();
|
|
|
|
my $block = 0;
|
|
foreach my $byte (@blocks) {
|
|
#printf("byte=%02x %08b\n", $byte, $byte);
|
|
for (my $bit = 0; $bit < 8; $bit++) {
|
|
if ($byte & (0x80 >> $bit)) {
|
|
#print "pushing block $block\n";
|
|
# Block zero should never be free.
|
|
push @free_blocks, $block if $block != 0;
|
|
}
|
|
$block++;
|
|
}
|
|
}
|
|
|
|
#print "Free blocks=\n";
|
|
#my $blkno = 0;
|
|
#foreach my $blk (@free_blocks) {
|
|
# print "\n" if !($blkno % 16);
|
|
# printf("%04x ", $blk);
|
|
# $blkno++;
|
|
#}
|
|
#print "\n";
|
|
|
|
#return reverse sort { $a <=> $b } @free_blocks;
|
|
return reverse @free_blocks;
|
|
}
|
|
|
|
#
|
|
# Write a file
|
|
#
|
|
sub write_file {
|
|
my ($pofile, $filename, $mode, $conv, $apple_filename, $ft, $at, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename mode=$mode conv=$conv apple_filename=$apple_filename\n" if $debug;
|
|
|
|
# Need to make sure the file doesn't already exist.
|
|
my ($storage_type, $t_file_type, $t_key_pointer, $blocks_used, $eof, $t_header_pointer, $t_i) = find_file($pofile, $filename, 1, $debug);
|
|
if ($storage_type != 0) {
|
|
print "File exists\n";
|
|
return 0;
|
|
}
|
|
|
|
# Check for existance of source file.
|
|
if (! -e $filename) {
|
|
print "File $filename does not exist.\n";
|
|
return 0;
|
|
}
|
|
|
|
# Get size of input file
|
|
my $fsize = -s $filename;
|
|
print "fsize=$fsize\n";
|
|
|
|
my $numblocks = int($fsize / 512) + (($fsize % 512) ? 1 : 0);
|
|
print "numblocks=$numblocks\n";
|
|
|
|
$blocks_used = $numblocks;
|
|
|
|
# Get list of free blocks.
|
|
my @free_blocks = get_free_blocks($pofile, $debug);
|
|
|
|
my $free_count = scalar @free_blocks;
|
|
|
|
if ($free_count < $numblocks) {
|
|
print "Not enough space on volume, $free_count free blocks, need $numblocks\n";
|
|
return 0;
|
|
}
|
|
|
|
my $subdir = '';
|
|
my $apple_fname = $apple_filename;
|
|
if ($apple_filename =~ /^[\/]*([^\/]+)\/(\S+)$/) {
|
|
$subdir = $1;
|
|
$apple_fname = $2;
|
|
}
|
|
print "subdir=$subdir apple_fname=$apple_fname\n";
|
|
|
|
# Find an empty file descriptive entry in the proper subdirectory.
|
|
my ($header_pointer, $i) = find_empty_fdescent($pofile, $subdir, $debug);
|
|
printf("header_pointer=\$%04x i=%d\n", $header_pointer, $i);
|
|
if ($header_pointer == 0) {
|
|
# May need to add a subdirectory block if the directory is full.
|
|
##FIXME
|
|
print "No directory space available\n";
|
|
return 0;
|
|
}
|
|
|
|
my $rv = 1;
|
|
|
|
# Default file storage type -- 0x00 is deleted.
|
|
my $file_storage_type = 0x00;
|
|
# Set file type, default TXT.
|
|
my $file_type = $typef{'TXT'};
|
|
if (defined $typef{$ft} && $ft ne '') {
|
|
$file_type = $typef{$ft};
|
|
} else {
|
|
print "Unknown file type $ft\n" if $ft ne '';
|
|
}
|
|
|
|
my $key_pointer = 0x00;
|
|
my $aux_type = 0x00;
|
|
if (defined $at && $at ne '') {
|
|
print "at=$at\n" if $debug;
|
|
if ($at =~ /^\$([0-9a-fA-F]+)/) {
|
|
print "1=$1\n" if $debug;
|
|
$aux_type = hex(lc($1));
|
|
} else {
|
|
print "aux_type=$at\n" if $debug;
|
|
$aux_type = $at;
|
|
}
|
|
} elsif ($ft eq 'BIN') {
|
|
print "Setting default aux_type for BIN\n" if $debug;
|
|
# Default this to 0x2000 for binary files.
|
|
$aux_type = 0x2000;
|
|
}
|
|
|
|
# Read in the file.
|
|
my $ifh;
|
|
my $file_buffer;
|
|
my @used_blocks = ();
|
|
if (open($ifh, "<$filename")) {
|
|
my $file_buffer = <$ifh>;
|
|
|
|
my @bytes = unpack "C*", $file_buffer;
|
|
|
|
if ($numblocks == 1) {
|
|
# Seedling file.
|
|
$file_storage_type = 0x10;
|
|
|
|
# Get a block off the free blocks list.
|
|
my $blknum = pop @free_blocks;
|
|
$key_pointer = $blknum;
|
|
|
|
print "blknum=$blknum\n";
|
|
|
|
# Pack the data for the block.
|
|
my $blkbuf = pack "C*", @bytes;
|
|
|
|
# Write the single block
|
|
if (!write_blk($pofile, $blknum, \$blkbuf)) {
|
|
print "I/O Error writeing block $blknum\n";
|
|
return 0;
|
|
} else {
|
|
# Add the block to the used blocks.
|
|
push @used_blocks, $blknum;
|
|
}
|
|
} elsif ($numblocks <= 256) {
|
|
# Sapling file.
|
|
$file_storage_type = 0x20;
|
|
|
|
# Get a block off the free blocks list for the index block.
|
|
my $blknum = pop @free_blocks;
|
|
$key_pointer = $blknum;
|
|
|
|
# Data for index block.
|
|
my @indbytes = ();
|
|
|
|
# Add index block to used blocks
|
|
push @used_blocks, $blknum;
|
|
|
|
# Write out the data blocks.
|
|
for (my $blk = 0; $blk < $numblocks; $blk++) {
|
|
# Get a free block.
|
|
my $datablknum = pop @free_blocks;
|
|
|
|
# Get the data for this block
|
|
my @databytes = splice @bytes, 0, 512;
|
|
|
|
# Pack the data.
|
|
my $databuf = pack "C*", @databytes;
|
|
|
|
# Write out the block
|
|
if (!write_blk($pofile, $datablknum, \$databuf)) {
|
|
print "I/O Error writeing block $datablknum\n";
|
|
}
|
|
|
|
# Add each block to used blocks list.
|
|
push @used_blocks, $datablknum;
|
|
|
|
# Add block to index block
|
|
$indbytes[$blk] = $datablknum & 0xff00; # LO byte
|
|
$indbytes[$blk + 256] = $datablknum >> 8; # HI byte
|
|
}
|
|
|
|
my $indbuf = pack "C*", @indbytes;
|
|
|
|
# Write out the index block.
|
|
if (!write_blk($pofile, $blknum, \$indbuf)) {
|
|
print "I/O Error writing block $blknum\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
# Tree file.
|
|
$file_storage_type = 0x30;
|
|
|
|
# Create the master index block.
|
|
my @master_index = ();
|
|
my $masterblknum = pop @free_blocks;
|
|
$key_pointer = $masterblknum;
|
|
|
|
# Add master index block to used blocks
|
|
push @used_blocks, $masterblknum;
|
|
|
|
# Create the first subindex block.
|
|
my @indbytes = ();
|
|
my $subblknum = pop @free_blocks;
|
|
|
|
# Write out the data blocks.
|
|
my $cursub = 0;
|
|
my $curblk = 0;
|
|
for (my $blk = 0; $blk < $numblocks; $blk++) {
|
|
# Get a free block.
|
|
my $datablknum = pop @free_blocks;
|
|
|
|
# Get the data for this block
|
|
my @databytes = splice @bytes, 0, 512;
|
|
|
|
# Add each block to used blocks list.
|
|
push @used_blocks, $datablknum;
|
|
my $subblknum = pop @free_blocks;
|
|
|
|
# Add block to current sub index block
|
|
$indbytes[$curblk] = $datablknum & 0xff00; # LO byte
|
|
$indbytes[$curblk + 256] = $datablknum >> 8; # HI byte
|
|
$curblk++;
|
|
|
|
# If the current index block is full or last block write out the sub index block.
|
|
if ($curblk > 255 || $blk == ($numblocks - 1)) {
|
|
# Add each subindex block to used blocks
|
|
push @used_blocks, $subblknum;
|
|
|
|
# Write out the sub index block
|
|
my $subindexbuf = pack "C*", @indbytes;
|
|
|
|
if (!write_blk($pofile, $subblknum, \$subindexbuf)) {
|
|
print "I/O Error writing block $subblknum\n";
|
|
return 0;
|
|
}
|
|
|
|
# Add each sub index block to the master block.
|
|
$master_index[$cursub] = $subblknum & 0xff00; # LO byte
|
|
$master_index[$cursub + 1] = $subblknum >> 8; # HI byte
|
|
$cursub += 2;
|
|
|
|
# Get ready for next index block.
|
|
$curblk = 0;
|
|
@indbytes = ();
|
|
$subblknum = pop @free_blocks;
|
|
}
|
|
}
|
|
|
|
# Write out the master index block.
|
|
my $masterbuf = pack "C*", @master_index;
|
|
|
|
if (!write_blk($pofile, $masterblknum, \$masterbuf)) {
|
|
print "I/O Error writing block $masterblknum\n";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Read & rewrite the file descriptive entry out.
|
|
my $dirbuf;
|
|
|
|
$header_pointer = 2 if $header_pointer == 0;
|
|
|
|
if (read_blk($pofile, $header_pointer, \$dirbuf)) {
|
|
dump_blk($dirbuf) if $debug;
|
|
#dump_blk($dirbuf);
|
|
|
|
my @bytes = unpack "C*", $dirbuf;
|
|
|
|
my $storage_type = $bytes[4] >> 4;
|
|
#printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
if ($storage_type == 0x0f || $storage_type == 0x0e) {
|
|
# Fill in STORAGE_TYPE/NAME_LENGTH
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
$file_storage_type &= 0xf0;
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
$file_storage_type |= length($apple_filename);
|
|
$bytes[0x2b + ($i* 0x27)] = $file_storage_type;
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
|
|
# Fill in FILE_NAME
|
|
my $filename_start = 0x2b + ($i * 0x27) + 0x01;
|
|
#print"filename_start=$filename_start\n";
|
|
#print "filename='";
|
|
my $j = 0;
|
|
for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
#printf("%c", $bytes[$i]);
|
|
if ($j < length($apple_filename)) {
|
|
$bytes[$i] = ord(substr($apple_filename, $j++, 1));
|
|
} else {
|
|
$bytes[$i] = 0x00;
|
|
}
|
|
}
|
|
#print "'\n";
|
|
#print "filename='";
|
|
#for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
# printf("%c", $bytes[$i]);
|
|
#}
|
|
#print "'\n";
|
|
|
|
# Fill in FILE_TYPE
|
|
$bytes[0x2b + ($i * 0x27) + 0x10] = $file_type;
|
|
|
|
# Fill in LO byte of KEY_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x11] = $key_pointer & 0x00ff;
|
|
# Fill in HI byte of KEY_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x12] = (($key_pointer & 0xff00) >> 8);
|
|
|
|
# Fill in LO byte of BLOCKS_USED
|
|
$bytes[0x2b + ($i * 0x27) + 0x13] = $blocks_used & 0x00ff;
|
|
# Fill in HI byte of BLOCKS_USED
|
|
$bytes[0x2b + ($i * 0x27) + 0x14] = (($blocks_used & 0xff00) >> 8);
|
|
|
|
# Fill in EOF
|
|
$bytes[0x2b + ($i * 0x27) + 0x15] = $fsize & 0x0000ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x16] = ($fsize & 0x00ff00) >> 8;
|
|
$bytes[0x2b + ($i * 0x27) + 0x17] = ($fsize & 0xff0000) >> 16;
|
|
|
|
# Fill in CREATION
|
|
my ($ymd, $hm) = current_date();
|
|
$bytes[0x2b + ($i * 0x27) + 0x18] = $ymd & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x19] = ($ymd >> 8) & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x1a] = $hm & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x1b] = ($hm >> 8) & 0x00ff;
|
|
|
|
# Fill in VERSION -- default to ProDOS 1.0
|
|
$bytes[0x2b + ($i * 0x27) + 0x1c] = 0x00;
|
|
|
|
# Fill in MIN_VERSION -- default to ProDOS 1.0
|
|
$bytes[0x2b + ($i * 0x27) + 0x1d] = 0x00;
|
|
|
|
# Fill in ACCESS -- default to unlocked.
|
|
$bytes[0x2b + ($i * 0x27) + 0x1e] = 0xc3;
|
|
|
|
# Fill in LO byte of AUX_TYPE
|
|
$bytes[0x2b + ($i * 0x27) + 0x1f] = $aux_type & 0x00ff;
|
|
# Fill in HI byte of AUX_TYPE
|
|
$bytes[0x2b + ($i * 0x27) + 0x20] = (($aux_type & 0xff00) >> 8);
|
|
##FIXME
|
|
|
|
# Fill in LAST_MOD
|
|
$bytes[0x2b + ($i * 0x27) + 0x21] = $ymd & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x22] = ($ymd >> 8) & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x23] = $hm & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x24] = ($hm >> 8) & 0x00ff;
|
|
|
|
# Fill in LO byte of HEADER_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x25] = $header_pointer & 0x00ff;
|
|
# Fill in HI byte of HEADER_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x26] = (($header_pointer & 0xff00) >> 8);
|
|
} else {
|
|
printf("Invalid storage type \$%02x\n", $storage_type);
|
|
return 0;
|
|
}
|
|
|
|
# Fix FILE_COUNT in directory.
|
|
##FIXME
|
|
|
|
$dirbuf = pack "C*", @bytes;
|
|
|
|
dump_blk($dirbuf) if $debug;
|
|
#dump_blk($dirbuf);
|
|
|
|
# Write the file descriptive entry back out.
|
|
if (!write_blk($pofile, $header_pointer, \$dirbuf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
# Mark blocks as used.
|
|
$rv = reserve_blocks($pofile, \@used_blocks, $debug);
|
|
} else {
|
|
return 0;
|
|
}
|
|
|
|
return $rv;
|
|
}
|
|
|
|
#
|
|
# Rename a file
|
|
#
|
|
sub rename_file {
|
|
my ($pofile, $filename, $new_filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
#print "pofile=$pofile filename=$filename new_filename=$new_filename\n" if $debug;
|
|
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, 1, $debug);
|
|
|
|
#print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
|
|
|
|
return 0 if $storage_type == 0;
|
|
|
|
my $buf;
|
|
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
#dump_blk($buf);
|
|
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
my $storage_type = $bytes[4] >> 4;
|
|
#printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
if ($storage_type == 0x0f || $storage_type == 0x0e) {
|
|
my $file_storage_type = $bytes[0x2b + ($i* 0x27)];
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
$file_storage_type &= 0xf0;
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
$file_storage_type |= length($new_filename);
|
|
$bytes[0x2b + ($i* 0x27)] = $file_storage_type;
|
|
#printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
my $filename_start = 0x2b + ($i * 0x27) + 0x01;
|
|
#print"filename_start=$filename_start\n";
|
|
#print "filename='";
|
|
my $j = 0;
|
|
for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
#printf("%c", $bytes[$i]);
|
|
if ($j < length($new_filename)) {
|
|
$bytes[$i] = ord(substr($new_filename, $j++, 1));
|
|
} else {
|
|
$bytes[$i] = 0x00;
|
|
}
|
|
}
|
|
#print "'\n";
|
|
#print "filename='";
|
|
#for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
# printf("%c", $bytes[$i]);
|
|
#}
|
|
#print "'\n";
|
|
} else {
|
|
printf("Invalid storage type \$%02x\n", $storage_type);
|
|
return 0;
|
|
}
|
|
|
|
$buf = pack "C*", @bytes;
|
|
|
|
dump_blk($buf) if $debug;
|
|
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Reserve a list of used blocks.
|
|
#
|
|
sub reserve_blocks {
|
|
my ($pofile, $used_blocks, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
# Get the volume bit map (blocks used/free).
|
|
my (@bitmaps) = get_vol_bit_map($pofile, $debug);
|
|
|
|
# Mark blocks in list as used in the bit map.
|
|
foreach my $cur_blk (@{$used_blocks}) {
|
|
#printf("cur_blk=%d byte=%d bit=%d\n", $cur_blk, $cur_blk / 8, $cur_blk % 8);
|
|
#$bitmaps[$cur_blk / 8] &= ~(1 << ($cur_blk % 8));
|
|
$bitmaps[$cur_blk / 8] &= ~(0x80 >> ($cur_blk % 8));
|
|
last if $cur_blk == 0;
|
|
}
|
|
|
|
# Now write the volume bit map back out.
|
|
return write_vol_bit_map($pofile, \@bitmaps, $debug);
|
|
}
|
|
|
|
#
|
|
# Free a list of blocks.
|
|
#
|
|
sub release_blocks {
|
|
my ($pofile, $free_blocks, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
# Get the volume bit map (blocks used/free).
|
|
my (@bitmaps) = get_vol_bit_map($pofile, $debug);
|
|
|
|
#foreach my $byte (@blocks) {
|
|
# printf("byte=\$%02x\n", $byte);
|
|
#}
|
|
|
|
# Free blocks in the bit map.
|
|
foreach my $cur_blk (@{$free_blocks}) {
|
|
#printf("cur_blk=%d byte=%d bit=%d\n", $cur_blk, $cur_blk / 8, $cur_blk % 8);
|
|
#$bitmaps[$cur_blk / 8] |= (1 << ($cur_blk % 8));
|
|
$bitmaps[$cur_blk / 8] |= (0x80 >> ($cur_blk % 8));
|
|
last if $cur_blk == 0;
|
|
}
|
|
|
|
#foreach my $byte (@blocks) {
|
|
# printf("byte=\$%02x\n", $byte);
|
|
#}
|
|
|
|
# Now write the volume bit map back out.
|
|
return write_vol_bit_map($pofile, \@bitmaps, $debug);
|
|
}
|
|
|
|
#
|
|
# Delete a file
|
|
#
|
|
sub delete_file {
|
|
my ($pofile, $filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename\n" if $debug;
|
|
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, 1, $debug);
|
|
|
|
#print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
|
|
|
|
return 0 if $storage_type == 0;
|
|
|
|
my $buf;
|
|
|
|
my $rv = 1;
|
|
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
my $storage_type = $bytes[4] >> 4;
|
|
#printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
if ($storage_type == 0x0f || $storage_type == 0x0e) {
|
|
my $file_storage_type = $bytes[0x2b + ($i * 0x27)];
|
|
printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
$file_storage_type &= 0xf0;
|
|
printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
# Set file storage type to 0x00, which means deleted.
|
|
$bytes[0x2b + ($i * 0x27)] = 0x00;
|
|
printf("file_storage_type=\$%02x\n", $file_storage_type);
|
|
|
|
# Fix file directory count.
|
|
##FIXME
|
|
|
|
# Now free all the blocks
|
|
if ($file_storage_type == 0x10) {
|
|
# Seedling file.
|
|
$rv = release_blocks($pofile, [ $key_pointer ], $debug );
|
|
} elsif ($file_storage_type == 0x20) {
|
|
# Sapling file.
|
|
my @blks = get_ind_blk($pofile, $key_pointer, $debug);
|
|
|
|
$rv = release_blocks($pofile, \@blks, $debug);
|
|
} elsif ($file_storage_type == 0x30) {
|
|
# Tree file.
|
|
##TESTME
|
|
my $buf2;
|
|
|
|
my @blks = get_master_ind_blk($pofile, $key_pointer, $debug);
|
|
|
|
my @blocks = ();
|
|
#foreach my $blk (@blks) {
|
|
# print "blk=$blk\n";
|
|
# last if $blk == 0;
|
|
#}
|
|
my $blkno = 1;
|
|
foreach my $blk (@blks) {
|
|
#print "blkno=$blkno blk=$blk\n";
|
|
last if $blk == 0;
|
|
my @subblks = get_sub_ind_blk($pofile, $blk, $debug);
|
|
#print "Pushing $blk\n";
|
|
push @blocks, $blk;
|
|
|
|
#foreach my $sblk (@subblks) {
|
|
# print "sblk=$sblk\n";
|
|
# last if $sblk == 0;
|
|
#}
|
|
|
|
foreach my $subblk (@subblks) {
|
|
last if $subblk == 0;
|
|
#print "Pushing $subblk\n";
|
|
push @blocks, $subblk;
|
|
last if $blkno++ == $blocks_used - 1;
|
|
}
|
|
}
|
|
$rv = release_blocks($pofile, \@blocks, $debug);
|
|
} elsif ($file_storage_type == 0xd0 || $file_storage_type == 0xe0) {
|
|
# Subdirectory.
|
|
# Subdirectory Header.
|
|
my @subdirblks = ();
|
|
push @subdirblks, $key_pointer;
|
|
my $subdirblk = $key_pointer;
|
|
my $done = 0;
|
|
while (!$done) {
|
|
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, $subdirblk, 1, $debug);
|
|
if ($nxt_vol_dir_blk == 0x0000) {
|
|
$done = 1;
|
|
} else {
|
|
push @subdirblks, $nxt_vol_dir_blk;
|
|
$subdirblk = $nxt_vol_dir_blk;
|
|
}
|
|
}
|
|
$rv = release_blocks($pofile, \@subdirblks, $debug);
|
|
} elsif ($file_storage_type == 0xf0) {
|
|
# Volume directory Header. This should never happen.
|
|
printf("Can't delete volume directory header \$%02x\n", $header_pointer);
|
|
|
|
return 0;
|
|
} else {
|
|
# Don't know what the file type is. This should never happen.
|
|
printf("Unknown storage type \$%02x\n", $file_storage_type);
|
|
|
|
return 0;
|
|
}
|
|
} else {
|
|
printf("Invalid storage type \$%02x\n", $storage_type);
|
|
return 0;
|
|
}
|
|
|
|
$buf = pack "C*", @bytes;
|
|
|
|
dump_blk($buf) if $debug;
|
|
|
|
# Write the file descriptive entry back back out.
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
print "File deleted\n";
|
|
|
|
return $rv;
|
|
}
|
|
|
|
#
|
|
# Copy a file
|
|
#
|
|
sub copy_file {
|
|
my ($pofile, $filename, $copy_filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename copy_filename=$copy_filename\n" if $debug;
|
|
|
|
# Check to see if source file exists.
|
|
##FIXME
|
|
# Check to see if dest file exists.
|
|
##FIXME
|
|
# Determine storage type.
|
|
##FIXME
|
|
# Check to see if there is enough space on volume.
|
|
##FIXME
|
|
# Read source blocks.
|
|
##FIXME
|
|
# Write dest blocks.
|
|
##FIXME
|
|
# Reserve blocks for dest file.
|
|
##FIXME
|
|
}
|
|
|
|
#
|
|
# Lock a file
|
|
#
|
|
sub lock_file {
|
|
my ($pofile, $filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename\n" if $debug;
|
|
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, 1, $debug);
|
|
|
|
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
|
|
|
|
return 0 if $storage_type == 0;
|
|
|
|
my $buf;
|
|
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
#dump_blk($buf);
|
|
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
my $storage_type = $bytes[4] >> 4;
|
|
printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
if ($storage_type == 0x0f || $storage_type == 0x0e) {
|
|
my $access = $bytes[0x2b + ($i * 0x27) + 0x1e];
|
|
#printf("access=\$%02x\n", $access);
|
|
$access &= 0x21;
|
|
#printf("access=\$%02x\n", $access);
|
|
$bytes[0x2b + ($i * 0x27) + 0x1e] = $access;
|
|
} else {
|
|
printf("Invalid storage type \$%02x\n", $storage_type);
|
|
return 0;
|
|
}
|
|
|
|
$buf = pack "C*", @bytes;
|
|
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Unlock a file
|
|
#
|
|
sub unlock_file {
|
|
my ($pofile, $filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename\n" if $debug;
|
|
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, 1, $debug);
|
|
|
|
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
|
|
|
|
return 0 if $storage_type == 0;
|
|
|
|
my $buf;
|
|
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
#dump_blk($buf);
|
|
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
my $storage_type = $bytes[4] >> 4;
|
|
printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
if ($storage_type == 0x0f || $storage_type == 0x0e) {
|
|
my $access = $bytes[0x2b + ($i * 0x27) + 0x1e];
|
|
#printf("access=\$%02x\n", $access);
|
|
$access |= 0x80;
|
|
$access |= 0x40;
|
|
$access |= 0x02;
|
|
$access |= 0x01;
|
|
#printf("access=\$%02x\n", $access);
|
|
$bytes[0x2b + ($i * 0x27) + 0x1e] = $access;
|
|
} else {
|
|
printf("Invalid storage type \$%02x\n", $storage_type);
|
|
return 0;
|
|
}
|
|
|
|
$buf = pack "C*", @bytes;
|
|
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
#
|
|
# Create a subdirectory.
|
|
#
|
|
sub create_subdir {
|
|
my ($pofile, $subdirname, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile subdirname=$subdirname\n" if $debug;
|
|
|
|
my $subdir = '';
|
|
my $subdir_fname = $subdirname;
|
|
if ($subdirname =~ /^[\/]*([^\/]+)\/(\S+)$/) {
|
|
$subdir = $1;
|
|
$subdir_fname = $2;
|
|
}
|
|
print "subdir=$subdir subdir_fname=$subdir_fname\n";
|
|
|
|
# Find an empty file descriptive entry in the proper subdirectory.
|
|
my ($header_pointer, $i) = find_empty_fdescent($pofile, $subdir, $debug);
|
|
printf("header_pointer=\$%04x i=%d\n", $header_pointer, $i);
|
|
# May need to add a subdirectory block if the directory is full.
|
|
##FIXME
|
|
if ($header_pointer == 0) {
|
|
print "No directory slots available.\n";
|
|
return 0
|
|
}
|
|
##FIXME
|
|
|
|
my $rv = 1;
|
|
|
|
my $buf;
|
|
|
|
# Read in the directory.
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
|
|
# Get current date.
|
|
my ($ymd, $hm) = current_date();
|
|
|
|
# Unpack the directory block.
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
# Fill in the file type in the file descriptive entry
|
|
my $file_storage_type = 0xd0;
|
|
$file_storage_type |= length($subdirname);
|
|
my $file_type = 0x0f;
|
|
##FIXME
|
|
|
|
# Get list of free blocks.
|
|
my @free_blocks = get_free_blocks($pofile, $debug);
|
|
|
|
# Get block from free block list for this directory.
|
|
my $subdirblknum = pop @free_blocks;
|
|
my $subdir_key_pointer = $subdirblknum;
|
|
|
|
# Fill in STORAGE_TYPE/NAME_LENGTH
|
|
$bytes[0x2b + ($i * 0x27)] = $file_storage_type;
|
|
# Fill in FILE_NAME
|
|
my $filename_start = 0x2b + ($i * 0x27) + 0x01;
|
|
#print"filename_start=$filename_start\n";
|
|
#print "filename='";
|
|
my $j = 0;
|
|
for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
#printf("%c", $bytes[$i]);
|
|
if ($j < length($subdirname)) {
|
|
$bytes[$i] = ord(substr($subdirname, $j++, 1));
|
|
} else {
|
|
$bytes[$i] = 0x00;
|
|
}
|
|
}
|
|
#print "'\n";
|
|
#print "filename='";
|
|
#for (my $i = $filename_start; $i < ($filename_start + 15); $i++) {
|
|
# printf("%c", $bytes[$i]);
|
|
#}
|
|
#print "'\n";
|
|
|
|
# FILL IN FILE_TYPE
|
|
$bytes[0x2b + ($i * 0x27) + 0x10] = 0x0f;
|
|
|
|
# FILL IN KEY_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x11] = $subdir_key_pointer & 0x00ff; # LO byte
|
|
$bytes[0x2b + ($i * 0x27) + 0x12] = ($subdir_key_pointer >> 8) & 0x00ff; # HI byte
|
|
|
|
# FILL IN BLOCKS_USED
|
|
$bytes[0x2b + ($i * 0x27) + 0x13] = 0x01; # Default to 1.
|
|
$bytes[0x2b + ($i * 0x27) + 0x14] = 0x00; # Default to 1.
|
|
|
|
# FILL IN EOF
|
|
$bytes[0x2b + ($i * 0x27) + 0x15] = 0x00;
|
|
$bytes[0x2b + ($i * 0x27) + 0x16] = 0x00;
|
|
$bytes[0x2b + ($i * 0x27) + 0x17] = 0x00;
|
|
|
|
# FILL IN CREATION
|
|
$bytes[0x2b + ($i * 0x27) + 0x18] = $ymd & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x19] = ($ymd >> 8) & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x1a] = $hm & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x1b] = ($hm >> 8) & 0x00ff;
|
|
|
|
# FILL IN VERSION
|
|
$bytes[0x2b + ($i * 0x27) + 0x1c] = 0x00; # Default to ProDOS 1.0
|
|
|
|
# FILL IN MIN_VERSION
|
|
$bytes[0x2b + ($i * 0x27) + 0x1d] = 0x00; # Default to ProDOS 1.0
|
|
|
|
# FILL IN ACCESS
|
|
$bytes[0x2b + ($i * 0x27) + 0x1e] = 0xc3; # Default to unlocked (set to 0x01 when file count > 0)
|
|
|
|
# FILL IN AUX_TYPE
|
|
$bytes[0x2b + ($i * 0x27) + 0x1f] = 0x00;
|
|
$bytes[0x2b + ($i * 0x27) + 0x20] = 0x00;
|
|
|
|
# FILL IN LAST_MOD
|
|
$bytes[0x2b + ($i * 0x27) + 0x21] = $ymd & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x22] = ($ymd >> 8) & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x23] = $hm & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x24] = ($hm >> 8) & 0x00ff;
|
|
|
|
# FILL IN HEADER_POINTER
|
|
$bytes[0x2b + ($i * 0x27) + 0x25] = $header_pointer & 0x00ff;
|
|
$bytes[0x2b + ($i * 0x27) + 0x26] = ($header_pointer >> 8) & 0x00ff;
|
|
|
|
# Create the subdirectory block.
|
|
my @subdirbytes = ();
|
|
|
|
# Fill in the subdirectory block.
|
|
##FIXME
|
|
|
|
# Initialize the bytes for the block
|
|
for (my $i = 0; $i < 512; $i++) {
|
|
$subdirbytes[$i] = 0x00;
|
|
}
|
|
|
|
$subdirbytes[0x00] = 0x00; # Prev directory block default to 0x00
|
|
$subdirbytes[0x01] = 0x00;
|
|
$subdirbytes[0x02] = 0x00; # Next directory block default to 0x00
|
|
$subdirbytes[0x03] = 0x00;
|
|
# Fill in STORAGE_TYPE/NAME_LENGTH
|
|
$subdirbytes[0x04] = 0x0e | length($subdirname);
|
|
# Fill in SUBDIR_NAME
|
|
$j = 0;
|
|
for (my $i = 0x05; $i <= 0x13; $i++) {
|
|
if ($j < length($subdirname)) {
|
|
$subdirbytes[$i] = ord(substr($subdirname, $j++, 1));
|
|
} else {
|
|
$subdirbytes[$i] = 0x00;
|
|
}
|
|
}
|
|
|
|
$subdirbytes[0x14] = 0x75; # Must contain this
|
|
|
|
$subdirbytes[0x15] = 0x00; # Reserved
|
|
$subdirbytes[0x15] = 0x00; # Reserved
|
|
$subdirbytes[0x17] = 0x00; # Reserved
|
|
$subdirbytes[0x18] = 0x00; # Reserved
|
|
$subdirbytes[0x19] = 0x00; # Reserved
|
|
$subdirbytes[0x1a] = 0x00; # Reserved
|
|
$subdirbytes[0x1b] = 0x00; # Reserved
|
|
|
|
# FILL IN CREATION
|
|
$subdirbytes[0x1c] = $ymd & 0x00ff;
|
|
$subdirbytes[0x1d] = ($ymd >> 8) & 0x00ff;
|
|
$subdirbytes[0x1e] = $hm & 0x00ff;
|
|
$subdirbytes[0x1f] = ($hm >> 8) & 0x00ff;
|
|
|
|
# FILL IN VERSION
|
|
$subdirbytes[0x20] = 0x00; # Default to ProDOS 1.0
|
|
|
|
# FILL IN MIN_VERSION
|
|
$subdirbytes[0x21] = 0x00; # Default to ProDOS 1.0
|
|
|
|
# FILL IN ACCCESS
|
|
$subdirbytes[0x22] = 0xc4; # Default to unlocked
|
|
|
|
# FILL IN ENTRY_LENGTH
|
|
$subdirbytes[0x23] = 0x27; # Default
|
|
|
|
# FILL IN ENTRIES_PER_BLOCK
|
|
$subdirbytes[0x24] = 0x0d; # Default
|
|
|
|
# FILL IN FILE_COUNT
|
|
$subdirbytes[0x25] = 0x00; # Default to empty
|
|
$subdirbytes[0x26] = 0x00; # Default to empty
|
|
|
|
# FILL IN PARENT_POINTER
|
|
$subdirbytes[0x27] = $header_pointer & 0x00ff;
|
|
$subdirbytes[0x28] = ($header_pointer >> 8) & 0x00ff;
|
|
|
|
# FILL IN PARENT_ENTRY
|
|
$subdirbytes[0x29] = $i;
|
|
|
|
# FILL IN PARENT_ENTRY_LENGTH
|
|
$subdirbytes[0x2a] = 0x27;
|
|
|
|
if ($debug) {
|
|
print "subdirbytes=\n";
|
|
for (my $i = 0; $i < 512; $i++) {
|
|
print "\n" if !($i % 16);
|
|
printf("%02x ", $subdirbytes[$i]);
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
my $subdirbuf = pack "C*", @subdirbytes;
|
|
|
|
# Write the new directory block out.
|
|
if (!write_blk($pofile, $subdirblknum, \$subdirbuf)) {
|
|
print "I/O Error writing block $subdirblknum\n";
|
|
return 0;
|
|
}
|
|
|
|
# Mark the subdir block as used.
|
|
my @used_blocks = ();
|
|
push @used_blocks, $subdirblknum;
|
|
$rv = reserve_blocks($pofile, \@used_blocks, $debug);
|
|
|
|
# Write file descriptive entry back out.
|
|
##FIXME
|
|
$buf = pack "C*", @bytes;
|
|
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
|
|
return $rv;
|
|
}
|
|
|
|
#
|
|
# Undelete a file
|
|
#
|
|
sub undelete_file {
|
|
my ($pofile, $filename, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile filename=$filename\n" if $debug;
|
|
|
|
my $rv = 1;
|
|
|
|
# Find erased directory entry.
|
|
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, 3, $debug);
|
|
|
|
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
|
|
|
|
my @used_blocks = ();
|
|
# Re-set the STORAGE_TYPE/NAME_LENGTH byte.
|
|
if ($file_type eq 'DIR') {
|
|
# Directory
|
|
$storage_type = 0x0d;
|
|
|
|
# Read directory blocks, add them to reserve list.
|
|
my $buf2;
|
|
my $blk = $key_pointer;
|
|
my $done = 0;
|
|
while (!$done) {
|
|
push @used_blocks, $blk;
|
|
clear_buf(\$buf2);
|
|
if (read_blk($pofile, $blk, \$buf2)) {
|
|
my @subdirbytes = unpack "C*", $buf2;
|
|
if ($subdirbytes[2] == 0x00 && $subdirbytes[3] == 0x00) {
|
|
$done = 1;
|
|
} else {
|
|
$blk = ($subdirbytes[2] | ($subdirbytes[3] >> 8));
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $blk\n";
|
|
return 0;
|
|
}
|
|
}
|
|
# Guess on whether it is a seedling, sapling or tree based on EOF.
|
|
} elsif ($eof <= 512) {
|
|
# Seedling;
|
|
$storage_type = 0x10;
|
|
push @used_blocks, $key_pointer;
|
|
} elsif ($eof <= (256 * 512)) {
|
|
# Saplingg;
|
|
$storage_type = 0x20;
|
|
|
|
push @used_blocks, $key_pointer;
|
|
# Read index block, add blocks to reserve list.
|
|
my @blks = get_ind_blk($pofile, $key_pointer, $debug);
|
|
foreach my $blk (@blks) {
|
|
push @used_blocks, $blk;
|
|
}
|
|
} else {
|
|
# Tree
|
|
$storage_type = 0x30;
|
|
|
|
push @used_blocks, $key_pointer;
|
|
# Read master index block and index blocks, add blocks to reserve list.
|
|
my @blks = get_master_ind_blk($pofile, $key_pointer, $debug);
|
|
|
|
my $blkno = 1;
|
|
foreach my $blk (@blks) {
|
|
push @used_blocks, $blk;
|
|
|
|
my @subblks = get_sub_ind_blk($pofile, $blk, $debug);
|
|
|
|
foreach my $subblk (@subblks) {
|
|
push @used_blocks, $subblk;
|
|
}
|
|
|
|
last if $blkno++ == $blocks_used - 1;
|
|
}
|
|
}
|
|
$storage_type |= length($filename);
|
|
|
|
printf("storage_type=\$%02x\n", $storage_type);
|
|
|
|
# Re-write file descriptive entry.
|
|
my $buf;
|
|
if (read_blk($pofile, $header_pointer, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
|
|
my @bytes = unpack "C*", $buf;
|
|
|
|
# Set file storage type to hopefully original value.
|
|
$bytes[0x2b + ($i * 0x27)] = $storage_type;
|
|
|
|
$buf = pack "C*", @bytes;
|
|
|
|
if (!write_blk($pofile, $header_pointer, \$buf)) {
|
|
print "I/O Error writing block $header_pointer\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading block $header_pointer\n";
|
|
}
|
|
|
|
# Re-mark all the blocks for the file as used.
|
|
$rv = reserve_blocks($pofile, \@used_blocks, $debug);
|
|
|
|
# Re-set file count for directory
|
|
##FIXME
|
|
|
|
return $rv;
|
|
}
|
|
|
|
#
|
|
# Format a volume
|
|
#
|
|
sub format_volume {
|
|
my ($pofile, $total_blocks, $volume_name, $dbg) = @_;
|
|
|
|
$debug = 1 if defined $dbg && $dbg;
|
|
|
|
print "pofile=$pofile total_blocks=$total_blocks volume_name=$volume_name\n" if $debug;
|
|
|
|
my $rv = 1;
|
|
|
|
# Create the blank file.
|
|
my $ofh;
|
|
if (open($ofh, ">$pofile")) {
|
|
close $ofh;
|
|
} else {
|
|
print "Can't write $pofile\n";
|
|
}
|
|
|
|
# Initialize a block.
|
|
my @bytes = ();
|
|
for (my $i = 0; $i < 512; $i++) {
|
|
push @bytes, 0x00;
|
|
}
|
|
my $buf = pack "C*", @bytes;
|
|
|
|
# Write out blank blocks for volume.
|
|
for (my $i = 0; $i < $total_blocks; $i++) {
|
|
if (!write_blk($pofile, $i, \$buf)) {
|
|
print "I/O Error writing block $i\n";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Write boot block (block 0), write in a boiler plate copy taken from a disk image.
|
|
if (read_blk("TEMPLATE.po", 0, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
if (!write_blk($pofile, 0, \$buf)) {
|
|
print "I/O Error writing block 0\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading template block 0\n";
|
|
return 0;
|
|
}
|
|
|
|
# Write Block 1 (SOS boot block), write in a boiler plate copy taken from a disk image.
|
|
if (read_blk("TEMPLATE.po", 1, \$buf)) {
|
|
dump_blk($buf) if $debug;
|
|
if (!write_blk($pofile, 1, \$buf)) {
|
|
print "I/O Error writing block 1\n";
|
|
return 0;
|
|
}
|
|
} else {
|
|
print "I/O Error reading template block 1\n";
|
|
return 0;
|
|
}
|
|
|
|
# Get current date.
|
|
my ($creation_ymd, $creation_hm) = current_date();
|
|
|
|
# Empty directory entries.
|
|
my $dir_ents = '';
|
|
|
|
# Write Key Volume Dir Block (block 2).
|
|
write_key_vol_dir_blk($pofile, 0x00, 0x03, 0xf0 | length($volume_name), $volume_name, $creation_ymd, $creation_hm, 0x00, 0x00, 0xc3, 0x27, 0x0d, 0, 0x06, $total_blocks, $dir_ents);
|
|
|
|
# Write the rest of the Volume Directory blocks.
|
|
my $prv_vol_dir_blk = $key_vol_dir_blk;
|
|
my $nxt_vol_dir_blk;
|
|
for (my $i = $key_vol_dir_blk + 1; $i < 0x06; $i++) {
|
|
if ($i == 0x05) {
|
|
$nxt_vol_dir_blk = 0x00;
|
|
} else {
|
|
$nxt_vol_dir_blk = $i + 1;
|
|
}
|
|
write_vol_dir_blk($pofile, $i, $prv_vol_dir_blk, $nxt_vol_dir_blk, $dir_ents);
|
|
$prv_vol_dir_blk++;
|
|
}
|
|
|
|
# Write Volume Bit Map blocks.
|
|
my @bitmaps = ();
|
|
$bitmaps[0] = 0x01; ##FIXME -- this assumes a 5.25 floppy.
|
|
for (my $i = 1; $i < $total_blocks / 8; $i++) {
|
|
$bitmaps[$i] = 0xff;
|
|
}
|
|
write_vol_bit_map($pofile, \@bitmaps, $debug);
|
|
|
|
return $rv;
|
|
}
|
|
|
|
1;
|
|
|