#!/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 () { 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"; }