Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.

award_plugin_roms.pl 7.3KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341
  1. #!/usr/bin/perl -w
  2. use strict;
  3. use FileHandle;
  4. use integer;
  5. sub unsigned_little_endian_to_value
  6. {
  7. # Assumes the data is initially little endian
  8. my ($buffer) = @_;
  9. my $bytes = length($buffer);
  10. my $value = 0;
  11. my $i;
  12. for($i = $bytes -1; $i >= 0; $i--) {
  13. my $byte = unpack('C', substr($buffer, $i, 1));
  14. $value = ($value * 256) + $byte;
  15. }
  16. return $value;
  17. }
  18. sub decode_fixed_string
  19. {
  20. my ($data, $bytes) = @_;
  21. return $data;
  22. }
  23. sub decode_pstring
  24. {
  25. my ($buf_ref, $offset_ref) = @_;
  26. # Decode a pascal string
  27. my $offset = ${$offset_ref};
  28. my $len = unpack('C',substr(${$buf_ref}, $offset, 1));
  29. my $data = substr(${$buf_ref}, $offset +1, $len);
  30. ${$offset_ref} = $offset + $len +1;
  31. return $data;
  32. }
  33. sub decode_cstring
  34. {
  35. # Decode a c string
  36. my ($buf_ref, $offset_ref) = @_;
  37. my ($data, $byte);
  38. my $index = ${$offset_ref};
  39. while(1) {
  40. $byte = substr(${$buf_ref}, $index, 1);
  41. if (!defined($byte) || ($byte eq "\0")) {
  42. last;
  43. }
  44. $data .= $byte;
  45. $index++;
  46. }
  47. ${$offset_ref} = $index;
  48. return $data;
  49. }
  50. sub type_size
  51. {
  52. my ($entry) = @_;
  53. my %type_length = (
  54. byte => 1,
  55. half => 2,
  56. word => 4,
  57. xword => 8,
  58. 'fixed-string' => $entry->[2],
  59. pstring => 0,
  60. cstring => 0,
  61. );
  62. my $type = $entry->[0];
  63. if (!exists($type_length{$type})) {
  64. die "unknown type $type";
  65. }
  66. my $length = $type_length{$type};
  67. return $length;
  68. }
  69. sub decode_fixed_type
  70. {
  71. my ($type, $data, $bytes) = @_;
  72. my %decoders = (
  73. 'byte' => \&unsigned_little_endian_to_value,
  74. 'half' => \&unsigned_little_endian_to_value,
  75. 'word' => \&unsigned_little_endian_to_value,
  76. 'xword' => \&unsigned_little_endian_to_value,
  77. 'fixed-string' => \&decode_fixed_string,
  78. );
  79. my $decoder = $decoders{$type} or die "unknow fixed type $type";
  80. return $decoder->($data, $bytes);
  81. }
  82. sub decode_variable_type
  83. {
  84. my ($type, $buf_ref, $offset_ref) = @_;
  85. my %decoders = (
  86. 'pstring' => \&decode_pstring,
  87. 'cstring' => \&decode_cstring,
  88. );
  89. my $decoder = $decoders{$type} or die "unknow variable type $type";
  90. return $decoder->($buf_ref, $offset_ref);
  91. }
  92. sub decode_struct
  93. {
  94. my ($buf_ref, $offset, $layout) = @_;
  95. my $initial_offset = $offset;
  96. my ($entry, %results);
  97. foreach $entry (@$layout) {
  98. my ($type, $name) = @$entry;
  99. my $bytes = type_size($entry);
  100. if ($bytes > 0) {
  101. my $data = substr(${$buf_ref}, $offset, $bytes);
  102. $results{$name} = decode_fixed_type($type, $data, $bytes);
  103. $offset += $bytes;
  104. } else {
  105. $results{$name} = decode_variable_type($type, $buf_ref, \$offset);
  106. }
  107. }
  108. return (\%results, $offset - $initial_offset);
  109. }
  110. sub print_big_hex
  111. {
  112. my ($min_digits, $value) = @_;
  113. my @digits;
  114. while($min_digits > 0 || ($value > 0)) {
  115. my $digit = $value%16;
  116. $value /= 16;
  117. unshift(@digits, $digit);
  118. $min_digits--;
  119. }
  120. my $digit;
  121. foreach $digit (@digits) {
  122. printf("%01x", $digit);
  123. }
  124. }
  125. my %lha_signatures = (
  126. '-com-' => 1,
  127. '-lhd-' => 1,
  128. '-lh0-' => 1,
  129. '-lh1-' => 1,
  130. '-lh2-' => 1,
  131. '-lh3-' => 1,
  132. '-lh4-' => 1,
  133. '-lh5-' => 1,
  134. '-lzs-' => 1,
  135. '-lz4-' => 1,
  136. '-lz5-' => 1,
  137. '-afx-' => 1,
  138. '-lzf-' => 1,
  139. );
  140. my %lha_os = (
  141. 'M' => 'MS-DOS',
  142. '2' => 'OS/2',
  143. '9' => 'OS9',
  144. 'K' => 'OS/68K',
  145. '3' => 'OS/386',
  146. 'H' => 'HUMAN',
  147. 'U' => 'UNIX',
  148. 'C' => 'CP/M',
  149. 'F' => 'FLEX',
  150. 'm' => 'Mac',
  151. 'R' => 'Runser',
  152. 'T' => 'TownOS',
  153. 'X' => 'XOSK',
  154. 'A' => 'Amiga',
  155. 'a' => 'atari',
  156. ' ' => 'Award ROM',
  157. );
  158. my @lha_level_1_header = (
  159. [ 'byte', 'header_size' ], # 1
  160. [ 'byte', 'header_sum', ], # 2
  161. [ 'fixed-string', 'method_id', 5 ], # 7
  162. [ 'word', 'skip_size', ], # 11
  163. [ 'word', 'original_size' ], # 15
  164. [ 'half', 'dos_time' ], # 17
  165. [ 'half', 'dos_date' ], # 19
  166. [ 'byte', 'fixed' ], # 20
  167. [ 'byte', 'level' ], # 21
  168. [ 'pstring', 'filename' ], # 22
  169. [ 'half', 'crc' ],
  170. [ 'fixed-string', 'os_id', 1 ],
  171. [ 'half', 'ext_size' ],
  172. );
  173. # General lha_header
  174. my @lha_header = (
  175. [ 'byte', 'header_size' ],
  176. [ 'byte', 'header_sum', ],
  177. [ 'fixed-string', 'method_id', 5 ],
  178. [ 'word', 'skip_size', ],
  179. [ 'word', 'original_size' ],
  180. [ 'half', 'dos_time' ],
  181. [ 'half', 'dos_date' ],
  182. [ 'half', 'rom_addr' ],
  183. [ 'half', 'rom_flags' ],
  184. [ 'byte', 'fixed' ],
  185. [ 'byte', 'level' ],
  186. [ 'pstring', 'filename' ],
  187. [ 'half', 'crc' ],
  188. [ 'lha_os', 'os_id', 1 ],
  189. [ 'half', 'ext_size' ],
  190. [ 'byte', 'zero' ],
  191. [ 'byte', 'total_checksum' ],
  192. [ 'half', 'total_size' ],
  193. );
  194. sub print_struct
  195. {
  196. my ($layout, $self) = @_;
  197. my $entry;
  198. my $width = 0;
  199. foreach $entry(@$layout) {
  200. my ($type, $name) = @$entry;
  201. if (length($name) > $width) {
  202. $width = length($name);
  203. }
  204. }
  205. foreach $entry (@$layout) {
  206. my ($type, $name) = @$entry;
  207. printf("%*s = ", $width, $name);
  208. my $value = $self->{$name};
  209. if (!defined($value)) {
  210. print "undefined";
  211. }
  212. elsif ($type eq "lha_os") {
  213. print "$lha_os{$value}";
  214. }
  215. elsif ($type =~ m/string/) {
  216. print "$value";
  217. }
  218. else {
  219. my $len = type_size($entry);
  220. print "0x";
  221. print_big_hex($len *2, $value);
  222. }
  223. print "\n";
  224. }
  225. }
  226. sub checksum
  227. {
  228. my ($buf_ref, $offset, $length) = @_;
  229. my ($i, $sum);
  230. $sum = 0;
  231. for($i = 0; $i < $length; $i++) {
  232. my $byte = unpack('C', substr($$buf_ref, $offset + $i, 1));
  233. $sum = ($sum + $byte) %256;
  234. }
  235. return $sum;
  236. }
  237. sub decode_lha_header
  238. {
  239. my ($buf_ref, $offset) = @_;
  240. my $level = unpack('C',substr(${$buf_ref}, $offset + 20, 1));
  241. my %self;
  242. my ($struct, $bytes);
  243. if ($level == 1) {
  244. ($struct, $bytes)
  245. = decode_struct($buf_ref, $offset, \@lha_level_1_header);
  246. %self = %$struct;
  247. if ($self{fixed} != 0x20) {
  248. die "bad fixed value";
  249. }
  250. $self{total_size} = $self{header_size} + 2 + $self{skip_size};
  251. if ($bytes != $self{header_size} +2) {
  252. die "$bytes != $self{header_size} +2";
  253. }
  254. my $checksum = checksum($buf_ref, $offset +2, $self{header_size});
  255. if ($checksum != $self{header_sum}) {
  256. printf("WARN: Header bytes checksum to %02lx\n",
  257. $checksum);
  258. }
  259. # If we are an award rom...
  260. if ($self{os_id} eq ' ') {
  261. @self{qw(zero total_checksum)} =
  262. unpack('CC', substr($$buf_ref,
  263. $offset + $self{total_size}, 2));
  264. if ($self{zero} != 0) {
  265. warn "Award ROM without trailing zero";
  266. }
  267. else {
  268. $self{total_size}++;
  269. }
  270. my $checksum =
  271. checksum($buf_ref, $offset, $self{total_size});
  272. if ($self{total_checksum} != $checksum) {
  273. printf("WARN: Image bytes checksum to %02lx\n",
  274. $checksum);
  275. }
  276. else {
  277. $self{total_size}++;
  278. }
  279. $self{rom_addr} = $self{dos_time};
  280. $self{rom_flags} = $self{dos_date};
  281. delete @self{qw(dos_time dos_date)};
  282. }
  283. }
  284. else {
  285. die "Unknown header type";
  286. }
  287. return \%self;
  288. }
  289. sub main
  290. {
  291. my ($filename, $rom_length) = @_;
  292. my $fd = new FileHandle;
  293. if (!defined($rom_length)) {
  294. my ($dev, $ino, $mode, $nlink, $uid, $gid,$rdev,$size,
  295. $atime, $mtime, $ctime, $blksize, $blocks)
  296. = stat($filename);
  297. $rom_length = $size;
  298. }
  299. $fd->open("<$filename") or die "Cannot ope $filename";
  300. my $data;
  301. $fd->read($data, $rom_length);
  302. $fd->close();
  303. my $i;
  304. for($i = 0; $i < $rom_length; $i++) {
  305. my $sig = substr($data, $i, 5);
  306. if (exists($lha_signatures{$sig})) {
  307. my $start = $i -2;
  308. my $header = decode_lha_header(\$data, $start);
  309. my $length = $header->{total_size};
  310. print "AT: $start - @{[$start + $length -1]}, $length bytes\n";
  311. print_struct(\@lha_header, $header);
  312. print "\n";
  313. }
  314. }
  315. }
  316. main(@ARGV);