[msitools: 16/18] data: add validation of wxi files

[Marc-André Lureau <malureau src gnome org>]

commit face016f33a28846e171b13ffd6829f11418f76e
Author: Daniel P. Berrangé <berrange redhat com>
Date:   Wed Feb 13 11:13:41 2019 +0000

    data: add validation of wxi files
    
    The wxi files are prone to mistakes either at time of creation
    or as packages change over time. Add a check script that can
    validate for critical mistakes that will either break the
    installer build, or prevent the binaries from being loaded
    at runtime:
    
     - Missing DLLs refrenced by DLL/EXE files
     - Files in manifest which no longer exist on disk
    
    This requires that the various mingw* RPMs are available
    at time of "make check", otherwise the test is skipped.
    
    Since RPM contents are continually changing, this test
    is only expected to work against a Fedora rawhide
    install.
    
    Thus it is not wired into "make check" by default.
    Instead it is run by "make -C data check-wxi"
    
    Signed-off-by: Daniel P. Berrangé <berrange redhat com>

 configure.ac         |   2 +
 data/Makefile.am     |  12 ++
 data/wxi-validate.pl | 332 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 346 insertions(+)
---
diff --git a/configure.ac b/configure.ac
index fb3d716..877f00e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -32,6 +32,8 @@ then
     AC_MSG_ERROR([bison is required to build msitools])
 fi
 
+AC_PATH_PROG(PERL, perl)
+
 PKG_CHECK_MODULES([GLIB], [glib-2.0 >= 2.12])
 PKG_CHECK_MODULES([GOBJECT], [gobject-2.0 gio-2.0 >= 2.14])
 PKG_CHECK_MODULES([GSF], [libgsf-1])
diff --git a/data/Makefile.am b/data/Makefile.am
index 51e46eb..773dafb 100644
--- a/data/Makefile.am
+++ b/data/Makefile.am
@@ -2,6 +2,8 @@ NULL =
 
 wxidir = $(datadir)/wixl-$(VERSION)/include
 
+EXTRA_DIST = wxi-validate.pl
+
 dist_wxi_DATA =                                        \
        wixl/SDL.wxi                            \
        wixl/OpenEXR.wxi                        \
@@ -89,5 +91,15 @@ dist_wxi_DATA =                                      \
        wixl/winpthreads.wxi                    \
        $(NULL)
 
+check-wxi-%:
+       $(AM_V_GEN)rpm -q mingw32-$* mingw64-$* 1>/dev/null 2>&1 ; \
+       if test $$? = 0 ; \
+       then \
+               $(PERL) $(srcdir)/wxi-validate.pl wixl/$*.wxi ; \
+       else \
+               echo "Skipping wixl/$*.wxi as mingw32-$* and/or mingw64-$* are not installed" ; \
+       fi
+
+check-wxi: $(dist_wxi_DATA:wixl/%.wxi=check-wxi-%)
 
 -include $(top_srcdir)/git.mk
