diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -109,8 +109,6 @@ yCbCrPositioning = exifIfd0Tag "yCbCrPositioning" 0x0213 ppYCbCrPositioning referenceBlackWhite = exifIfd0Tag "referenceBlackWhite" 0x0214 showT copyright = exifIfd0Tag "copyright" 0x8298 showT -exifIfdOffset = exifIfd0Tag "exifIfdOffset" 0x8769 showT -gpsTagOffset = exifIfd0Tag "gpsTagOffset" 0x8825 showT printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 ppUndef gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT @@ -163,7 +161,7 @@ imageUniqueId, exifInteroperabilityOffset, imageDescription, xResolution, yResolution, resolutionUnit, dateTime, whitePoint, primaryChromaticities, yCbCrPositioning, yCbCrCoefficients, referenceBlackWhite, - exifIfdOffset, printImageMatching, gpsTagOffset, artist, + printImageMatching, artist, gpsVersionID, gpsLatitudeRef, gpsLatitude, gpsLongitudeRef, gpsLongitude, gpsAltitudeRef, gpsAltitude, gpsTimeStamp, gpsSatellites, gpsStatus, gpsMeasureMode, gpsDop, gpsSpeedRef, gpsSpeed, gpsTrackRef, gpsTrack, diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -135,9 +135,7 @@ yCbCrPositioning, yCbCrCoefficients, referenceBlackWhite, - exifIfdOffset, printImageMatching, - gpsTagOffset, -- * If you need to declare your own exif tags ExifTag(..), @@ -205,7 +203,10 @@ markerNumber <- getWord16be dataSize <- fromIntegral . toInteger <$> getWord16be case markerNumber of - 0xffe1 -> parseExifBlock + 0xffe1 -> tryParseExifBlock >>= \case + Right exif -> pure exif + -- try will fail for XMP content for instance + Left bytesReadByTry -> skip (dataSize - 2 - bytesReadByTry) >> findAndParseExifBlockJPEG -- ffda is Start Of Stream => image -- I expect no more EXIF data after this point. 0xffda -> fail "No EXIF in JPEG" @@ -244,32 +245,22 @@ putWord32 Intel = putWord32le putWord32 Motorola = putWord32be -parseExifBlock :: Get (Map ExifTag ExifValue) -parseExifBlock = do +-- return either the exif info, or the number of bytes read. +tryParseExifBlock :: Get (Either Int (Map ExifTag ExifValue)) +tryParseExifBlock = do header <- getByteString 4 nul <- toInteger <$> getWord16be - unless (header == Char8.pack "Exif" && nul == 0) - $ fail "invalid EXIF header" - parseTiff + if header == Char8.pack "Exif" && nul == 0 + then Right <$> parseTiff + else pure (Left 6) -- read 6 bytes: 4+2 parseTiff :: Get (Map ExifTag ExifValue) parseTiff = do - tiffHeaderStart <- fromIntegral <$> bytesRead - byteAlign <- parseTiffHeader - let subIfdParse = parseSubIFD byteAlign tiffHeaderStart - (mExifSubIfdOffsetW, mGpsOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart - gpsData <- maybe (return []) (lookAhead . subIfdParse GpsSubIFD) mGpsOffsetW - exifSubEntries <- maybe (return []) (subIfdParse ExifSubIFD) mExifSubIfdOffsetW - return $ Map.fromList $ ifdEntries ++ exifSubEntries ++ gpsData - -parseSubIFD :: ByteAlign -> Int -> TagLocation -> Word32 -> Get [(ExifTag, ExifValue)] -parseSubIFD byteAlign tiffHeaderStart ifdType offsetW = do - let offset = fromIntegral $ toInteger offsetW - bytesReadNow <- fromIntegral <$> bytesRead - skip $ (offset + tiffHeaderStart) - bytesReadNow - parseSubIfd byteAlign tiffHeaderStart ifdType + (byteAlign, ifdOffset) <- lookAhead parseTiffHeader + tags <- parseIfd byteAlign IFD0 ifdOffset + return $ Map.fromList tags -parseTiffHeader :: Get ByteAlign +parseTiffHeader :: Get (ByteAlign, Int) parseTiffHeader = do byteAlignV <- Char8.unpack <$> getByteString 2 byteAlign <- case byteAlignV of @@ -280,49 +271,38 @@ unless (alignControl == 0x2a || (byteAlign == Intel && (alignControl == 0x55 || alignControl == 0x4f52))) $ fail "exif byte alignment mismatch" ifdOffset <- fromIntegral . toInteger <$> getWord32 byteAlign - skip $ ifdOffset - 8 - return byteAlign - -parseIfd :: ByteAlign -> Int -> Get (Maybe Word32, Maybe Word32, [(ExifTag, ExifValue)]) -parseIfd byteAlign tiffHeaderStart = do - dirEntriesCount <- fromIntegral <$> getWord16 byteAlign - ifdEntries <- replicateM dirEntriesCount (parseIfEntry byteAlign) - let exifOffset = entryContentsByTag exifIfdOffset ifdEntries - let gpsOffset = entryContentsByTag gpsTagOffset ifdEntries - entries <- mapM (decodeEntry byteAlign tiffHeaderStart IFD0) ifdEntries - return (exifOffset, gpsOffset, entries) + return (byteAlign, ifdOffset) -entryContentsByTag :: ExifTag -> [IfEntry] -> Maybe Word32 -entryContentsByTag tag = fmap entryContents . find (\e -> entryTag e == tagKey tag) +-- | Parse an Image File Directory table +parseIfd :: ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)] +parseIfd byteAlign ifdId offset = do + entries <- lookAhead $ do + skip offset + dirEntriesCount <- fromIntegral <$> getWord16 byteAlign + replicateM dirEntriesCount (parseIfEntry byteAlign ifdId) + + concat <$> mapM (entryTags byteAlign) entries -parseSubIfd :: ByteAlign -> Int -> TagLocation -> Get [(ExifTag, ExifValue)] -parseSubIfd byteAlign tiffHeaderStart location = do - dirEntriesCount <- fromIntegral <$> getWord16 byteAlign - ifdEntries <- replicateM dirEntriesCount (parseIfEntry byteAlign) - mapM (decodeEntry byteAlign tiffHeaderStart location) ifdEntries +-- | Convert IFD entries to tags, reading sub-IFDs +entryTags :: ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)] +entryTags _ (Tag tag parseValue) = parseValue >>= \value -> pure [(tag, value)] +entryTags byteAlign (SubIFD ifdId offset) = lookAhead (parseIfd byteAlign ifdId offset) -data IfEntry = IfEntry - { - entryTag :: !Word16, - entryFormat :: !Word16, - entryNoComponents :: !Int, - entryContents :: !Word32 - } deriving Show +data IfEntry = Tag ExifTag (Get ExifValue) | SubIFD TagLocation Int -parseIfEntry :: ByteAlign -> Get IfEntry -parseIfEntry byteAlign = do +-- | Parse a single IFD entry +parseIfEntry :: ByteAlign -> TagLocation -> Get IfEntry +parseIfEntry byteAlign ifdId = do tagNumber <- getWord16 byteAlign - dataFormat <- getWord16 byteAlign - numComponents <- getWord32 byteAlign - value <- getWord32 byteAlign - return IfEntry - { - entryTag = tagNumber, - entryFormat = dataFormat, - entryNoComponents = fromIntegral $ toInteger numComponents, - entryContents = value - } + format <- getWord16 byteAlign + numComponents <- fromIntegral <$> getWord32 byteAlign + content <- getWord32 byteAlign + return $ case (ifdId, tagNumber) of + (IFD0, 0x8769) -> SubIFD ExifSubIFD (fromIntegral content) + (IFD0, 0x8825) -> SubIFD GpsSubIFD (fromIntegral content) + (_, tagId) -> Tag (getExifTag ifdId tagId) (decodeEntry byteAlign format numComponents content) + getExifTag :: TagLocation -> Word16 -> ExifTag getExifTag l v = fromMaybe (ExifTag l Nothing v showT) $ find (isSameTag l v) allExifTags where isSameTag l1 v1 (ExifTag l2 _ v2 _) = l1 == l2 && v1 == v2 @@ -455,49 +435,36 @@ undefinedValueHandler ] -decodeEntry :: ByteAlign -> Int -> TagLocation -> IfEntry -> Get (ExifTag, ExifValue) -decodeEntry byteAlign tiffHeaderStart location entry = do - let exifTag = getExifTag location $ entryTag entry - let contentsInt = fromIntegral $ toInteger $ entryContents entry - -- because I only know how to skip ahead, I hope the entries - -- are always sorted in order of the offsets to their values... - -- (maybe lookAhead could help here?) - tagValue <- case getHandler $ entryFormat entry of - Just handler -> decodeEntryWithHandler byteAlign tiffHeaderStart handler entry - Nothing -> return $ ExifUnknown (entryFormat entry) (entryNoComponents entry) contentsInt - return (exifTag, tagValue) +decodeEntry :: ByteAlign -> Word16 -> Int -> Word32 -> Get ExifValue +decodeEntry byteAlign format amount payload = do + case getHandler format of + Just handler | isInline handler -> return $ parseInline byteAlign handler amount (runPut $ putWord32 byteAlign payload) + Just handler -> parseOffset byteAlign handler amount payload + Nothing -> return $ ExifUnknown format amount (fromIntegral payload) + where + isInline handler = dataLength handler * amount <= 4 getHandler :: Word16 -> Maybe ValueHandler getHandler typeId = find ((==typeId) . dataTypeId) valueHandlers -decodeEntryWithHandler :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue -decodeEntryWithHandler byteAlign tiffHeaderStart handler entry = - if dataLength handler * entryNoComponents entry <= 4 - then do - let inlineBs = runPut $ putWord32 byteAlign $ entryContents entry - return $ parseInline byteAlign handler entry inlineBs - else parseOffset byteAlign tiffHeaderStart handler entry - -parseInline :: ByteAlign -> ValueHandler -> IfEntry -> B.ByteString -> ExifValue -parseInline byteAlign handler entry bytestring = +parseInline :: ByteAlign -> ValueHandler -> Int -> B.ByteString -> ExifValue +parseInline byteAlign handler amount bytestring = fromJust $ runMaybeGet getter bytestring where - getter = case entryNoComponents entry of + getter = case amount of 1 -> readSingle handler byteAlign - _ -> readMany handler byteAlign $ entryNoComponents entry + _ -> readMany handler byteAlign amount -parseOffset :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue -parseOffset byteAlign tiffHeaderStart handler entry = do - let contentsInt = fromIntegral $ toInteger $ entryContents entry - curPos <- fromIntegral <$> bytesRead +parseOffset :: ByteAlign -> ValueHandler -> Int -> Word32 -> Get ExifValue +parseOffset byteAlign handler amount offset = do -- this skip can take me quite far and I can't skip -- back with binary. So do the skip with a lookAhead. -- see https://github.com/emmanueltouzery/hsexif/issues/9 lookAhead $ do - skip (contentsInt + tiffHeaderStart - curPos) - let bsLength = entryNoComponents entry * dataLength handler + skip (fromIntegral offset) + let bsLength = amount * dataLength handler bytestring <- getLazyByteString (fromIntegral bsLength) - return (parseInline byteAlign handler entry bytestring) + return (parseInline byteAlign handler amount bytestring) signedInt32ToInt :: Word32 -> Int signedInt32ToInt w = fromIntegral (fromIntegral w :: Int32) diff --git a/hsexif.cabal b/hsexif.cabal --- a/hsexif.cabal +++ b/hsexif.cabal @@ -1,5 +1,5 @@ name: hsexif -version: 0.6.1.6 +version: 0.6.1.7 synopsis: EXIF handling library in pure Haskell description: The hsexif library provides functions for working with EXIF data contained in JPEG files. Currently it only supports reading the data. diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -55,6 +55,21 @@ describe "partial exif data" $ testPartialExif partial describe "tiff file" $ testNef tiffExifData + describe "unusual data layouts" $ do + it "parses EXIF below IDF0" $ do + result <- parseFileExif "tests/test-exif-below-idf0.jpg" + case result of + Left err -> assertBool ("Cannot parse: " ++ err) False + Right tags -> do + (Map.lookup dateTimeOriginal tags) `assertEqual'` (Just $ ExifText "2013:10:02 20:33:33") + it "xmp block before the exif" $ do + result <- parseFileExif "tests/xmp-before-exif-truncated.jpg" -- the file is truncated. original is at: https://github.com/emmanueltouzery/hsexif/issues/17 + case result of + Left err -> assertBool ("Cannot parse: " ++ err) False + Right tags -> do + (Map.lookup dateTimeOriginal tags) `assertEqual'` (Just $ ExifText "2020:03:04 17:14:20") + + testNotAJpeg :: B.ByteString -> Spec testNotAJpeg imageContents = it "returns empty list if not a JPEG" $ assertEqual' (Left "Not a JPEG, TIFF, RAF, or TIFF-based raw file") (parseExif imageContents) @@ -112,7 +127,6 @@ (dateTime, ExifText "2014:04:10 20:14:20"), (yCbCrPositioning, ExifNumber 2), (fileSource, ExifUndefined "\ETX"), - (exifIfdOffset, ExifNumber 358), (printImageMatching, ExifUndefined "PrintIM\NUL0300\NUL\NUL\ETX\NUL\STX\NUL\SOH\NUL\NUL\NUL\ETX\NUL\"\NUL\NUL\NUL\SOH\SOH\NUL\NUL\NUL\NUL\t\DC1\NUL\NUL\DLE'\NUL\NUL\v\SI\NUL\NUL\DLE'\NUL\NUL\151\ENQ\NUL\NUL\DLE'\NUL\NUL\176\b\NUL\NUL\DLE'\NUL\NUL\SOH\FS\NUL\NUL\DLE'\NUL\NUL^\STX\NUL\NUL\DLE'\NUL\NUL\139\NUL\NUL\NUL\DLE'\NUL\NUL\203\ETX\NUL\NUL\DLE'\NUL\NUL\229\ESC\NUL\NUL\DLE'\NUL\NUL") ]) (sort cleanedParsed) -- the sony maker note is 35k!! Just test its size and that it starts with "SONY DSC". @@ -276,7 +290,6 @@ (ExifTag IFD0 Nothing 0x14a (T.pack . show), ExifNumber 58880), (referenceBlackWhite, ExifRationalList [(0,1),(255,1),(0,1),(255,1),(0,1),(255,1)]), (copyright, ExifText "Copyright,NIKON CORPORATION,1999\0"), - (exifIfdOffset, ExifNumber 528), (ExifTag IFD0 Nothing 0x9003 (T.pack . show), ExifText "2000:11:19 13:01:50"), (ExifTag IFD0 Nothing 0x9216 (T.pack . show), ExifNumberList [1,0,0,0]) ]) diff --git a/tests/test-exif-below-idf0.jpg b/tests/test-exif-below-idf0.jpg new file mode 100644 Binary files /dev/null and b/tests/test-exif-below-idf0.jpg differ diff --git a/tests/xmp-before-exif-truncated.jpg b/tests/xmp-before-exif-truncated.jpg new file mode 100644 Binary files /dev/null and b/tests/xmp-before-exif-truncated.jpg differ