sc.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Data::Dumper;
   5
   6 {
   7 #package Data::MPQ::SCM;
   8 #package File::StarCraft::Map;
   9 package Archive::MoPaQ;
  10
  11 use strict;
  12 use warnings;
  13 use Data::Dumper;
  14
  15 {
  16
  17 sub overflow ($$) {
  18         my $self = shift;
  19         $_[0] %= 0xFFFF_FFFF + 1;
  20 }
  21
  22 my @crypttable;
  23 {
  24         my $seed = 0x0010_0001;
  25
  26         for my $i1 (0 .. 0x100) {
  27                 my $i2 = $i1;
  28                 for (0 .. 4) {
  29                         $seed  = ($seed * 125 + 3) % 0x2AAAAB;
  30                         my $temp1 = ($seed & 0xFFFF) << 16;
  31
  32                         $seed  = ($seed * 125 + 3) % 0x2AAAAB;
  33                         my $temp2 = ($seed & 0xFFFF);
  34
  35                         $crypttable[$i2] = ($temp1 | $temp2);
  36
  37                         $i2 += 0x100;
  38                 }
  39         }
  40 }
  41
  42 sub hashstr {
  43         my $self = shift;
  44         my ($str, $type) = @_;
  45         my ($seed1, $seed2) = (0x7FED_7FED, 0xEEEE_EEEE);
  46         for my $ch (unpack "C*", uc $str) {
  47                 $seed1 += $seed2;
  48                 $self->overflow($seed1);
  49                 $seed1 ^= $crypttable[$type*0x100 + $ch];
  50                 $seed2 *= 33;
  51                 $seed2 += $ch + $seed1 + 3;
  52                 $self->overflow($seed2);
  53         }
  54         return $seed1;
  55 }
  56
  57 sub decrypt ($$$) {
  58         my $self = shift;
  59         my ($in, $key) = @_;
  60         my $seed = 0xEEEE_EEEE;
  61
  62         my @out = unpack "V*", $in;
  63         for my $ch (@out) {
  64                 $seed += $crypttable[0x400 + ($key & 0xFF)];
  65                 $self->overflow($seed);
  66                 $ch ^= $self->overflow($key + $seed);
  67                 $key = $self->overflow((~$key << 21) + 0x1111_1111) | ($key >> 11);
  68                 $seed *= 33;
  69                 $seed += $ch + 3;
  70         }
  71         return pack "V*", @out;
  72 }
  73
  74 }
  75
  76 # Archive Header - File Data - File Data - Special Files - Hash Table - Block Table - Extended Block Table - Strong Digital signature
  77
  78 sub new {
  79         my ($class, $file) = @_;
  80         my $fh = $file || \*STDIN;
  81         bless {
  82                 fh => $fh,
  83         }, $class;
  84 }
  85
  86 sub _read {
  87         my $self = shift;
  88         my ($size, $seek) = @_;
  89         my $fh = $self->{fh};
  90         seek *$fh, $seek, 0 if $seek;
  91         read(*$fh, my $in, $size) eq $size or return undef;
  92         return $in;
  93 }
  94
  95 sub open {
  96         my $self = shift;
  97
  98         local $_ = $self->_read(8) #, 0
  99                 and my ($magic, $headsize) = unpack "a4V", $_
 100                 or die "Couldn't read file header\n";
 101
 102         $magic eq "MPQ\032"
 103                 or die "File is not a valid MoPaQ archive\n";
 104
 105         $headsize == 32
 106                 or die "Unrecognized header size\n";
 107
 108         $self->{header} = $self->_read($headsize) #, 8
 109                 or die "Couldn't read header of $headsize bytes\n";
 110
 111         my (
 112                 $archivesize,  # Size of the whole archive, including the header. Does not include the strong digital signature, if present. This size is used, among other things, for determining the region to hash in computing the digital signature. This field is deprecated in the Burning Crusade MoPaQ format, and the size of the archive is calculated as the size from the beginning of the archive to the end of the hash table, block table, or extended block table (whichever is largest).
 113                 $version,      # MoPaQ format version. MPQAPI will not open archives where this is negative. Known versions:
 114 # 0000h: Original format. HeaderSize should be 20h, and large archives are not supported.
 115 # 0001h: Burning Crusade format. Header size should be 2Ch, and large archives are supported.
 116                 $sectorsize,   # Power of two exponent specifying the number of 512-byte disk sectors in each logical sector in the archive. The size of each logical sector in the archive is 512 * 2^SectorSizeShift. Bugs in the Storm library dictate that this should always be 3 (4096 byte sectors).
 117
 118                 $hashoffset,  # Offset to the beginning of the hash table, relative to the beginning of the archive.
 119                 $blockoffset,  # Offset to the beginning of the block table, relative to the beginning of the archive.
 120                 $hashentries, # Number of entries in the hash table. Must be a power of two, and must be less than 2^16 for the original MoPaQ format, or less than 2^20 for the Burning Crusade format.
 121                 $blockentries, # Number of entries in the block table.
 122         ) = unpack "Vvcx VVVV", $self->{header};
 123
 124         my (
 125                 $eblockoffset, # (>=BC) Offset to the beginning of the extended block table, relative to the beginning of the archive.
 126                 $hashoffsethb, # (>=BC) High 16 bits of the hash table offset for large archives.
 127                 $blockoffsethb, # (>=BC) High 16 bits of the block table offset for large archives.
 128         ) = unpack "C8ss", substr $self->{header}, -4 if $version >= 1;
 129
 130         my $hashdata = $self->_read($hashentries * 16, $hashoffset)
 131                 or die $!;
 132         $self->{hash} = {
 133                 map unpack("a11xV", $_),
 134                 unpack "(a16)*", $self->decrypt($hashdata, $self->hashstr('(hash table)', 3))
 135         };
 136
 137         my $blockdata = $self->_read($blockentries * 16, $blockoffset)
 138                 or die $!;
 139         $self->{block} = [
 140                 unpack "(a16)*", $self->decrypt($blockdata, $self->hashstr('(block table)', 3))
 141         ];
 142
 143         return $self;
 144 }
 145
 146 sub extract {
 147         my $self = shift;
 148         my ($index) = @_;
 149         my (
 150                 $offset,   # Offset of the beginning of the block, relative to the beginning of the archive.
 151                 $size,     # Size of the block in the archive.
 152                 $filesize, # Size of the file data stored in the block. Only valid if the block is a file; otherwise meaningless, and should be 0. If the file is compressed, this is the size of the uncompressed file data.
 153                 $flags,
 154         ) = unpack "V4", $self->{block}[$index];
 155
 156         my $data = $self->_read($size, $offset) or die $!;
 157         $self->decrypt($data, 0);
 158 }
 159
 160 }
 161
 162 {
 163
 164 package Data::StarCraft::Map;
 165
 166 use constant {
 167         BWREP_HEADER_SIZE => 0x279,
 168 };
 169
 170 sub new {
 171         my ($class, $file) = @_;
 172         my $fh = $file || \*STDIN;
 173         bless {
 174                 fh => $fh,
 175         }, $class;
 176 }
 177
 178 sub _read {
 179         my $self = shift;
 180         my ($size, $seek) = @_;
 181         my $fh = $self->{fh};
 182         seek *$fh, $seek, 0 if $seek;
 183         read(*$fh, my $in, $size) eq $size or return undef;
 184         return $in;
 185 }
 186
 187 =cut
 188 sub unpack {
 189         my %esi;
 190         $esi{m24} = rep;
 191         $esi{m1C} = 0x800;
 192         $esi{m20} = func_esi28(myesi->m2234, myesi->m1C, myesi->m24);
 193         $esi{m20} <= 4 and return 3;
 194         $esi{m04} = (int)rep->src[0];
 195         $esi{m0C} = (int)rep->src[1];
 196         $esi{m14} = (int)rep->src[2];
 197         $esi{m18} = 0;
 198         $esi{m1C} = 3;
 199         $esi{m0C} < 4 || $esi{m0C} > 6 and return 1;
 200         $esi{m10} = (1 << $esi{m0C}) - 1;  # 2^n - 1
 201
 202 #       /* if ($esi{m04} == 1) printf("Oops\n"); */                        /* Should never be true */
 203         $esi{m04} == 0 or return 2;
 204
 205         memcpy(myesi->m30F4, off_5071D0, sizeof(off_5071D0));               /* dst, src, len */
 206         com1(sizeof(off_5071E0), myesi->m30F4, off_5071E0, myesi->m2B34);   /* len, src, str, dst */
 207         memcpy(myesi->m3104, off_5071A0, sizeof(off_5071A0));               /* dst, src, len */
 208         memcpy(myesi->m3114, off_5071B0, sizeof(off_5071B0));               /* dst, src, len */
 209         memcpy(myesi->m30B4, off_507120, sizeof(off_507120));               /* dst, src, len */
 210         com1(sizeof(off_507160), myesi->m30B4, off_507160, myesi->m2A34);   /* len, src, str, dst */
 211         unpack_rep_chunk(myesi);
 212 }
 213 =cut
 214
 215 sub unpack_section
 216 {
 217         my ($self, $size) = @_;
 218
 219         $size > 0 or return;
 220 =cut
 221 #    replay_enc_t    rep;
 222 #    esi_t           myesi;
 223 #    byte            buffer[0x2000];
 224 #    int             check, count, length, n, len=0, m1C, m20=0;
 225
 226         my $check = $self->_read(4) or return;
 227         my $count = $self->_read(4) or return;
 228
 229         my $m20 = 0;
 230         for (my $n = 0, $m1C = 0; $n < $count; $n++, $m1C += sizeof(buffer), $m20 += $len) {
 231                 my $length = $this->_read(4);
 232                 $length <= $size - $m20 or return;
 233                 my $result = $this->_read($length) or return;
 234                 continue if $length == min($size - $m1C, sizeof($buffer));
 235
 236                 # init rep struct
 237                 rep.src = (byte*)result;
 238                 rep.m04 = 0;
 239                 rep.m08 = $buffer;
 240                 rep.m0C = 0;
 241                 rep.m10 = $length;
 242                 rep.m14 = sizeof(buffer);
 243                 # unpack replay section
 244                 if (unpack_rep_section(&myesi, &rep) == 0 && rep.m0C <= sizeof(buffer)) len = rep.m0C; else len = 0;
 245                 if (len == 0 || len > size) return 4;
 246
 247                 # Main decompression functions
 248                 /*
 249                 unsigned long outlength = sizeof(buffer);
 250                 Explode4(buffer, &outlength, result, length);
 251                 len = (int)outlength;
 252                 */
 253
 254                 memcpy(result, buffer, len);
 255                 $result += $len;
 256         }
 257         return $check;
 258 }
 259 =cut
 260
 261 sub open {
 262         my $self = shift;
 263
 264         local $_ = $self->_read(16)
 265                 and my ($magic, $headsize) = unpack "a16", $_
 266                 or die "Couldn't read file header\n";
 267
 268         $magic eq "\xA7\x7E\x7E\x2B\001\000\000\000\004\000\000\000reRS"
 269                 or die "File is not a valid starcraft replay\n";
 270
 271         $self->{header} = $self->unpack_section(BWREP_HEADER_SIZE)
 272                 or die "Couldn't read header of ".BWREP_HEADER_SIZE." bytes\n";
 273 }
 274
 275 }
 276
 277 my $rep = Data::StarCraft::Map->new;
 278 $rep->open;
 279 print join ",", map ord, split //, $rep->{header};
 280 print "\n";
 281 exit;
 282
 283 my $mpq = Archive::MoPaQ->new;
 284 $mpq->open;
 285 print $mpq->extract(0);
 286 #print Dumper [ $mpq->extract(0) ];
 287
 288 #print Dumper pack('V*', $self->hashstr('(index)', 1));
 289