mirror of https://github.com/qpdf/qpdf.git
146 lines
3.2 KiB
Perl
146 lines
3.2 KiB
Perl
#!/usr/bin/env perl
|
|
|
|
require 5.008;
|
|
BEGIN { $^W = 1; }
|
|
use strict;
|
|
use File::Basename;
|
|
|
|
my $whoami = basename($0);
|
|
|
|
usage() unless @ARGV == 4;
|
|
my ($file, $destdir, $objdump, $windows_wordsize) = @ARGV;
|
|
my $filedir = dirname($file);
|
|
|
|
my $sep = ($^O eq 'MSWin32' ? ';' : ':');
|
|
my @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
|
|
foreach my $var (qw(LIB))
|
|
{
|
|
if (exists $ENV{$var})
|
|
{
|
|
push(@path, split($sep, $ENV{$var}));
|
|
}
|
|
}
|
|
my $redist_suffix = (($windows_wordsize eq '64') ? "x64" : "x86");
|
|
if (exists $ENV{'VCINSTALLDIR'})
|
|
{
|
|
my $redist = $ENV{'VCINSTALLDIR'} . "/Redist/$redist_suffix";
|
|
if (opendir(D, $redist))
|
|
{
|
|
my @entries = readdir(D);
|
|
closedir(D);
|
|
foreach my $e (@entries)
|
|
{
|
|
if ($e =~ m/\.CRT$/i)
|
|
{
|
|
unshift(@path, "$redist/$e");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if (exists $ENV{'UniversalCRTSdkDir'})
|
|
{
|
|
my $redist = $ENV{'UniversalCRTSdkDir'} . "/Redist/ucrt/DLLs/$redist_suffix";
|
|
unshift(@path, $redist);
|
|
}
|
|
|
|
my $format = undef;
|
|
my @to_find = get_dlls($file);
|
|
|
|
my %final = ();
|
|
my @notfound = ();
|
|
|
|
while (@to_find)
|
|
{
|
|
my $dll = shift(@to_find);
|
|
my $found = 0;
|
|
foreach my $dir (@path)
|
|
{
|
|
if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
|
|
{
|
|
if (! exists $final{$dll})
|
|
{
|
|
$final{$dll} = "$dir/$dll";
|
|
push(@to_find, get_dlls("$dir/$dll"));
|
|
}
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (! $found)
|
|
{
|
|
push(@notfound, $dll);
|
|
}
|
|
}
|
|
if (@notfound)
|
|
{
|
|
die "$whoami: can't find the following dlls: " .
|
|
join(', ', @notfound), "\n";
|
|
}
|
|
|
|
foreach my $dll (sort keys (%final))
|
|
{
|
|
my $f = $final{$dll};
|
|
$f =~ s,\\,/,g;
|
|
print "Copying $f to $destdir\n";
|
|
system("cp -p '$f' '$destdir'") == 0 or
|
|
die "$whoami: copy $f to $destdir failed\n";
|
|
}
|
|
|
|
sub get_dlls
|
|
{
|
|
my @result = ();
|
|
my $exe = shift;
|
|
open(O, "$objdump -p \"$exe\"|") or die "$whoami: can't run objdump\n";
|
|
while (<O>)
|
|
{
|
|
if (m/^\s+DLL Name:\s+(.+\.dll)/i)
|
|
{
|
|
my $dll = $1;
|
|
$dll =~ tr/A-Z/a-z/;
|
|
next if $dll =~ m/^(kernel32|user32|msvcrt|advapi32)\.dll$/;
|
|
next if $dll =~ m/^(api-ms-win.*|ws2_32|crypt32|bcrypt)\.dll$/;
|
|
push(@result, $dll);
|
|
}
|
|
elsif (m/^Magic.*\((PE.+?)\)/)
|
|
{
|
|
$format = $1;
|
|
}
|
|
}
|
|
close(O);
|
|
if (! defined $format)
|
|
{
|
|
die "$whoami: can't determine format of $exe\n";
|
|
}
|
|
@result;
|
|
}
|
|
|
|
sub is_format
|
|
{
|
|
my ($file, $format) = @_;
|
|
$file =~ s,\\,/,g;
|
|
# Special case: msvc*.dll seem to be able to behave both as 32-bit
|
|
# and 64-bit DLLs. Either that, or this logic is wrong for those
|
|
# DLLs and it doesn't matter because they're already installed on
|
|
# my test system (which doesn't have msvc installed on it).
|
|
if ($file =~ m,/msvc,i)
|
|
{
|
|
return 1;
|
|
}
|
|
my $result = 0;
|
|
my $file_format = `file "$file"`;
|
|
print "$file $format $file_format\n";
|
|
if ($? == 0)
|
|
{
|
|
if ($file_format =~ m/\Q${format}\E executable/)
|
|
{
|
|
$result = 1;
|
|
}
|
|
}
|
|
$result;
|
|
}
|
|
|
|
sub usage
|
|
{
|
|
die "Usage: $whoami {exe|dll} destdir\n";
|
|
}
|