+Avoid /tmp to avoid getting deleted by: tmpwatch(8)
authorlace <>
Sat, 24 Dec 2005 02:53:16 +0000 (02:53 +0000)
committerlace <>
Sat, 24 Dec 2005 02:53:16 +0000 (02:53 +0000)
Discard 'ia64' packages.
Improve printing of XML comments for dupes.
+Handle 'mspatch' to index more than "ntkrnlpa.exe" of them.
Updates of magics ignorances.
+Acceleration to avoid trying cabextract(1) for any PE executable.
+Provide default XML header+footer.

src/install/acquire/captivemodid-print.pl

index 7360c4e..b7d6f87 100755 (executable)
@@ -27,9 +27,13 @@ use Digest::MD5 qw(md5_hex);
 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;
 
 
@@ -109,6 +113,15 @@ my %lang=(
        );
 
 
+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)=@_;
@@ -141,35 +154,36 @@ 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;
                        }
                }
@@ -190,6 +204,7 @@ my($filename_unused,$basename_orig)=@_;
        $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) {
@@ -211,6 +226,7 @@ my($filename_unused,$basename_orig)=@_;
                        }
                else {
                        $type=$final_type or confess;
+                       confess Dumper(\@stack) if $type eq "cabinet";
                        $this_name=$final_name;
                        }
                my $length=(stat $filename)[7] or confess;
@@ -252,7 +268,12 @@ my($filename_unused,$basename_orig)=@_;
                $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,
@@ -275,6 +296,7 @@ my($filename_unused,$basename_orig)=@_;
                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];
 }
 
@@ -330,34 +352,72 @@ my($filename)=@_;
 }
 
 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;
@@ -401,16 +461,16 @@ sub process()
                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
@@ -425,7 +485,23 @@ sub process()
                                # 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.},
@@ -433,11 +509,9 @@ sub process()
                                        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, /
@@ -447,6 +521,9 @@ sub process()
                        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'";
@@ -474,7 +551,54 @@ if ($out) {
        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