#!/usr/bin/env perl
# $Source: /var/lib/cvs/ghutils/unpak.pl,v $
# $Id: unpak.pl,v 1.14 2008-10-25 09:49:37 tarragon Exp $

use strict;
use warnings;

use File::Spec;
use Getopt::Long;
use String::CRC32;
use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError);
use File::Temp qw( tempfile );
use File::Basename;

my $MYNAME = basename($0);
my $VERSION = do { my @r=(q$Revision: 1.14 $=~/\d+/g); sprintf '%d.'.'%d'x$#r,@r };

sub usage {
    my $message = shift;
    if ( $message ) {
        print $message . "\n";
    }

    print <<EOF;

$MYNAME v$VERSION by Tarragon Allen (tma)

This program will extract files from PAK/PAB archives, as used in Guitar Hero 3,
Guitar Hero: Aerosmith, and Guitar Hero: World Tour. It may work with files from
other games developed by Neversoft, but this is untested.

Usage:

    unpak.pl [-b <pab file>] [-d <output directory>] [-c <dbg file>] [-t (ps2|xen)]
             [-i] [-k] [--test] [-v] [-h] <pak file>

    --pab           -b  the pab (pak binary) file for extracting split archives
    --directory     -d  directory to extract files into 
                        (defaults to current directory)
    --crc           -c  checksum file (.dbg), more than one may be provided
    --type          -t  force parsing as a 'ps2' or 'xen' file (will autodetect)
    --inflate       -i  decompress the file(s) using zlib before extraction
    --keeptemp      -k  don't remove temporary files after program exit
    --verbose       -v  print lots of diagnostic info
    --test              do everything except actually write the files
    --help          -h  this help

EOF
exit;
}


# define known file types
my %file_extensions = (
    # entries with a dot
    '0x0a6808d4' => 'wav',
    '0x199f902b' => 'nav',
    '0x2b0a3095' => 'stex',
    '0x2c3b5adc' => 'scn',
    '0x2f1a6a09' => 'shd',
    '0x33180544' => 'rnb_lvl',
    '0x3f57c28a' => 'scv',
    '0x43904241' => 'table',
    '0x49875607' => 'nqb',
    '0x4a2e1fa0' => 'rnb_mdl',
    '0x4bc1e85e' => 'mqb',
    '0x559566cc' => 'dbg',
    '0x5d796624' => 'sqb',
    '0x6290993b' => 'mcol',
    '0x64112e85' => 'skin',
    '0x6613eacd' => 'rag',
    '0x66aeda37' => 'mdv',
    '0x689028a5' => 'pimg',
    '0x72a6d78c' => 'col',
    '0x7330095c' => 'ske',
    '0x745dcd45' => 'ska',
    '0x777db6d3' => 'skiv',
    '0x7e1abc70' => 'fnt',
    '0x7ea7357b' => 'geom',
    '0x88493f06' => 'cel',
    '0x8a20e0f8' => 'hkc',
    '0x8bfa5e8e' => 'tex',
    '0x9014dd5c' => 'fnv',
    '0x91e1028d' => 'rnb',
    '0x9b22ca94' => 'cam',
    '0x9bcc234d' => 'mdl',
    '0x9de9087f' => 'fam',
    '0xa7dea591' => 'pfx',
    '0xa7f505c4' => 'qb',
    '0xb065c9a2' => 'imv',
    '0xb0a32c18' => 'oba',
    '0xcd452536' => 'qs',
    '0xdad5e950' => 'img',
    '0xe20f226c' => 'png',
    '0xea151f1c' => 'tvx',
    '0xfdc939b7' => 'fnc',
    '0xff2d0e91' => 'gap',

    # entries without a dot
    '0xcb7db8cf' => 'dbg',
    '0xf2c9ac8b' => 'pak',
    '0x2bbea5c3' => 'qb',

    # last entry types
    '0x2cb3ef3b' => '.last',
    '0xb524565f' => 'last',
);

# parse command line options
my $pab = ''; # pabfile
my $outdir = '.'; # output directory
my @crcfiles;
my $type = ''; # file type (ps2 or xen)
my $inflate = 0; # zlib decompression
my $keeptemp = 0; # keep temporary files
my $verbose = 0; # verbose
my $test = 0; # test mode
my $help = 0;

GetOptions(
    'pab|b=s'       => \$pab,
    'directory=s'   => \$outdir,
    'crc=s'         => \@crcfiles,
    'type|t=s'      => \$type,
    'inflate'       => \$inflate,
    'keeptemp'      => \$keeptemp,
    'verbose'       => \$verbose,
    'test'          => \$test,
    'help|?'        => \$help,
);

$help and &usage;

my $pak = shift;
if ( ! defined $pak ) {
    &usage('Please provide a pak filename.');
}

if ( $type eq '' ) {
    if ( $pak =~ m/\.ps2/ ) {
        $type = 'ps2';
    }
    elsif ( $pak =~ m/\.xen/ ) {
        $type = 'xen';
    }
    else {
        &usage('Error: Couldn\'t automatically determine file type! Please use the -t option to specify.');
    }
}

if ( $type ne 'xen' && $type ne 'ps2' ) {
    &usage("Unrecognised file type '$type'. Options are 'ps2' or 'xen'.");
}

# check output dir before we go any further
unless ( -d $outdir && -w $outdir) {
    mkdir $outdir || die "Could not create $outdir: $!\n";
}

# read in checksum names
my %checksums;
if ( scalar @crcfiles ) {
    foreach my $file ( @crcfiles ) {
        open DBG, $file or die "Could not open checksum file $file for reading: $!\n";
        binmode DBG;

        my $checksums_found = 0;
        while ( <DBG> ) {
            chop;
            chomp;
            if ( m/^(0x[0-9a-f]{8})\s(.*)/ ) {
                my $id   = $1;
                my $name = $2;
                next if $name =~ '^c:' ;
                $checksums{ hex $id } = $name;
            }
        }
        ! scalar %checksums && &printverb("No checksums found.\n");
        close DBG;
    }
}

# deflate files, if required
my $temppakname;
my $temppabname;
if ( $inflate ) {
    ( undef, $temppakname ) = tempfile( 'pakdeflateXXXXX', DIR => '.' );
    if ( inflation( $pak, $temppakname ) ) {
        $pak = $temppakname;
    }

    if ( $pab ) {
        ( undef, $temppabname ) = tempfile( 'pabdeflateXXXXX', DIR => '.' );
        if ( inflation( $pab, $temppabname ) ) {
            $pab = $temppabname;
        }
    }
}

# process pak header
my $offset = 0;
my @filelist = ();

open FILE, $pak or die "Could not open pak file $pak for reading: $!\n";
binmode FILE;

# check for chunks (magic number = 'CHNK')
my $magic;
read FILE, $magic, 4;
seek FILE,0,0;

my $chnk_filename;
if ( unpack('N', $magic) == 0x43484e4b ) {
    my $pointer = 0;
    ( undef, $chnk_filename ) = tempfile( 'chnkXXXXX', DIR => '.' );
    print "Found CHNK header, decompressing.\n";

    while (1) {
        my $header = tell FILE;

        my $buf;
        my $len = read FILE, $buf, 24;

        my ( 
            $magic, 
            $start, 
            $length, 
            $next, 
            $flags, 
            $size,
        ) = unpack 'N*', $buf;
        
        last unless $magic == 0x43484e4b;

        seek FILE, $header + $start, 0;
        die "short read\n" unless read(FILE, $buf, $length) == $length;
        anyinflate( \$buf, $chnk_filename, Append => 1 ) or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n";
        
        last if $next == 0xffffffff;
        seek FILE, $header + $next, 0;
    }
    close FILE;
    open FILE, $chnk_filename;
}

print "Processing $pak ...\n";
while (1) {
    my $buf;

    $verbose && printf "\nChecking for header at \%08x:\n",$offset;

    my $increment = 0x20;
    my $buflen = read FILE, $buf, 0x20;
    last if $buflen == 0;

    my @dwords;
    if ( $type eq "ps2" ) {
        @dwords = unpack "V*", $buf;
    }
    else {
        @dwords = unpack "N*", $buf;
    }
    my $filetype_crc = shift @dwords;
    my $filetype;
    my $filetype_crc_hex = sprintf '0x%08x',$filetype_crc; 
    if ( defined $file_extensions{ $filetype_crc_hex } ) {
        $filetype = $file_extensions{ $filetype_crc_hex };
    }
    else {
        $filetype = &dbg($filetype_crc);
        if ( ! defined $filetype ) {
            $filetype = sprintf '0x%08x',$filetype_crc;
        }
    }
    my $filestart = shift @dwords;
    $filestart += $offset;
    my $filelen = shift @dwords;
    my $filename_pak_crc = shift @dwords;
    my $filename_pak = &dbg($filename_pak_crc);
    my $filename_dbg_crc = shift @dwords;
    my $filename_dbg = &dbg($filename_dbg_crc);
    my $filename_trun_crc = shift @dwords;
    my $filename_trun = &dbg($filename_trun_crc);
    my $null = shift @dwords;
    my $filename_flags = shift @dwords;
    my $filename = '';

    if ( $filename_flags ) { # HACK - assumes if there are any flags then there is a filename in the pak file. Will probably break.
        $increment = 0xC0;
        my $buflen = read FILE, $buf, 0xA0;
        $buflen == 0xA0 || &usage( sprintf "Data missing in header entry at \%08x.\n", $offset ); 

        $filename = unpack "Z*", $buf;
        if ( $filename_pak_crc == 0 or $filename_pak_crc != hex &get_crc32($filename) ) {
            for ( my $letter = 'a'; $letter ne 'z'; $letter++ ) {
                if ( $filename_pak_crc == hex &get_crc32( $letter.$filename ) ) {
                    $filename = $letter.$filename;
                    last;
                }
            }
        }
    }
    elsif ( defined $filename_dbg ) {
        $filename = $filename_dbg;
    }
    else {
        $filename = sprintf 'file-%03d-0x%08x-0x%08x.%s',scalar @filelist+1, $filename_dbg_crc, $filename_trun_crc,$filetype;
    }

    $offset = $offset + $increment;

    if ( $filetype_crc == 0 or defined($filetype)?$filetype =~ m/.?last/i:0 ) {
        last;
    }

    push @filelist, (
        {
            filename => $filename,
            start    => $filestart,
            len      => $filelen,
        }
    );

    if ( $verbose ) {
        print  " Filename       : \"$filename\"\n";
        printf ' Start          : %1$10u (0x%1$08x)'."\n", $filestart;
        printf ' Length         : %1$10u (0x%1$08x)'."\n", $filelen;
        printf ' Type CRC       : %1$10u (0x%1$08x)', $filetype_crc;
        defined($filetype) ? print " $filetype\n" : print "\n";
        printf ' PAK name CRC   : %1$10u (0x%1$08x)', $filename_pak_crc;
        defined($filename_pak) ? print " $filename_pak\n" : print "\n";
        printf ' DBG name CRC   : %1$10u (0x%1$08x)', $filename_dbg_crc;
        defined($filename_dbg) ? print " $filename_dbg\n" : print "\n";
        printf ' Short name CRC : %1$10u (0x%1$08x)', $filename_trun_crc;
        defined($filename_trun) ? print " $filename_trun\n" : print "\n";
        printf ' Null           : %1$10u (0x%1$08x)'."\n", $null;
        printf ' Flags          : %1$10u (0x%1$08x)'."\n", $filename_flags;
    }
}

print "Found " . scalar @filelist . " files.\n";

# process pak data (inline or external)

# if pab file defined, close pak and open the pab
my $chnkpab_filename;
if ( $pab ne '' ) {
    close FILE;
    open FILE, $pab or die "Could not open $pab! $!\n";
    binmode FILE;
    $offset = $filelist[0]->{'start'};

    # check for chunks (magic number = 'CHNK')
    my $magic;
    read FILE, $magic, 4;
    seek FILE,0,0;

    if ( unpack('N', $magic) == 0x43484e4b ) {
        my $pointer = 0;
        ( undef, $chnkpab_filename ) = tempfile( 'chnkXXXXX', DIR => '.' );
        print "Found CHNK header in pab file, decompressing.\n";

        while (1) {
            my $header = tell FILE;

            my $buf;
            my $len = read FILE, $buf, 24;

            my ( 
                $magic, 
                $start, 
                $length, 
                $next, 
                $flags, 
                $size,
            ) = unpack 'N*', $buf;
            
            last unless $magic == 0x43484e4b;

            seek FILE, $header + $start, 0;
            die "short read\n" unless read(FILE, $buf, $length) == $length;
            anyinflate( \$buf, $chnkpab_filename, Append => 1 ) or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n";
            
            last if $next == 0xffffffff;
            seek FILE, $header + $next, 0;
        }
        close FILE;
        open FILE, $chnkpab_filename;
    }
}

foreach my $files_href ( @filelist ) {
    if ( $verbose ) { 
        printf "Current offset : \%08x\n", $offset;
        printf "Expected offset: \%08x\n", $files_href->{'start'};
    }
    if ( $offset < $files_href->{'start'} ) {
        my $junk = $files_href->{'start'} - $offset;
        $verbose && printf "Skipping \%08x bytes of junk.\n", $junk;
        my $skipit = seek FILE, $junk, 1;
        $skipit || die sprintf "Couldn't seek past junk at \%1\$010D (0x\%1\$08x)! $!\n", $offset;
        $offset = $offset + $junk;
        $verbose && printf "Adjusted offset: \%08x\n", $offset;
    }
    elsif ( $offset > $files_href->{'start'} ) {
        die sprintf
            "Offset exception when attempting to read \"\%s\".\n" .
            "File starts at \%08x but offset is \%08x\n", 
            $files_href->{'filename'}, 
            $files_href->{'start'}, 
            $offset;
    }

    # filenames use either / or \ as the directory delimiter, even on the same platform!
    my $converted_filename = $files_href->{'filename'};
    $converted_filename =~ s#\\#/#g;

    # split out directories and filename
    my @filename_parts = split /\//, $converted_filename;
    my $basename = pop @filename_parts;  
    $verbose && print "Basename is \"$basename\"\n";

    # create subdirectories, if necessary
    my $path = $outdir;
    foreach my $part ( @filename_parts ) {
        $verbose && print "Checking for directory: $part\n";
        $path = File::Spec->catdir ($path,  $part);
        if ( ! $test ) { -d $path || mkdir $path; }
    }

    # create the complete, OS safe, path and filename
    my $full_filename = File::Spec->catfile ($path, $basename);
    
    if ( -f $full_filename ) {
        print "Not extracting $files_href->{'filename'}: file exists.\n";
    }
    else {
        print "Extracting $files_href->{'filename'} to $full_filename\n";

        my $read_buf_size = 0x800;
        my $counter = $files_href->{'len'};
        my $buf;
        my $read;
        $test || open OUT, ">:raw", "$full_filename";

        while(1) {
            if ( $counter > $read_buf_size ) {
                my $read = read FILE, $buf, $read_buf_size;
                $read < $read_buf_size && die ( sprintf "Premature end of file at \%1\$10D (0x\%1\$08x).\n", $offset); 
                $test || print OUT $buf;
                $counter -= $read_buf_size;
                $offset += $read_buf_size;
            }
            else {
                $read = read FILE, $buf, $counter;
                $read < $counter && die ( sprintf "Premature end of file at \%1\$10D (0x\%1\$08x).\n", $offset);
                $test || print OUT $buf;
                $offset += $counter;
                last;
            }
        }
    }
}

sub dbg {
    my $value = shift;
    if ( defined $checksums{$value} ) {
        return $checksums{$value};
    }
    else {
        return undef;
    }
}

sub get_crc32 {
    my $string = lc shift;
    $string =~ s#\/#\\#g;
    $string =~ s#\.\s*\.qb$##g;
    return sprintf "0x\%08x", ( crc32( $string ) ^ 0xFFFFFFFF ) ;
}

sub inflation {
    my $inputFile = shift;
    my $outputFile = shift;

    my $status = anyinflate( 
            $inputFile => $outputFile,
            BinModeOut  => 1
    ) or die "anyinflate failed: $AnyInflateError\n";
    return $status;
}

END {
    unless ( $keeptemp ) {
        if ( $inflate ) {
            unlink $temppakname;
            if ( $temppabname ) {
                unlink $temppabname;
            }
        }
        if ( $chnk_filename ) {
            unlink $chnk_filename;
        }
        if ( $chnkpab_filename ) {
            unlink $chnkpab_filename;
        }
    }
    else {
        defined $temppakname && print "Temporary INFLATE pak file $temppakname not deleted.\n";
        defined $temppabname && print "Temporary INFLATE pab file $temppabname not deleted.\n";
        defined $chnk_filename && print "Temporary DECHNK pak file $chnk_filename not deleted.\n";
        defined $chnkpab_filename && print "Temporary DECHNK pab file $chnkpab_filename not deleted.\n";
    }
}

