use File::Remove qw(remove);
use Getopt::Long;
use Data::Dumper;
+require Config::IniHash;
+require File::Basename;
-my $tmp="/tmp/captivemodid";
+confess if !$ENV{"HOME"};
+my $tmp=$ENV{"HOME"}."/tmp/captivemodid";
+confess "tmp '$tmp' too dangerous for tmpwatch(8)" if $tmp=~m{^/tmp\b} || $tmp=~m{^/var/tmp\b};
my $out;
);
+sub name_valid($)
+{
+my($name)=@_;
+ $name=~tr/-/_/;
+ $name=lc $name;
+ return 0 if $name=~/[^a-z]ia64[^a-z]/;
+ return 1;
+}
+
sub name_to_lang($)
{
my($name)=@_;
for my $subst (@checked_build) {
return 1 if $name=~/[^a-z]$subst[^a-z]/;
}
- return;
+ return 0;
}
my $ver_prefix="5.1.2600.";
my @stack_out;
-my $STDERR_needs_eol;
my %md5sum_printed_global;
sub stack0_flush()
{
return if $opt_quiet;
- # FIXME: Proper nesting, not just these 2 levels:
- my %md5sum_printed_local;
+ # $md5sum_printed_local[$stacki]{md5}=1;
+ my @md5sum_printed_local;
while (my $stack=shift @stack_out) {
+ my $hiding=1;
for my $stacki (0..$#$stack) {
my $this=$stack->[$stacki];
- next if $md5sum_printed_local{$this->{"md5"}}++;
+ $hiding=0 if !$md5sum_printed_local[$stacki]{$this->{"md5"}};
+ next if $hiding;
+ splice @md5sum_printed_local,$stacki,@md5sum_printed_local-$stacki,{$this->{"md5"}=>1};
my $dupe_global=$md5sum_printed_global{$this->{"md5"}}++;
my $print="";
- $print.=<<"HERE";
-<!-- @{[ $this->{"relname"} ]} -->
+ $print.=<<"HERE" if $dupe_global;
+<!-- @{[ $this->{"relname"} ]} md5="@{[ $this->{"md5"} ]}" -->
HERE
$print.=<<"HERE" if !$dupe_global;
+<!-- @{[ $this->{"relname"} ]} -->
<module type="@{[ $this->{"type"} ]}" length="@{[ $this->{"length"} ]}" priority="@{[ $this->{"priority"} ]}" md5="@{[ $this->{"md5"} ]}"
id="@{[ $this->{"dist"} ]} @{[ !$this->{"is_debug"} ? "" : "Checked Build "]}@{[ $this->{"lang"} ]} $ver_prefix@{[ $this->{"ver"} ]} @{[ $this->{"this_name"} ]}" />
HERE
$print=~s/^/"\t" x (1+$stacki)/egm;
- print STDERR "\n" if $STDERR_needs_eol;
- $STDERR_needs_eol=0;
print $print;
}
}
$final_type="ntoskrnl.exe" if $final_type=~/^nt.*[.]exe$/;
(my $basename_orig_=$basename_orig)=~s/.$/_/;
(my $basename0=$stack[0]->{"filename"})=~s{^.*/}{} or confess;
+ return if !name_valid($basename0);
stack0_flush() if $last_stack0_filename && $last_stack0_filename ne $stack[0]->{"filename"};
$last_stack0_filename=$stack[0]->{"filename"};
for my $stacki (0..$#stack) {
}
else {
$type=$final_type or confess;
+ confess Dumper(\@stack) if $type eq "cabinet";
$this_name=$final_name;
}
my $length=(stat $filename)[7] or confess;
$md5obj->addfile(*F);
close F or confess;
my $md5sum=lc $md5obj->hexdigest();
- spawn("cp -p '$filename' '$out/$md5sum'") if !$md5sum_stored{$md5sum}++ && $out && $stacki==$#stack;
+ if (!$md5sum_stored{$md5sum}++ && $out && $stacki==$#stack) {
+ my $dir="$out/$final_type";
+
+ mkdir_checked($dir) if !-d $dir;
+ spawn("cp -p '$filename' '$dir/$md5sum'");
+ }
my %new=(
%$this,
do { cluck Dumper($this,\%new) if $new{$_} ne $this->{$_}; } for keys(%$this);
%$this=%new;
}
+ # It is intentional to copy only the references - to update their "ver".
push @stack_out,[@stack];
}
}
my %unknown;
-sub process();
-sub process()
+sub process(;$$);
+sub process(;$$)
{
+my($ref,$reftype)=@_;
+
my $dirname=$dirnew or confess;
$dirnew=undef();
local $depth=$depth+1;
my @stack_orig=@stack;
+ local @stack;
+
+ # Handle so-called 'mspatch'.
+ # Look for Product/Technology: Platform SDK
+ # Item like: Microsoft Windows SDK
+ # http://www.microsoft.com/downloads/details.aspx?FamilyID=2297bdc9-b5ae-4b8a-b601-eef54a52867a&DisplayLang=en
+ # http://download.microsoft.com/download/0/7/3/073d42b8-e2ba-4293-ad97-28365dc2d655/6.0.5270.0.9.WindowsSDK_Vista_idw.DVD.Rel_Update.img
+ # Setup/WinSDK-SDK_MSI_SMP-common.0.cab
+ # APATCH 5.1.2600.0 Patch Application Utility
+ # Do not use: Windows Installer SDK (x86): APATCH 1.94 Patch Application Utility
+ # as it will break on some files (incompatible with some new features).
+ # You need proper Wine setup incl. its binary filetype registration.
+ if (-e "$dirname/_sfx_manifest_") {
+ Config::IniHash::ReadINI("_sfx_manifest_",
+ # The only way how to read it in the original order:
+ "forValue"=>sub {
+ my($dest_raw,$src_raw,$sectionname,$inihashref)=@_;
+ return if $sectionname ne "Deltas";
+ $dest_raw=~tr{\\}{/};
+ $src_raw=~tr{\\}{/};
+ my $dest=($dest_raw=~/^\s*"([^"]+)"\s*$/)[0] or confess;
+ my($patch,$src)=($src_raw=~/^\s*"([^"]+)"\s*,\s*"([^"]+)"\s*$/) or confess;
+ my $destdir=File::Basename::dirname($dest);
+ cluck "$dirname/$patch" if !-r "$dirname/$patch";
+ cluck "$dirname/$src" if !-r "$dirname/$src";
+ # Not &mkdir: Take care of already existing directories and ... "-p".
+ spawn "mkdir -p '$dirname/$destdir'";
+ rm_rf "$dirname/$dest";
+ spawn "true;(apatch '$dirname/$patch' '$dirname/$src' '$dirname/$dest' &>/dev/null)";
+ return;
+ },
+ );
+ }
local *FIND;
open FIND,"find '$dirname' -type f|sort|" or confess $dirname;
local $_;
while (<FIND>) {
next if $_ eq "";
- if (!$depth) {
- print STDERR ".";
- $STDERR_needs_eol=1;
- }
+ print STDERR "." if !$depth;
chomp;
my $filename=$_;
$filename=~m{^/} or confess $filename;
(my $basename=$filename)=~s{^.*/}{} or confess;
- -r $filename or do { cluck $filename; system("ls -l '$filename'"); };
+ -r $filename or do { cluck Dumper(\@stack,$filename); system("ls -l '$filename'"); };
+ $$ref=$reftype if $ref;
my $this={
"filename"=>$filename,
"relname"=>relname($filename),
};
@stack=(@stack_orig,$this);
+ if ($basename=~/[.]_p$/) {
+ do { cluck "Missing $_" if !-e $_; } for "_sfx_manifest_";
+ next;
+ }
+
check $filename,$basename;
local *MIME;
next if $id eq 'TrueType font data';
next if $id eq 'Windows NT registry file';
next if $id eq 'lif file'; # .sig?
- next if $id=~/^Infocom game data /; # ._p?
+ next if $id=~/^Infocom game data /; # .chm?
next if $id=~/^Sun disk label /; # .dl_?
next if $id=~/^compiled Java class data, /;
- next if $id=~/^Minix filesystem/; # .dl_?,_p?
+ next if $id=~/^Minix filesystem/; # .dl_?
next if $id eq 'DBase 3 index file'; # .nls?
next if $id=~/^Macintosh MFS data /; # .cp_?
next if $id eq 'ACB archive data'; # .cat?
next if $id eq 'COM executable for MS-DOS'; # .edb?
- next if $id=~/^Bio-Rad .PIC Image File/; # ._p?
next if $id eq 'SysEx File - Gulbransen'; # .edb?
+ next if $id eq 'LE executable for MS Windows (VxD)'; # .386?
# Do not:
#next if $id=~/^PE executable for MS Windows .* 32-bit$/; # TODO
# Catch all unidentified flying cabinets:
|| $id=~/^PE executable for MS Windows .* 32-bit$/
) {
- $this->{"type"}="cabinet";
+ # Acceleration: Spawning cabextract(1) is slow, try to find "MSCF" first.
+ local *CAB;
+ open CAB,$filename or confess $filename;
+ my $buf="";
+ my $buf2;
+ my $mscf; # magic
+ while (my $got=read CAB,$buf2,0x1000) {
+ confess $filename if !defined $got;
+ last if !$got;
+ confess $filename if $got<0;
+ confess $filename if length($buf2)!=$got;
+ $buf.=$buf2;
+ last if $mscf=($buf=~/MSCF/s);
+ $buf=substr($buf,-4);
+ }
+ close CAB or confess;
+ next if !$mscf;
prep();
spawn q{cabextract -q '}.$filename.q{' 2>&1|grep -v ': \(}.join(q{\|},
q{WARNING; possible [0-9]* extra bytes at end of file.},
q{checksum error},
q{error in CAB data format},
).q{\)$';true};
- process();
+ process(\$this->{"type"},"cabinet");
next;
}
- # non-"32-bit" (amd64 in fact)
- next if $id=~/^PE executable for MS Windows/;
if (0
|| $id eq 'PE executable for MS Windows (GUI) Intel 80386 32-bit, ZIP self-extracting archive (WinZip)'
|| $id=~/^Zip archive data, /
process();
next;
}
+ # non-"32-bit" - amd64 in fact but not detected by file(1).
+ # Really.
+ next if $id=~/^PE executable for MS Windows/;
if ($id=~m{^gzip compressed data, was "\S+", from Win/32}) {
prep();
spawn "gzip -d <'$filename' >'$basename'";
rm_rf $out;
mkdir_checked $out;
}
+$|=1;
+print <<'HERE';
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- $Id$
+ - Database of ids for Captive-compatible W32 binary modules
+ - Copyright (C) 2003-2005 Jan Kratochvil <project-captive@jankratochvil.net>
+ -
+ - This program is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; exactly version 2 of June 1991 is required
+ -
+ - This program is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with this program; if not, write to the Free Software
+ - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ -->
+<!--
+ - XP No Service Pack 5.1.2600.0
+ - Q317277_WXP_SP1_x86 xpclnt_qfe.010827-1803 5.1.2600.31
+ - Q811493_WXP_SP2 2600.xpclnt_qfe.021108-2107 5.1.2600.108
+ - XP Service Pack 1/1a xpsp1.020828-1920 5.1.2600.1106
+ - Q811493_WXP_SP2 2600.xpsp2.030422-1633 5.1.2600.1151
+ -
+ - 510110690:
+ - 90->{ntoskrnl +80}+{English +10}
+ - 1106->5.1.2600.{1106}
+ - 0->{0=Free,5=Checked}
+ - 51->{5}.{1}
+ - ntoskrnl
+ - ntoskrnl +80 (Uniprocessor 4GB or less)
+ - ntkrnlpa +60 (Uniprocessor >4GB extended addressing support)
+ - ntkrnlmp +40 (Multiprocessor 4GB or less)
+ - ntkrpamp +20 (Multiprocessor >4GB extended addressing support)
+ - English +10
+ -->
+<modid>
+
+
+HERE
process;
stack0_flush() if $last_stack0_filename;
-print STDERR "\n" if $STDERR_needs_eol;
-$STDERR_needs_eol=0;
+rm_rf $tmp;
+print STDERR "\n";
+print <<'HERE';
+
+</modid>
+HERE