Fix Ar crashing on odd-sized object files (Trac #15396)
authorKrzysztof Gogolewski <krz.gogolewski@gmail.com>
Fri, 27 Jul 2018 20:10:52 +0000 (22:10 +0200)
committerKrzysztof Gogolewski <krz.gogolewski@gmail.com>
Fri, 27 Jul 2018 20:10:53 +0000 (22:10 +0200)
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

compiler/main/Ar.hs
testsuite/tests/driver/T15396.hs [new file with mode: 0644]
testsuite/tests/driver/T15396.stdout [new file with mode: 0644]
testsuite/tests/driver/all.T

index 51655c0..9ead053 100644 (file)
@@ -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 (file)
index 0000000..9ab9f6e
--- /dev/null
@@ -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 (file)
index 0000000..65edafa
--- /dev/null
@@ -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"}]
index 714b6c4..6397598 100644 (file)
@@ -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'])