diff --git a/CHANGELOG.md b/CHANGELOG.md index dcb2783..644525a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## Zip 1.2.0 + +* Added the `setExternalFileAttrs` function and the `edExternalFileAttrs` + field in the `EntryDescription` record. + ## Zip 1.1.0 * Made `saveEntry` and `unpackInto` restore modification time of files. diff --git a/Codec/Archive/Zip.hs b/Codec/Archive/Zip.hs index 43bc3d9..ed93f4d 100644 --- a/Codec/Archive/Zip.hs +++ b/Codec/Archive/Zip.hs @@ -121,6 +121,7 @@ module Codec.Archive.Zip , setModTime , addExtraField , deleteExtraField + , setExternalFileAttrs , forEntries -- ** Operations on archive as a whole , setArchiveComment @@ -147,7 +148,7 @@ import Data.Sequence (Seq, (|>)) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Void -import Data.Word (Word16) +import Data.Word (Word16, Word32) import System.Directory import System.FilePath (()) import System.IO.Error (isDoesNotExistError) @@ -530,6 +531,17 @@ deleteExtraField -> ZipArchive () deleteExtraField n s = addPending (I.DeleteExtraField n s) +-- | Set external file attributes. +-- +-- @since 1.2.0 + +setExternalFileAttrs + :: Word32 -- ^ External file attributes + -> EntrySelector -- ^ Name of entry to modify + -> ZipArchive () +setExternalFileAttrs attrs s = + addPending (I.SetExternalFileAttributes attrs s) + -- | Perform an action on every entry in the archive. forEntries diff --git a/Codec/Archive/Zip/Internal.hs b/Codec/Archive/Zip/Internal.hs index 60d2aae..e87e44c 100644 --- a/Codec/Archive/Zip/Internal.hs +++ b/Codec/Archive/Zip/Internal.hs @@ -98,6 +98,8 @@ data PendingAction -- ^ Set comment for entire archive | DeleteArchiveComment -- ^ Delete comment of entire archive + | SetExternalFileAttributes Word32 EntrySelector + -- ^ Set an external file attribute for specified entry -- | Collection of maps describing how to produce entries in resulting -- archive. @@ -116,7 +118,8 @@ data EditingActions = EditingActions , eaDeleteComment :: Map EntrySelector () , eaModTime :: Map EntrySelector UTCTime , eaExtraField :: Map EntrySelector (Map Word16 ByteString) - , eaDeleteField :: Map EntrySelector (Map Word16 ()) } + , eaDeleteField :: Map EntrySelector (Map Word16 ()) + , eaExtFileAttr :: Map EntrySelector Word32 } -- | Origin of entries that can be streamed into archive. @@ -312,7 +315,7 @@ optimize -> (ProducingActions, EditingActions) -- ^ Optimized data optimize = foldl' f ( ProducingActions M.empty M.empty - , EditingActions M.empty M.empty M.empty M.empty M.empty M.empty ) + , EditingActions M.empty M.empty M.empty M.empty M.empty M.empty M.empty) where f (pa, ea) a = case a of SinkEntry m src s -> @@ -357,6 +360,9 @@ optimize = foldl' f ( pa , ea { eaExtraField = M.alter (er n) s (eaExtraField ea) , eaDeleteField = M.alter (ef n ()) s (eaDeleteField ea) } ) + SetExternalFileAttributes b s -> + ( pa + , ea { eaExtFileAttr = M.insert s b (eaExtFileAttr ea) }) _ -> (pa, ea) clearEditingFor s ea = ea { eaCompression = M.delete s (eaCompression ea) @@ -364,7 +370,8 @@ optimize = foldl' f , eaDeleteComment = M.delete s (eaDeleteComment ea) , eaModTime = M.delete s (eaModTime ea) , eaExtraField = M.delete s (eaExtraField ea) - , eaDeleteField = M.delete s (eaDeleteField ea) } + , eaDeleteField = M.delete s (eaDeleteField ea) + , eaExtFileAttr = M.delete s (eaExtFileAttr ea) } re o n x = if x == o then n else x ef k v (Just m) = Just (M.insert k v m) ef k v Nothing = Just (M.singleton k v) @@ -415,6 +422,9 @@ sinkEntry h s o src EditingActions {..} = do modTime = case o of GenericOrigin -> currentTime Borrowed ed -> edModTime ed + extFileAttr = case o of + GenericOrigin -> M.findWithDefault 0 s eaExtFileAttr + Borrowed _ -> M.findWithDefault 0 s eaExtFileAttr oldExtraFields = case o of GenericOrigin -> M.empty Borrowed ed -> edExtraField ed @@ -435,7 +445,8 @@ sinkEntry h s o src EditingActions {..} = do , edUncompressedSize = 0 -- ↑ , edOffset = fromIntegral offset , edComment = M.lookup s eaEntryComment <|> oldComment - , edExtraField = extraField } + , edExtraField = extraField + , edExternalFileAttrs = extFileAttr } B.hPut h (runPut (putHeader LocalHeader s desc0)) DataDescriptor {..} <- C.runConduitRes $ if recompression @@ -574,7 +585,8 @@ getCDHeader = do fileNameSize <- getWord16le -- file name length extraFieldSize <- getWord16le -- extra field length commentSize <- getWord16le -- file comment size - skip 8 -- disk number start, internal/external file attributes + skip 4 -- disk number start, internal file attributes + externalFileAttrs <- getWord32le -- external file attributes offset <- fromIntegral <$> getWord32le -- offset of local header fileName <- decodeText needUnicode <$> getBytes (fromIntegral fileNameSize) -- file name @@ -603,7 +615,8 @@ getCDHeader = do , edUncompressedSize = z64efUncompressedSize z64ef , edOffset = z64efOffset z64ef , edComment = if commentSize == 0 then Nothing else comment - , edExtraField = extraField } + , edExtraField = extraField + , edExternalFileAttrs = externalFileAttrs } in return $ (,desc) <$> (fileName >>= mkEntrySelector . T.unpack) -- | Parse an extra-field. @@ -710,7 +723,7 @@ putHeader c' s EntryDescription {..} = do putWord16le (fromIntegral $ B.length comment) -- file comment length putWord16le 0 -- disk number start putWord16le 0 -- internal file attributes - putWord32le 0 -- external file attributes + putWord32le edExternalFileAttrs -- external file attributes putWord32le (withSaturation edOffset) -- relative offset of local header putByteString rawName -- file name (variable size) putByteString extraField -- extra field (variable size) @@ -916,6 +929,7 @@ targetEntry (DeleteEntryComment s) = Just s targetEntry (SetModTime _ s) = Just s targetEntry (AddExtraField _ _ s) = Just s targetEntry (DeleteExtraField _ s) = Just s +targetEntry (SetExternalFileAttributes _ s) = Just s targetEntry (SetArchiveComment _) = Nothing targetEntry DeleteArchiveComment = Nothing diff --git a/Codec/Archive/Zip/Type.hs b/Codec/Archive/Zip/Type.hs index 3a9a25d..80f1070 100644 --- a/Codec/Archive/Zip/Type.hs +++ b/Codec/Archive/Zip/Type.hs @@ -158,6 +158,9 @@ data EntryDescription = EntryDescription , edOffset :: Natural -- ^ Absolute offset of local file header , edComment :: Maybe Text -- ^ Entry comment , edExtraField :: Map Word16 ByteString -- ^ All extra fields found + , edExternalFileAttrs :: Word32 -- ^ External file attributes + -- + -- @since 1.2.0 } deriving (Eq, Typeable) -- | Supported compression methods. diff --git a/tests/Main.hs b/tests/Main.hs index c9f4be5..84cba21 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -67,6 +67,7 @@ main = hspec $ do describe "entry comment" entryCommentSpec describe "setModTime" setModTimeSpec describe "extra field" extraFieldSpec + describe "setExternalFileAttrsSpec" setExternalFileAttrsSpec describe "renameEntry" renameEntrySpec describe "deleteEntry" deleteEntrySpec describe "forEntries" forEntriesSpec @@ -124,6 +125,7 @@ instance Arbitrary EM where content <- arbitrary modTime <- arbitrary comment <- arbitrary + externalFileAttrs <- arbitrary extraFieldTag <- arbitrary `suchThat` (/= 1) extraFieldContent <- arbitrary `suchThat` ((< 0xffff) . B.length) let action = do @@ -131,6 +133,7 @@ instance Arbitrary EM where setModTime modTime s setEntryComment comment s addExtraField extraFieldTag extraFieldContent s + setExternalFileAttrs externalFileAttrs s return $ EM s EntryDescription { edVersionMadeBy = undefined , edVersionNeeded = undefined @@ -141,7 +144,8 @@ instance Arbitrary EM where , edUncompressedSize = fromIntegral (B.length content) , edOffset = undefined , edComment = Just comment - , edExtraField = M.singleton extraFieldTag extraFieldContent } + , edExtraField = M.singleton extraFieldTag extraFieldContent + , edExternalFileAttrs = externalFileAttrs } action data EC = EC (Map EntrySelector EntryDescription) (ZipArchive ()) deriving Show @@ -171,6 +175,7 @@ instance Show EntryDescription where "\n, edUncompressedSize = " ++ show (edUncompressedSize ed) ++ "\n, edComment = " ++ show (edComment ed) ++ "\n, edExtraField = " ++ show (edExtraField ed) ++ + "\n, edExtFileAttr = " ++ show (edExternalFileAttrs ed) ++ " }" instance Show (ZipArchive a) where @@ -529,6 +534,17 @@ extraFieldSpec = do M.lookup n . edExtraField . (! s) <$> getEntries efield `shouldBe` Nothing +setExternalFileAttrsSpec :: SpecWith FilePath +setExternalFileAttrsSpec = + context "when an external file attribute is added (after creation)" $ + it "sets a custom external file attribute" $ \path -> property $ \attr s -> do + attr' <- createArchive path $ do + addEntry Store "foo" s + setExternalFileAttrs attr s + commit + edExternalFileAttrs . (! s) <$> getEntries + attr' `shouldBe` attr + renameEntrySpec :: SpecWith FilePath renameEntrySpec = do context "when renaming after editing of new entry" $