1 files changed, 240 insertions, 0 deletions
diff --git a/testing/alfls b/testing/alfls
new file mode 100755
index 0000000..4b3d867
--- /dev/null
+++ b/testing/alfls
@@ -0,0 +1,240 @@
+#!/usr/bin/perl -w
+
+# Note: when/if I ever manage to reimplement the ALF decompressor in
+# C, this script will serve as the prototype for the unalf tool, which
+# will of course be in C also...
+
+use bytes;
+
+sub chrat {
+	my $offs = shift;
+	return substr($data, $offs, 1);
+}
+
+sub wordat {
+	my $offs = shift;
+	return ord(chrat($offs)) | (ord(chrat($offs + 1)) << 8);
+}
+
+sub longat {
+	my $offs = shift;
+	return wordat($offs) | (wordat($offs + 2) << 16);
+}
+
+sub header_ok {
+	my $pos = shift || 0;
+
+	return 0 unless chrat($pos) eq chr(0x1a);
+
+	my $c = ord(chrat($pos + 1 ));
+
+	if($c >= 2 && $c <= 9) {
+		warn "$SELF: this is an ARC archive (not ALF).\n" unless $arc_warn;
+		$arc_warn++;
+		return 1;
+	} elsif($c == 0x0f) {
+		return 1;
+	}
+
+	return 0;
+}
+
+@monthnames = qw/??? Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ??? ??? ???/;
+
+# see Arcinfo...
+sub extract_date {
+	my $pos = shift;
+	my $date = wordat($pos);
+
+	my $year = ($date >> 9) + 1980;
+	$year %= 100; # only ever print last 2 digits
+
+	my $month = ($date >> 5) & 0x0f;
+	$month = $monthnames[$month];
+
+	my $day = $date & 0x1f;
+
+	my $res = sprintf("%2d %3s %2d", $day, $month, $year);
+	return $res;
+}
+
+sub extract_time {
+	my $pos = shift;
+	my $time = wordat($pos);
+
+	my $hour = $time >> 11;
+	my $min = ($time >> 5) & 0x3f;
+	# don't bother with sec, we don't display them.
+
+	# special case: "arc v" displays 00:00 as 12:00p.
+	if($hour == 0 && $min == 0) {
+		$hour = 24;
+	}
+
+	my $ampm = ($hour > 11 ? 'p' : 'a');
+	$hour %= 12;
+	$hour = 12 if $hour == 0;
+
+	my $res = sprintf("%2d:%02d%s", $hour, $min, $ampm);
+	return $res;
+}
+
+sub list_file {
+	# each file header is 29 bytes.
+
+	# bytes 0-1 are 0x1a (ARCMARK) and 0x0f (ALF compression type)
+
+	# bytes 2-14 are filename, though the Atari max filename len
+	#   is 12 (e.g. FOOBARXX.EXT).
+
+	# bytes 15-18 are 4-byte compressed length (LSB first).
+	#   bytes 17-18 should always be 0, I don't think alfcrunch
+	#   can handle a file >64K. even if it can, byte 18 should still
+	#   always be 0, because *surely* it can't handle a file that's
+	#   >16M. for that matter, most Atari DOSes can't handle a hard
+	#   drive partition >16M...
+
+	# bytes 19-22 are date/time stamp, hopefully the same as ARC.
+
+	# bytes 23-24 are the checksum CRC-16 (?) checksum.
+
+	# bytes 25-28 are the 4-byte uncompressed length (LSB first).
+	#   bytes 27-28 should always be 0 (as above).
+
+	# the 29-byte header is followed by the compressed data, whose length
+	# matches the compressed length in bytes 15-18.
+
+	# a lot of the files in the the Holmes archive have filler bytes at
+	# the end, put there by ancient dumb file transfer protocols, or
+	# dumb DOSes (doesn't CP/M do this?).
+
+	if(!header_ok($pos)) {
+		warn "$SELF: Junk at EOF (probably harmless).\n";
+		$pos += (1 << 31); # ludicrous size, makes main loop exit.
+		return;
+	}
+
+	# read the filename until we hit a null byte, or a space, or
+	# the max length. all the .alf files I have, do have a null byte
+	# terminator for the filename... followed by spaces to fill up the
+	# rest of the 13-byte field.
+	my $filename = "";
+	for(my $i = 2; $i < 15; $i++) {
+		my $b = chrat($pos + $i);
+		last if ord($b) == 0 || $b eq ' ';
+		$filename .= $b;
+	}
+
+	my $clen = longat($pos + 15);
+	my $ulen = longat($pos + 25);
+	my $crc = wordat($pos + 23);
+	my $date = extract_date($pos + 19);
+	my $time = extract_time($pos + 21);
+	my $pct = 100 - int($clen / $ulen * 100);
+
+	printf("%-12s  ", $filename);
+	printf("%8d  ", $ulen);
+	if(chrat($pos + 1) eq chr(0x0f)) {
+		print("     ALF  ");
+	} else {
+		print("     ARC  ");
+	}
+	printf("%3d%%  ", $pct);
+	printf("%8d  ", $clen);
+	printf("%9s  ", $date);
+	printf("%6s  ", $time);
+	printf("%04x\n", $crc);
+
+	if($ENV{DUMP}) {
+		my $bits;
+		for(my $i = 0; $i < $clen; $i++) {
+			$bits .= sprintf("%08b", ord(chrat($pos + 29 + $i)));
+		}
+		my $count = 0;
+		while($bits =~ s/^([01]{9})//) {
+			my $ctlbit = substr($1, 0, 1);
+			my $byte = substr($1, 1);
+			my $val = eval "0b$byte";
+			my $hex = sprintf('$%02x', $val);
+			printf("%3d: ", $count++);
+			print "$ctlbit $byte ; ";
+			if($ctlbit eq '0') {
+				print "literal $hex";
+				if($val > 32 && $val < 127) {
+					print " " . chr($val);
+				}
+			} else {
+				my $name = "(?)";
+				if($val == 0) {
+					$name = "start";
+				} elsif($val == 1) {
+					$name = "end";
+				}
+				print "$val $name";
+			}
+			print "\n";
+		}
+		print "junk: $bits\n" if length($bits);
+	}
+
+	$total_clen += $clen;
+	$total_ulen += $ulen;
+	$file_count++;
+
+	$pos += ($clen + 29);
+}
+
+# main()
+
+$total_clen = $total_ulen = $file_count = 0;
+
+($SELF = $0) =~ s,.*/,,;
+
+if(@ARGV != 1) {
+	die "$SELF requires exactly one ALF file as an argument.\n";
+} elsif($ARGV[0] =~ /--?h(elp)?/) {
+	print <<EOF;
+$SELF - list contents of an ALF (or ARC) archive file.
+
+Usage: $SELF <archive>
+
+For each file in the ALF or ARC archive, displays the filename,
+compressed and uncompressed sizes, compression amount, date/time,
+and CRC. After all files are listed, the total sizes and compression
+are shown.
+
+The output is intended to look like that of "arc v", except the
+Stowage column only ever says "ALF" or "ARC" (doesn't show e.g.
+"Squashed", "Crunched", etc for ARC files).
+
+Exit status is 0 on success, non-zero on failure.
+EOF
+	exit 0;
+}
+
+undef $/;
+
+$data = <>;
+
+#warn "read " . length($data) . " bytes\n";
+die("$SELF: Not an alfcrunch file.\n") unless header_ok();
+
+print <<EOF;
+Name          Length    Stowage    SF   Size now  Date       Time    CRC
+============  ========  ========  ====  ========  =========  ======  ====
+EOF
+
+$pos = 0;
+while($pos < length($data)) {
+	list_file();
+}
+
+print "        ====  ========            ====  ========\nTotal   ";
+printf("%4d  ", $file_count);
+printf("%8d", $total_ulen);
+print ' ' x 12;
+printf("%3d%%  ", 99);
+printf("%8d\n", $total_clen);
+
+
+exit 0;