[commit: ghc] ghc-8.6: Fix Ar crashing on odd-sized object files (Trac #15396) (0480507)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/04805078763d6c7347d4cecf33d7e14099790793/ghc

>---------------------------------------------------------------

commit 04805078763d6c7347d4cecf33d7e14099790793
Author: Krzysztof Gogolewski <krz.gogolewski at gmail.com>
Date:   Fri Jul 27 22:10:52 2018 +0200

    Fix Ar crashing on odd-sized object files (Trac #15396)
    
    Summary: All the work was done by Moritz Angermann.
    
    Test Plan: validate
    
    Reviewers: angerman, RyanGlScott, bgamari
    
    Reviewed By: angerman
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15396
    
    Differential Revision: https://phabricator.haskell.org/D5013
    
    (cherry picked from commit 754c3a55a603b155fa5d9a282de73d41a4694ffc)


>---------------------------------------------------------------

04805078763d6c7347d4cecf33d7e14099790793
 compiler/main/Ar.hs                  | 13 +++++++++++--
 testsuite/tests/driver/T15396.hs     |  8 ++++++++
 testsuite/tests/driver/T15396.stdout |  1 +
 testsuite/tests/driver/all.T         |  2 ++
 4 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs
index 51655c0..9ead053 100644
--- a/compiler/main/Ar.hs
+++ b/compiler/main/Ar.hs
@@ -95,7 +95,8 @@ getBSDArchEntries = do
         st_size <- getPaddedInt <$> getByteString 10
         end     <- getByteString 2
         when (end /= "\x60\x0a") $
-          fail "Invalid archive header end marker"
+          fail ("[BSD Archive] Invalid archive header end marker for name: " ++
+                C.unpack name)
         off1    <- liftM fromIntegral bytesRead :: Get Int
         -- BSD stores extended filenames, by writing #1/<length> into the
         -- name field, the first @length@ bytes then represent the file name
@@ -106,6 +107,10 @@ getBSDArchEntries = do
                         return $ C.unpack $ C.takeWhile (/= ' ') name
         off2    <- liftM fromIntegral bytesRead :: Get Int
         file    <- getByteString (st_size - (off2 - off1))
+        -- data sections are two byte aligned (see Trac #15396)
+        when (odd st_size) $
+          void (getByteString 1)
+
         rest    <- getBSDArchEntries
         return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest
 
@@ -128,8 +133,12 @@ getGNUArchEntries extInfo = do
       st_size <- getPaddedInt <$> getByteString 10
       end     <- getByteString 2
       when (end /= "\x60\x0a") $
-        fail "Invalid archive header end marker"
+        fail ("[BSD Archive] Invalid archive header end marker for name: " ++
+              C.unpack name)
       file <- getByteString st_size
+      -- data sections are two byte aligned (see Trac #15396)
+      when (odd st_size) $
+        void (getByteString 1)
       name <- return . C.unpack $
         if C.unpack (C.take 1 name) == "/"
         then case C.takeWhile (/= ' ') name of
diff --git a/testsuite/tests/driver/T15396.hs b/testsuite/tests/driver/T15396.hs
new file mode 100644
index 0000000..9ab9f6e
--- /dev/null
+++ b/testsuite/tests/driver/T15396.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Ar
+
+-- obtained from echo -n \0 > x.o && ar -q b.a x.o && cat b.a
+archive = "!<arch>\nx.o/            0           0     0     644     1         \
+\`\n0\nx.o/            0           0     0     644     1         `\n0\n"
+
+main = print (parseAr archive)
diff --git a/testsuite/tests/driver/T15396.stdout b/testsuite/tests/driver/T15396.stdout
new file mode 100644
index 0000000..65edafa
--- /dev/null
+++ b/testsuite/tests/driver/T15396.stdout
@@ -0,0 +1 @@
+Archive [ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"},ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"}]
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 714b6c4..6397598 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -278,3 +278,5 @@ test('T13604a', [], run_command, ['$MAKE -s --no-print-directory T13604a'])
 test('inline-check', omit_ways(['hpc', 'profasm'])
                    , compile
 		   , ['-dinline-check foo -O -ddebug-output'])
+
+test('T15396', normal, compile_and_run, ['-package ghc'])