2
1
mirror of https://github.com/qpdf/qpdf.git synced 2024-12-23 03:18:59 +00:00
qpdf/copy_dlls
Jay Berkenbilt 4229457068 Security: use a secure random number generator
If not available, give an error.  The user may also configure qpdf to
use an insecure random number generator.
2013-10-18 10:45:12 -04:00

163 lines
3.6 KiB
Perl
Executable File

#!/usr/bin/env perl
require 5.008;
BEGIN { $^W = 1; }
use strict;
use File::Basename;
my $whoami = basename($0);
usage() unless @ARGV == 3;
my ($file, $destdir, $objdump) = @ARGV;
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 @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
if (-f "$file.manifest")
{
unshift(@path, get_manifest_dirs("$file.manifest"));
}
my @final = ();
my @notfound = ();
dll_loop:
foreach my $dll (sort keys %dlls)
{
my $found = 0;
foreach my $dir (@path)
{
if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
{
push(@final, "$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 $f (@final)
{
$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 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 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
{
die "Usage: $whoami {exe|dll} destdir\n";
}