#!/usr/bin/perl -w
# unpack a .ar file from MM2
#
# File format:
# *** numbers are stored in little-endian format
# offset     size (bytes) function
# 0x00000000 4            Magic: "DAVE"
# 0x00000004 4            number of files stored in this archive
# 0x00000008 4            offset to filenames OR size of file header block
# 0x00000012 4            offset to data OR size of filename block
# * lots of zeros here
# 0x00000800 16           file header. there's [offset 4] of these
# * [offset 8] bytes of data
#            variable     zero-terminated filename
# * [offset 12] bytes of data
#            variable     possibly deflated file
#
# File header:
# 0x00000000 4            offset from start of filename block to filename
# 0x00000004 4            offset from start of file to data block
# 0x00000008 4            uncompressed size of file
# 0x00000012 4            compressed size of file
#
# if compressed size != uncompressed size, the file data is compressed
# using zlib, maximum compression, WindowBits => -MAX_WBITS (disables
# production of header bytes)
#
use Fcntl qw( SEEK_CUR SEEK_SET );
use Getopt::Long;
use File::Path;
use File::Basename;
use Compress::Zlib;
#use strict;

sub systell( * ) {
    sysseek( $_[0], 0, SEEK_CUR );
}

sub usage {
    print STDERR "usage: unar [-v] [-l] arfile[.ar]\n";
    exit( 1 );
}

my $list = 0;
my $verbose = 0;

GetOptions( "l" => \$list,
            "v" => \$verbose );

# this could become more complex, but for now if only -v is specified,
# take it to mean -v -l
if ( $verbose and !$list ) {
    $list = 1;
}

my $file = shift or die "No file specified\n";
my @filters = @ARGV;

if ( !@filters ) {
    push @filters, "*";
}

if ( ! -r $file ) {
    if ( -r $file . ".ar" ) {
        $file .= ".ar";
    } elsif ( -r $file . ".AR" ) {
        $file .= ".AR";
    } else {
        die "unar: cannot find or open $file, $file.ar, or $file.AR.\n";
    }
}

open( FILE, $file ) or die "unar: $! while opening $file";

# File signature: DAVE
my ( $nr, $buf );
my $unzip = 0;
$nr = sysread( FILE, $buf, 4 );
if ( $buf ne "DAVE" ) {
  if ( $buf eq "PK\x3"."\x4" ) {
	print STDERR "This is a PKZIP file...\n";
    $unzip = 1;
  } else {
	print STDERR "AR file signature not found\n";
  }
  exit(1) unless $unzip;
}

if ( $unzip ) {
#         local file header signature     4 bytes  (0x04034b50)
#         version needed to extract       2 bytes
#         general purpose bit flag        2 bytes
#         compression method              2 bytes
#         last mod file time              2 bytes
#         last mod file date              2 bytes
#         crc-32                          4 bytes
#         compressed size                 4 bytes
#         uncompressed size               4 bytes
#         file name length                2 bytes
#         extra field length              2 bytes

#         file name (variable size)
#         extra field (variable size)

# 504b 0304 PK0304
# 1400 need version 2.0 to extract
# 0800 flags 0000 0000 0000 1000 -> crc, size fields are zero, need desc.
# 0800 compr 0000 0000 0000 1000 -> deflated
# 480e mtime
# 9237 mdate
# 0000 0000 crc
# 0000 0000 compressed
# 0000 0000 uncompressed
# 1000 file name length
# 1000 extra field length
#  i A  T K  O S  _ v  1 .  0 i  . i  s o
# 6941 544b 4f53 5f76 312e 3069 2e69 736f
#
# 5558 0c00 0624 6747 370b 6747 0000 f501
    $nr = sysread( FILE, $buf, 26 );
    my ( $ver, $flag, $z, $mtime, $mdate, $crc, $comp, $uncomp, $fn, $ef ) =
      (
       unpack( "v", substr( $buf, 0, 2 )),
       unpack( "v", substr( $buf, 2, 2 )),
       unpack( "v", substr( $buf, 4, 2 )),
       unpack( "v", substr( $buf, 6, 2 )),
       unpack( "v", substr( $buf, 8, 2 )),
       unpack( "V", substr( $buf, 10, 4 )),
       unpack( "V", substr( $buf, 14, 4 )),
       unpack( "V", substr( $buf, 18, 4 )),
       unpack( "v", substr( $buf, 22, 2 )),
       unpack( "v", substr( $buf, 24, 2 )),
      );

    $nr = sysread( FILE, $buf, $fn + $ef );
    my $name = substr( $buf, 0, $fn );
    my $extra = substr( $buf, $fn, $ef );

    print "$name $comp $uncomp\n";

    my ( $zi, $status ) = inflateInit( WindowBits => -MAX_WBITS );
    open( UNZ, ">$name" ) or die "$name: $!";
    while ( my $b = sysread( FILE, $buf, 10240 )) {
         if ( $b <= 0 ) {
             print "error: $!";
             last;
         }
         my ( $out, $status ) = $zi->inflate( \$buf );

         if ( !defined( $status )) {
             print "inflate error\n";
             last;
         }
         if ( $status != Z_OK ) {
             print "inflate error #2\n";
             last;
         }

         print "inflated " . $zi->total_in() . " to " . $zi->total_out() . "\n";

         print UNZ $out;
     }
    close( UNZ );
} else {
    # Rest of header
    $nr = sysread( FILE, $buf, 28 );

    # Extract record count
    my $numrecs = unpack( "V", substr( $buf, 0, 4 ));
    # start of filenames - 0x800
    my $offset = unpack( "V", substr( $buf, 4, 4 ));
    # size of filename block (offset to start of data from start of filenames)
    my $length = unpack( "V", substr( $buf, 8, 4 ));

    $nr = sysseek( FILE, 0x800, 0 ); # Data appears to start here regardless.

    if ( $nr != 0x800 ) {
        die "unar: error $! while seeking\n";
    }

    # Read NUMRECS records (16 bytes per)

    # This is fairly non-optimal, since it seeks back and forth between
    # the record section and the name section. However, it still runs
    # pretty quickly, so I'll leave it as-is for now.
    my @records;
    for my $rec ( 0..$numrecs - 1 ) {
        $nr = sysread( FILE, $buf, 16 );
        my %rec;
        $rec{nameptr} = unpack( "V", substr( $buf, 0, 4 )) + 0x17000;
        $rec{dataptr} = unpack( "V", substr( $buf, 4, 4 ));
        $rec{fulsize} = unpack( "V", substr( $buf, 8, 4 ));
        $rec{zipsize} = unpack( "V", substr( $buf, 12, 4 ));

        my $here = systell( FILE );
        sysseek( FILE, $rec{nameptr}, SEEK_SET );
        $nr = sysread( FILE, $buf, 1024 );
        $rec{namestr} = unpack( "Z*", $buf );
        sysseek( FILE, $here, SEEK_SET );

        push @records, \%rec;
    }
}

