Fine-grain NarEffects to the perms we care about.

This commit is contained in:
Shea Levy 2019-03-23 07:39:01 -04:00
parent f79ba0f8e0
commit e5f1c7d9bc
No known key found for this signature in database
GPG Key ID: 5C0BD6957D86FE27
2 changed files with 12 additions and 15 deletions

View File

@ -36,12 +36,11 @@ type RawFilePath = BS.ByteString
data NarEffects (m :: * -> *) = NarEffects { data NarEffects (m :: * -> *) = NarEffects {
narReadFile :: RawFilePath -> m BSL.ByteString narReadFile :: RawFilePath -> m BSL.ByteString
, narWriteFile :: RawFilePath -> BSL.ByteString -> m () , narWriteFile :: RawFilePath -> IsExecutable -> BSL.ByteString -> m ()
, narListDir :: RawFilePath -> m [FilePathPart] , narListDir :: RawFilePath -> m [FilePathPart]
, narCreateDir :: RawFilePath -> m () , narCreateDir :: RawFilePath -> m ()
, narCreateLink :: RawFilePath -> RawFilePath -> m () , narCreateLink :: RawFilePath -> RawFilePath -> m ()
, narGetPerms :: RawFilePath -> m Permissions , narIsExec :: RawFilePath -> m IsExecutable
, narSetPerms :: RawFilePath -> Permissions -> m ()
, narIsDir :: RawFilePath -> m Bool , narIsDir :: RawFilePath -> m Bool
, narIsSymLink :: RawFilePath -> m Bool , narIsSymLink :: RawFilePath -> m Bool
, narFileSize :: RawFilePath -> m Int64 , narFileSize :: RawFilePath -> m Int64
@ -214,10 +213,8 @@ localUnpackNar effs basePath (Nar fso) = localUnpackFSO basePath fso
localUnpackFSO basePath fso = case fso of localUnpackFSO basePath fso = case fso of
Regular isExec _ bs -> do Regular isExec _ bs ->
(narWriteFile effs) basePath bs (narWriteFile effs) basePath isExec bs
p <- narGetPerms effs basePath
(narSetPerms effs) basePath (p {executable = isExec == Executable})
SymLink targ -> narCreateLink effs targ basePath SymLink targ -> narCreateLink effs targ basePath
@ -237,14 +234,10 @@ localPackNar effs basePath = Nar <$> localPackFSO basePath
fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path' fType <- (,) <$> narIsDir effs path' <*> narIsSymLink effs path'
case fType of case fType of
(_, True) -> SymLink <$> narReadLink effs path' (_, True) -> SymLink <$> narReadLink effs path'
(False, _) -> Regular <$> isExecutable effs path' (False, _) -> Regular <$> narIsExec effs path'
<*> narFileSize effs path' <*> narFileSize effs path'
<*> narReadFile effs path' <*> narReadFile effs path'
(True , _) -> fmap (Directory . Map.fromList) $ do (True , _) -> fmap (Directory . Map.fromList) $ do
fs <- narListDir effs path' fs <- narListDir effs path'
forM fs $ \fp -> forM fs $ \fp ->
(fp,) <$> localPackFSO (BSC.concat [path', "/", unFilePathPart fp]) (fp,) <$> localPackFSO (BSC.concat [path', "/", unFilePathPart fp])
isExecutable :: Functor m => NarEffects m -> RawFilePath -> m IsExecutable
isExecutable effs fp =
bool NonExecutable Executable . executable <$> narGetPerms effs fp

View File

@ -36,17 +36,21 @@ import System.Nix.Nar
import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus, import System.Posix.Files (createSymbolicLink, fileSize, getFileStatus,
isDirectory, readSymbolicLink) isDirectory, readSymbolicLink)
import System.Directory import System.Directory
import Data.Bool (bool)
-- TODO: Move this to a unix-backed effects library -- TODO: Move this to a unix-backed effects library
narEffectsIO :: NarEffects IO narEffectsIO :: NarEffects IO
narEffectsIO = NarEffects { narEffectsIO = NarEffects {
narReadFile = BSL.readFile . BSC.unpack narReadFile = BSL.readFile . BSC.unpack
, narWriteFile = BSL.writeFile . BSC.unpack , narWriteFile = \f e c -> do
let f' = BSC.unpack f
BSL.writeFile f' c
p <- getPermissions f'
setPermissions f' (p { executable = e == Executable})
, narListDir = (fmap (map (FilePathPart . BSC.pack))) . listDirectory . BSC.unpack , narListDir = (fmap (map (FilePathPart . BSC.pack))) . listDirectory . BSC.unpack
, narCreateDir = createDirectory . BSC.unpack , narCreateDir = createDirectory . BSC.unpack
, narCreateLink = (. BSC.unpack) . createSymbolicLink . BSC.unpack , narCreateLink = (. BSC.unpack) . createSymbolicLink . BSC.unpack
, narGetPerms = getPermissions . BSC.unpack , narIsExec = (fmap (bool NonExecutable Executable . executable)) . getPermissions . BSC.unpack
, narSetPerms = setPermissions . BSC.unpack
, narIsDir = fmap isDirectory <$> getFileStatus . BSC.unpack , narIsDir = fmap isDirectory <$> getFileStatus . BSC.unpack
, narIsSymLink = pathIsSymbolicLink . BSC.unpack , narIsSymLink = pathIsSymbolicLink . BSC.unpack
, narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus . BSC.unpack , narFileSize = fmap (fromIntegral . fileSize) <$> getFileStatus . BSC.unpack