octoleo/qpdf
2
1
Fork 0
mirror of https://github.com/qpdf/qpdf.git synced 2024-12-22 10:58:58 +00:00
Code Issues Releases Wiki Activity

Windows: find DLLs recursively at installation

Browse Source
This commit is contained in:
Jay Berkenbilt 2017-08-22 16:22:16 -04:00
parent 70949cb4cb
commit 55f19d3e1b
1 changed files with 50 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
copy_dlls Executable file → Normal file
View File

@ -11,33 +11,6 @@ usage() unless @ARGV == 4;
my ($file, $destdir, $objdump, $windows_wordsize) = @ARGV; my ($file, $destdir, $objdump, $windows_wordsize) = @ARGV;
my $filedir = dirname($file); my $filedir = dirname($file);
my %dlls = ();
my $format = undef;
open(O, "$objdump -p $file|") 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$/;
$dlls{$dll} = 1;
}
elsif (m/^Magic.*\((PE.+?)\)/)
{
$format = $1;
}
}
close(O);
if (! defined $format)
{
die "$whoami: can't determine format of $file\n";
}
# Search the directories named in the file's manifest (if present),
# the file's directory, the current directory, and the path for dlls
# since that's what Windows does. Be sure to only capture compatible
# DLLs.
my $sep = ($^O eq 'MSWin32' ? ';' : ':'); my $sep = ($^O eq 'MSWin32' ? ';' : ':');
my @path = ($filedir, '.', split($sep, $ENV{'PATH'})); my @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
foreach my $var (qw(LIB)) foreach my $var (qw(LIB))
@ -47,10 +20,6 @@ foreach my $var (qw(LIB))
push(@path, split($sep, $ENV{$var})); push(@path, split($sep, $ENV{$var}));
} }
} }
if (-f "$file.manifest")
{
unshift(@path, get_manifest_dirs("$file.manifest"));
}
my $redist_suffix = (($windows_wordsize eq '64') ? "x64" : "x86"); my $redist_suffix = (($windows_wordsize eq '64') ? "x64" : "x86");
if (exists $ENV{'VCINSTALLDIR'}) if (exists $ENV{'VCINSTALLDIR'})
{ {
@ -68,46 +37,82 @@ if (exists $ENV{'VCINSTALLDIR'})
} }
} }
} }
if (exists $ENV{'UNIVERSALCRTSDKDIR'}) if (exists $ENV{'UniversalCRTSdkDir'})
{ {
my $redist = $ENV{'UNIVERSALCRTSDKDIR'} . "/Redist/ucrt/DLLs/$redist_suffix"; my $redist = $ENV{'UniversalCRTSdkDir'} . "/Redist/ucrt/DLLs/$redist_suffix";
unshift(@path, $redist); unshift(@path, $redist);
} }
my @final = ();
my $format = undef;
my @to_find = get_dlls($file);
my %final = ();
my @notfound = (); my @notfound = ();
dll_loop:
foreach my $dll (sort keys %dlls) while (@to_find)
{ {
my $dll = shift(@to_find);
my $found = 0; my $found = 0;
foreach my $dir (@path) foreach my $dir (@path)
{ {
if ((-f "$dir/$dll") && is_format("$dir/$dll", $format)) if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
{ {
push(@final, "$dir/$dll"); if (! exists $final{$dll})
$found = 1; {
last; $final{$dll} = "$dir/$dll";
} push(@to_find, get_dlls("$dir/$dll"));
}
$found = 1;
last;
}
} }
if (! $found) if (! $found)
{ {
push(@notfound, $dll); push(@notfound, $dll);
} }
} }
if (@notfound) if (@notfound)
{ {
die "$whoami: can't find the following dlls: " . die "$whoami: can't find the following dlls: " .
join(', ', @notfound), "\n"; join(', ', @notfound), "\n";
} }
foreach my $f (@final) foreach my $dll (sort keys (%final))
{ {
my $f = $final{$dll};
$f =~ s,\\,/,g; $f =~ s,\\,/,g;
print "Copying $f to $destdir\n"; print "Copying $f to $destdir\n";
system("cp -p '$f' '$destdir'") == 0 or system("cp -p '$f' '$destdir'") == 0 or
die "$whoami: copy $f to $destdir failed\n"; 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$/;
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 sub is_format
{ {
my ($file, $format) = @_; my ($file, $format) = @_;
@ -133,58 +138,6 @@ sub is_format
$result; $result;
} }
sub get_manifest_dirs
{
# Find all system directories in which to search for DLLs based on
# the contents of a Visual Studio manifest file.
my $manifest_file = shift;
require XML::Parser;
my $sysroot = $ENV{'SYSTEMROOT'} or die "$whoami: can't get \$SYSTEMROOT\n";
$sysroot =~ s,\\,/,g;
if ($^O eq 'cygwin')
{
chop($sysroot = `cygpath $sysroot`);
die "$whoami: can't get system root" unless $? == 0;
}
my $winsxs = "$sysroot/WinSxS";
opendir(D, $winsxs) or die "$whoami: can't opendir $winsxs: $!\n";
my @entries = readdir(D);
closedir(D);
my @candidates = ();
my $readAssemblyIdentity = sub
{
my ($parser, $element, %attrs) = @_;
return unless $element eq 'assemblyIdentity';
my $type = $attrs{'type'};
my $name = $attrs{'name'};
my $version = $attrs{'version'};
my $processorArchitecture = $attrs{'processorArchitecture'};
my $publicKeyToken = $attrs{'publicKeyToken'};
my $dir_start = join('_',
$processorArchitecture,
$name,
$publicKeyToken,
$version);
push(@candidates, $dir_start);
};
my $p = new XML::Parser(Handlers => {'Start' => $readAssemblyIdentity});
$p->parsefile($manifest_file);
my @dirs = ();
foreach my $c (@candidates)
{
push(@dirs, map { "$winsxs/$_" } (grep { m/^\Q$c\E/i } @entries));
}
@dirs;
}
sub usage sub usage
{ {
die "Usage: $whoami {exe|dll} destdir\n"; die "Usage: $whoami {exe|dll} destdir\n";