OpenSystemsDevelopment / qpdf

Commit 55f19d3e1bd23728769803999139b276aca1da57

Authored by Jay Berkenbilt
1 parent 70949cb4

Windows: find DLLs recursively at installation

Inline Side-by-side
Showing 1 changed file with 50 additions and 97 deletions
copy_dlls 100755 → 100644
  View file @55f19d3
... ... @@ -11,33 +11,6 @@ usage() unless @ARGV == 4;
11 11 my ($file, $destdir, $objdump, $windows_wordsize) = @ARGV;
12 12 my $filedir = dirname($file);
13 13  
14   -my %dlls = ();
15   -my $format = undef;
16   -open(O, "$objdump -p $file|") or die "$whoami: can't run objdump\n";
17   -while (<O>)
18   -{
19   - if (m/^\s+DLL Name:\s+(.+\.dll)/i)
20   - {
21   - my $dll = $1;
22   - $dll =~ tr/A-Z/a-z/;
23   - next if $dll =~ m/^(kernel32|user32|msvcrt|advapi32)\.dll$/;
24   - $dlls{$dll} = 1;
25   - }
26   - elsif (m/^Magic.*\((PE.+?)\)/)
27   - {
28   - $format = $1;
29   - }
30   -}
31   -close(O);
32   -if (! defined $format)
33   -{
34   - die "$whoami: can't determine format of $file\n";
35   -}
36   -
37   -# Search the directories named in the file's manifest (if present),
38   -# the file's directory, the current directory, and the path for dlls
39   -# since that's what Windows does. Be sure to only capture compatible
40   -# DLLs.
41 14 my $sep = ($^O eq 'MSWin32' ? ';' : ':');
42 15 my @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
43 16 foreach my $var (qw(LIB))
... ... @@ -47,10 +20,6 @@ foreach my $var (qw(LIB))
47 20 push(@path, split($sep, $ENV{$var}));
48 21 }
49 22 }
50   -if (-f "$file.manifest")
51   -{
52   - unshift(@path, get_manifest_dirs("$file.manifest"));
53   -}
54 23 my $redist_suffix = (($windows_wordsize eq '64') ? "x64" : "x86");
55 24 if (exists $ENV{'VCINSTALLDIR'})
56 25 {
... ... @@ -68,46 +37,82 @@ if (exists $ENV{&#39;VCINSTALLDIR&#39;})
68 37 }
69 38 }
70 39 }
71   -if (exists $ENV{'UNIVERSALCRTSDKDIR'})
  40 +if (exists $ENV{'UniversalCRTSdkDir'})
72 41 {
73   - my $redist = $ENV{'UNIVERSALCRTSDKDIR'} . "/Redist/ucrt/DLLs/$redist_suffix";
  42 + my $redist = $ENV{'UniversalCRTSdkDir'} . "/Redist/ucrt/DLLs/$redist_suffix";
74 43 unshift(@path, $redist);
75 44 }
76   -my @final = ();
  45 +
  46 +my $format = undef;
  47 +my @to_find = get_dlls($file);
  48 +
  49 +my %final = ();
77 50 my @notfound = ();
78   -dll_loop:
79   -foreach my $dll (sort keys %dlls)
  51 +
  52 +while (@to_find)
80 53 {
  54 + my $dll = shift(@to_find);
81 55 my $found = 0;
82 56 foreach my $dir (@path)
83 57 {
84   - if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
85   - {
86   - push(@final, "$dir/$dll");
87   - $found = 1;
88   - last;
89   - }
  58 + if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
  59 + {
  60 + if (! exists $final{$dll})
  61 + {
  62 + $final{$dll} = "$dir/$dll";
  63 + push(@to_find, get_dlls("$dir/$dll"));
  64 + }
  65 + $found = 1;
  66 + last;
  67 + }
90 68 }
91 69 if (! $found)
92 70 {
93   - push(@notfound, $dll);
  71 + push(@notfound, $dll);
94 72 }
95 73 }
96   -
97 74 if (@notfound)
98 75 {
99 76 die "$whoami: can't find the following dlls: " .
100 77 join(', ', @notfound), "\n";
101 78 }
102 79  
103   -foreach my $f (@final)
  80 +foreach my $dll (sort keys (%final))
