summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krz.gogolewski@gmail.com>2018-07-21 02:00:46 +0200
committerKrzysztof Gogolewski <krz.gogolewski@gmail.com>2018-07-21 02:00:46 +0200
commitbe534b04202e00c259763dae5d5fc761beb9d8a4 (patch)
treecb8fbd8885af65d8521121348c281772b60aa7f1 /compiler
parentf64f06bebddd1dbfc6568f36fa1f91f758fa22f1 (diff)
downloadhaskell-wip/monoidal/odd-linking.tar.gz
first version of testwip/monoidal/odd-linking
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/Ar.hs11
1 files changed, 9 insertions, 2 deletions
diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs
index 51655c023c..cf3a02e515 100644
--- a/compiler/main/Ar.hs
+++ b/compiler/main/Ar.hs
@@ -95,7 +95,7 @@ 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 +106,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 +132,11 @@ getGNUArchEntries extInfo = do
st_size <- getPaddedInt <$> getByteString 10
end <- getByteString 2
when (end /= "\x60\x0a") $
- fail "Invalid archive header end marker"
+ fail $ "[GNU 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