Allow to manipulate external file attributes (#52)

This commit is contained in:
Ramakrishnan Muthukrishnan
2018-09-22 18:09:46 +05:30
committed by Mark Karpov
parent 1f9283d345
commit fe2e6cbc2d
5 changed files with 59 additions and 9 deletions
+5
View File
@@ -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.
+13 -1
View File
@@ -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
+21 -7
View File
@@ -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
+3
View File
@@ -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.
+17 -1
View File
@@ -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" $