mirror of
https://github.com/simplex-chat/zip.git
synced 2026-06-03 09:17:33 +00:00
Allow to manipulate external file attributes (#52)
This commit is contained in:
committed by
Mark Karpov
parent
1f9283d345
commit
fe2e6cbc2d
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
@@ -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" $
|
||||
|
||||
Reference in New Issue
Block a user