#!/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 "" 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 "" 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;