__END__
print "Archive:  $file\n";
if ( $list ) {
    if ( $verbose ) {
        print "  Length    Size   Ratio Name\n";
        print " -------- -------- ----- ----\n";
    } else {
        print "  Length  Name\n";
        print " -------- ----\n";
    }
}
my ( $totzip, $totful, $found ) = ( 0, 0, 0 );
for my $rec ( 0..$numrecs - 1 ) {
    # check for filters
    my $ok = 0;
    for my $filter ( @filters ) {
        # ugly. there must be an inline glob somewhere I can use.
        my $filterregexp = $filter;
        $filterregexp =~ s/\./\\./g;
        $filterregexp =~ s/\?/./g;
        $filterregexp =~ s/\*/.*/g;
        if ( $records[$rec]->{namestr} =~ /^$filterregexp$/i ) {
            $ok = 1;
            last;
        }
    }
    next unless $ok;
    $found++;

    if ( $list ) {
        if ( $verbose ) {
            printf " %8d %8d %3d%%  %s\n",
              $records[$rec]->{fulsize},
                $records[$rec]->{zipsize},
                  $records[$rec]->{fulsize} ? 
                    100 - ( $records[$rec]->{zipsize}/$records[$rec]->{fulsize} * 100 )
                      : 0,
                        $records[$rec]->{namestr};
        } else {
            printf " %8d %s\n",
              $records[$rec]->{fulsize},
                $records[$rec]->{namestr};
        }
    } else {
        # extracting files
        # directory
        if ( $records[$rec]->{namestr} =~ m@/$@ ) {
            mkpath( $records[$rec]->{namestr}, 0, 0755 );
        } else {
            print "  inflating: " . $records[$rec]->{namestr} . "\n";
            my $path = dirname( $records[$rec]->{namestr} );
            -d $path or mkpath( $path, 0, 0755 );

            sysseek( FILE, $records[$rec]->{dataptr}, SEEK_SET );
            sysread( FILE, $buffer, $records[$rec]->{zipsize});
            open( UNAR, ">" . $records[$rec]->{namestr} ) or die $!;
            binmode( UNAR );
            if ( $records[$rec]->{zipsize} != $records[$rec]->{fulsize}) {
                my $i = inflateInit( WindowBits => -( MAX_WBITS ) );
                my ( $data, $status ) = $i->inflate( $buffer );
                print UNAR $data;
            } else {
                print UNAR $buffer;
            }
            close( UNAR );
        }
    }

    $totzip += $records[$rec]->{zipsize};
    $totful += $records[$rec]->{fulsize};
}

if ( $list ) {
    if ( $verbose ) {
        print " -------- -------- ----- ----\n";
        printf " %8d %8d %3d%%  %d files\n",
          $totful, $totzip, $totful ? 100 - ( $totzip / $totful * 100 ) : 0, $found;
    } else {
        print " -------- ----\n";
        printf " %8d %d files\n", $totful, $found;
    }
}

exit;