hsexif 0.6.1.6 → 0.6.1.7

raw patch · 6 files changed

+74/−96 lines, 6 filesdep ~basebinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Graphics/ExifTags.hs +1/−3
• Graphics/HsExif.hs +57/−90
• hsexif.cabal +1/−1
• tests/Tests.hs +15/−2
• tests/test-exif-below-idf0.jpg binary
• tests/xmp-before-exif-truncated.jpg binary

@@ -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,

@@ -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)

@@ -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.

@@ -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])               ])

binary file changed (absent → 38580 bytes)

binary file changed (absent → 8192 bytes)