From: lace <> Date: Sat, 24 Dec 2005 02:53:16 +0000 (+0000) Subject: +Avoid /tmp to avoid getting deleted by: tmpwatch(8) X-Git-Tag: bp_HEAD~13 X-Git-Url: http://git.jankratochvil.net/?p=captive.git;a=commitdiff_plain;h=6992ca3bc9600cafcbdd924095737adb731ebbe2 +Avoid /tmp to avoid getting deleted by: tmpwatch(8) 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. --- diff --git a/src/install/acquire/captivemodid-print.pl b/src/install/acquire/captivemodid-print.pl index 7360c4e..b7d6f87 100755 --- a/src/install/acquire/captivemodid-print.pl +++ b/src/install/acquire/captivemodid-print.pl @@ -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"; - + $print.=<<"HERE" if $dupe_global; + HERE $print.=<<"HERE" if !$dupe_global; + {"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 () { 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'; + + + + + + +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'; + + +HERE