104 81 {
  82 + my $f = $final{$dll};
105 83 $f =~ s,\\,/,g;
106 84 print "Copying $f to $destdir\n";
107 85 system("cp -p '$f' '$destdir'") == 0 or
108 86 die "$whoami: copy $f to $destdir failed\n";
109 87 }
110 88  
  89 +sub get_dlls
  90 +{
  91 + my @result = ();
  92 + my $exe = shift;
  93 + open(O, "$objdump -p $exe|") or die "$whoami: can't run objdump\n";
  94 + while (<O>)
  95 + {
  96 + if (m/^\s+DLL Name:\s+(.+\.dll)/i)
  97 + {
  98 + my $dll = $1;
  99 + $dll =~ tr/A-Z/a-z/;
  100 + next if $dll =~ m/^(kernel32|user32|msvcrt|advapi32)\.dll$/;
  101 + push(@result, $dll);
  102 + }
  103 + elsif (m/^Magic.*\((PE.+?)\)/)
  104 + {
  105 + $format = $1;
  106 + }
  107 + }
  108 + close(O);
  109 + if (! defined $format)
  110 + {
  111 + die "$whoami: can't determine format of $exe\n";
  112 + }
  113 + @result;
  114 +}
  115 +
111 116 sub is_format
112 117 {
113 118 my ($file, $format) = @_;
... ... @@ -133,58 +138,6 @@ sub is_format
133 138 $result;
134 139 }
135 140  
136   -sub get_manifest_dirs
137   -{
138   - # Find all system directories in which to search for DLLs based on
139   - # the contents of a Visual Studio manifest file.
140   -
141   - my $manifest_file = shift;
142   -
143   - require XML::Parser;
144   - my $sysroot = $ENV{'SYSTEMROOT'} or die "$whoami: can't get \$SYSTEMROOT\n";
145   - $sysroot =~ s,\\,/,g;
146   - if ($^O eq 'cygwin')
147   - {
148   - chop($sysroot = `cygpath $sysroot`);
149   - die "$whoami: can't get system root" unless $? == 0;
150   - }
151   - my $winsxs = "$sysroot/WinSxS";
152   - opendir(D, $winsxs) or die "$whoami: can't opendir $winsxs: $!\n";
153   - my @entries = readdir(D);
154   - closedir(D);
155   -
156   - my @candidates = ();
157   -
158   - my $readAssemblyIdentity = sub
159   - {
160   - my ($parser, $element, %attrs) = @_;
161   - return unless $element eq 'assemblyIdentity';
162   - my $type = $attrs{'type'};
163   - my $name = $attrs{'name'};
164   - my $version = $attrs{'version'};
165   - my $processorArchitecture = $attrs{'processorArchitecture'};
166   - my $publicKeyToken = $attrs{'publicKeyToken'};
167   -
168   - my $dir_start = join('_',
169   - $processorArchitecture,
170   - $name,
171   - $publicKeyToken,
172   - $version);
173   - push(@candidates, $dir_start);
174   - };
175   -
176   - my $p = new XML::Parser(Handlers => {'Start' => $readAssemblyIdentity});
177   - $p->parsefile($manifest_file);
178   -
179   - my @dirs = ();
180   - foreach my $c (@candidates)
181   - {
182   - push(@dirs, map { "$winsxs/$_" } (grep { m/^\Q$c\E/i } @entries));
183   - }
184   -
185   - @dirs;
186   -}
187   -
188 141 sub usage
189 142 {
190 143 die "Usage: $whoami {exe|dll} destdir\n";
... ...