diff --git a/data/wxi-validate.pl b/data/wxi-validate.pl
new file mode 100755
index 0000000..bc2221b
--- /dev/null
+++ b/data/wxi-validate.pl
@@ -0,0 +1,332 @@
+#!/usr/bin/perl
+#
+# Validate a set of wxi files to determine if they
+# list all the DLL dependencies required by any EXE
+# or DLL files that contain and that all listed files
+# do exist on disk
+#
+# Copyright 2018-2019 Red Hat, Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 2 of
+# the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see
+# <http://www.gnu.org/licenses/>.
+#
+
+use strict;
+use warnings;
+
+use XML::XPath;
+use XML::XPath::XMLParser;
+
+# WXI Filename -> group name
+my %filegroups;
+
+# Group name -> dict ( array of component groups, array of component hashes )
+my %groups;
+
+# Component hash -> file path
+my %components;
+
+# DLL file name -> component hash
+my %dllcomponents;
+# DLL file name -> group name
+my %dllgroups;
+
+# DLL files provided by Windows runtime which
+# thus don't need to be listed in wxi files
+# as dependencies
+my %dllbuiltin = (
+    "advapi32.dll" => 1,
+    "comctl32.dll" => 1,
+    "comdlg32.dll" => 1,
+    "crypt32.dll" => 1,
+    "d3d9.dll" => 1,
+    "dnsapi.dll" => 1,
+    "dsound.dll" => 1,
+    "dwmapi.dll" => 1,
+    "gdi32.dll" => 1,
+    "gdiplus.dll" => 1,
+    "imm32.dll" => 1,
+    "iphlpapi.dll" => 1,
+    "kernel32.dll" => 1,
+    "msimg32.dll" => 1,
+    "msvcrt.dll" => 1,
+    "mswsock.dll" => 1,
+    "ole32.dll" => 1,
+    "oleaut32.dll" => 1,
+    "opengl32.dll" => 1,
+    "psapi.dll" => 1,
+    "setupapi.dll" => 1,
+    "shell32.dll" => 1,
+    "user32.dll" => 1,
+    "usp10.dll" => 1,
+    "winmm.dll" => 1,
+    "winspool.drv" => 1,
+    "wldap32.dll" => 1,
+    "ws2_32.dll" => 1,
+);
+
+my @checkgroups;
+my $errors = 0;
+# Load all the requested wxi files, doing
+# a basic sanity check that all files in
+# the manifest exist
+foreach my $file (@ARGV) {
+    push @checkgroups, &load($file);
+}
+exit 1 if $errors;
+
+# Check all DLL/EXE files to see if they
+# reference DLLs which are not mentioned as
+# dependencies
+foreach my $group (@checkgroups) {
+    my %allowedcomps;
+    &expand($group, \%allowedcomps);
+    &check($group, \%allowedcomps);
+}
+exit $errors;
+
+sub load {
+    my $file = shift;
+
+    # By convention the .wxi files must be named to match
+    # the mingw RPM name
+    my $rpmname = $file;
+    $rpmname =~ s,^.*/,,;
+    $rpmname =~ s/.wxi//;
+
+    my $rpmname32 = "mingw32-$rpmname";
+    my $rpmname64 = "mingw64-$rpmname";
+
+    # This testing is only going to work if the RPMs are
+    # actually installed
+    my $hasrpm32 = (system "rpm -q $rpmname32 >/dev/null 2>&1") == 0;
+    my $hasrpm64 = (system "rpm -q $rpmname64 >/dev/null 2>&1") == 0;
+
+    unless ($hasrpm32) {
+        $errors = 1;
+        print "Cannot check $file, $rpmname32 not installed\n";
+    }
+    unless ($hasrpm32) {
+        $errors = 1;
+        print "Cannot check $file, $rpmname32 not installed\n";
+    }
+
+    # Since we're recursively expanding <require> imports
+    # we might be called repeatedly for the same file, so
+    # short circuit if that happens
+    if (exists $filegroups{$file}) {
+        return $filegroups{$file};
+    }
+
+    # XML::XPath will automatically process the
+    # <?require> directives, but that is problematic
+    # as we want to track the exact source file that
+    # problems are present in.
+    #
+    # Thus we pre-emptively load any includes here
+    # so we can report errors directly, and setup
+    # the right file groups
+    open XML, "$file" or die "cannot read $file: $!";
+
+    foreach (<XML>) {
+        if (/<\?require (\S+)\?>/) {
+            my $incname = $1;
+            my $path = $file;
+            $path =~ s,/[^/]+$,/,;
+            my $incfile = $path . $incname;
+            &load($incfile);
+        }
+    }
+
+    close XML;
+
+    my $xp = XML::XPath->new(filename => $file);
+    my $nodeset;
+
+    # Extract all the listed dependencies
+    $nodeset = eval { $xp->find("//ComponentGroup"); };
+    if ($@) {
+        print STDERR "Parsing failed on $file: $@\n";
+        $errors = 1;
+        return;
+    }
+
+    my $cg = $nodeset->[0];
+
+    my $cgid = $cg->getAttribute("Id");
+    $groups{$cgid} = {
+        "file" => $file,
+        "groups" => [],
+        "components" => [],
+    };
+    foreach my $child ($cg->getChildNodes()) {
+        next unless defined $child->getName();
+
+        if ($child->getName() eq "ComponentRef") {
+            # These are file local dependencies
+            push @{$groups{$cgid}->{components}}, $child->getAttribute("Id");
+        } else {
+            # These are external file dependencies
+            push @{$groups{$cgid}->{groups}}, $child->getAttribute("Id");
+        }
+    }
+
+
+    # Extract all files listed in this wxi manifest
+    $nodeset = eval { $xp->find("//Component"); };
+    if ($@) {
+        print STDERR "Parsing failed on $file: $@\n";
+        return;
+    }
+
+    foreach my $node ($nodeset->get_nodelist) {
+        my $id = $node->getAttribute("Id");
+
+        foreach my $child ($node->getChildNodes()) {
+            next unless defined $child->getName() && $child->getName() eq "File";
+
+            my $fname = $child->getAttribute("Source");
+
+            my $msifile32 = $fname;
+            my $msifile64 = $fname;
+
+            $msifile32 =~ s,\$\(var.GLIB_ARCH\),win32,;
+            $msifile64 =~ s,\$\(var.GLIB_ARCH\),win64,;
+
+            $msifile32 =~ s,\$\(var.SourceDir\),/usr/i686-w64-mingw32/sys-root/mingw,;
+            $msifile64 =~ s,\$\(var.SourceDir\),/usr/x86_64-w64-mingw32/sys-root/mingw,;
+
+            # Hacks because we don't parse conditionals
+
+            # gcc
+            $msifile32 = undef if $msifile32 =~ /libgcc_s_seh-1\.dll/;
+            $msifile64 = undef if $msifile64 =~ /libgcc_s_sjlj-1.dll/;
+
+            # openssl
+            $msifile32 = undef if $msifile32 && $msifile32 =~ /lib(ssl|crypto)-[^-]+-x64.dll/;
+            $msifile64 = undef if $msifile64 && $msifile64 =~ /lib(ssl|crypto)-[^-]+.dll/;
+
+            # gstreamer1-plugins-base
+            $msifile32 = undef if $msifile32 && $msifile32 =~ /x86_64/;
+            $msifile64 = undef if $msifile64 && $msifile64 =~ /i686/;
+
+
+            # Check that the listed files really do exist
+            if ($hasrpm32 && $msifile32 && ! -e $msifile32) {
+                print "\n\nErrors in $file\n\n" unless $errors;
+                $errors = 1;
+                print "  - Missing $msifile32\n";
+            }
+            if ($hasrpm64 && $msifile64 && ! -e $msifile64) {
+                print "\n\nErrors in $file\n\n" unless $errors;
+                $errors = 1;
+                print "  - Missing $msifile64\n";
+            }
+
+            # Setup mappings for the component and file
+            $components{$id} = [] unless exists $components{$id};
+            push @{$components{$id}}, $msifile32 if $msifile32;
+            push @{$components{$id}}, $msifile64 if $msifile64;
+
+            # Setup mappings for the DLLs
+            if ($fname =~ m,.*/([^/]+.dll)$,) {
+                my $dllname = lc $1;
+                $dllcomponents{$dllname} = $id;
+                $dllgroups{$dllname} = $cgid;
+            }
+        }
+    }
+
+    $filegroups{$file} = $cgid;
+
+    return $cgid;
+}
+
+
+# Recursively expand a file to find the full
+# transitive set of dependancies / references
+sub expand {
+    my $name = shift;
+    my $allowed = shift;
+
+    foreach (@{$groups{$name}->{components}}) {
+        $allowed->{$_} = 1;
+    }
+    foreach my $ref (@{$groups{$name}->{groups}}) {
+        &expand($ref, $allowed);
+    }
+}
+
+
+# Check that all DLL/EXE files have their
+# dependencies satisfied
+sub check {
+    my $name = shift;
+    my $allowed = shift;
+
+    foreach my $comp (@{$groups{$name}->{components}}) {
+        if (!exists $components{$comp}) {
+            $errors = 1;
+            print "Referenced component $comp does not exist in $name\n";
+            return;
+        }
+        my @files = @{$components{$comp}};
+
+        foreach my $file (@files) {
+            next unless $file =~ /\.(exe|dll)$/;
+
+            my $problems = 0;
+
+            unless (-f $file) {
+                print " > $file\n" if ++$problems == 1;
+                print "     - Cannot analyse missing file $file\n";
+                next;
+            }
+
+            # Get the list of dependancies from objdump. The
+            # output contains list of stuff we don't care
+            # about so we're looking for lines like:
+            #
+            #    DLL Name: libcurl-4.dll
+            #    DLL Name: libdl.dll
+            #    DLL Name: libgcc_s_sjlj-1.dll
+            #    DLL Name: libgnutls-30.dll
+            #    DLL Name: libintl-8.dll
+
+            open OBJ, "x86_64-w64-mingw32-objdump -p $file |";
+            foreach my $info (<OBJ>) {
+                next unless $info =~ /DLL Name: (\S+)/;
+                my $dllname = lc $1;
+                next if exists $dllbuiltin{$dllname};
+
+                unless (exists $dllcomponents{$dllname}) {
+                    print " > $file\n" if ++$problems == 1;
+                    print "     - Unknown component for $dllname\n";
+                    next;
+                }
+
+                my $dllcomp = $dllcomponents{$dllname};
+
+                next if exists $allowed->{$dllcomp};
+
+                my $dllgroup = $dllgroups{$dllname};
+
+                print " > $file\n" if ++$problems == 1;
+                print "     - Missing group ref $dllgroup for $dllname\n";
+            }
+
+            $errors = 1 if $problems;
+        }
+    }
+}