mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
Merge pull request #259 from haskell-nix/nar-is-exec
Replace permissions with `narIsExec` effect
This commit is contained in:
commit
48b4891693
@ -3,11 +3,13 @@
|
||||
module System.Nix.Nar.Effects
|
||||
( NarEffects(..)
|
||||
, narEffectsIO
|
||||
, IsExecutable(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Bool (bool)
|
||||
import Data.Int (Int64)
|
||||
import Data.Kind (Type)
|
||||
import System.IO (Handle, IOMode(WriteMode))
|
||||
@ -25,15 +27,17 @@ import System.Posix.Files ( createSymbolicLink
|
||||
import qualified System.IO as IO
|
||||
import qualified Control.Exception.Lifted as Exception.Lifted
|
||||
|
||||
data IsExecutable = NonExecutable | Executable
|
||||
deriving (Eq, Show)
|
||||
|
||||
data NarEffects (m :: Type -> Type) = NarEffects {
|
||||
narReadFile :: FilePath -> m Bytes.Lazy.ByteString
|
||||
, narWriteFile :: FilePath -> Bytes.Lazy.ByteString -> m ()
|
||||
, narStreamFile :: FilePath -> m (Maybe ByteString) -> m ()
|
||||
, narWriteFile :: FilePath -> IsExecutable -> Bytes.Lazy.ByteString -> m ()
|
||||
, narStreamFile :: FilePath -> IsExecutable -> m (Maybe ByteString) -> m ()
|
||||
, narListDir :: FilePath -> m [FilePath]
|
||||
, narCreateDir :: FilePath -> m ()
|
||||
, narCreateLink :: FilePath -> FilePath -> m ()
|
||||
, narGetPerms :: FilePath -> m Directory.Permissions
|
||||
, narSetPerms :: FilePath -> Directory.Permissions -> m ()
|
||||
, narIsExec :: FilePath -> m IsExecutable
|
||||
, narIsDir :: FilePath -> m Bool
|
||||
, narIsSymLink :: FilePath -> m Bool
|
||||
, narFileSize :: FilePath -> m Int64
|
||||
@ -53,13 +57,15 @@ narEffectsIO
|
||||
=> NarEffects m
|
||||
narEffectsIO = NarEffects {
|
||||
narReadFile = liftIO . Bytes.Lazy.readFile
|
||||
, narWriteFile = \a -> liftIO . Bytes.Lazy.writeFile a
|
||||
, narWriteFile = \f e c -> liftIO $ do
|
||||
Bytes.Lazy.writeFile f c
|
||||
p <- Directory.getPermissions f
|
||||
Directory.setPermissions f (p { Directory.executable = e == Executable })
|
||||
, narStreamFile = streamStringOutIO
|
||||
, narListDir = liftIO . Directory.listDirectory
|
||||
, narCreateDir = liftIO . Directory.createDirectory
|
||||
, narCreateLink = \f -> liftIO . createSymbolicLink f
|
||||
, narGetPerms = liftIO . Directory.getPermissions
|
||||
, narSetPerms = \f -> liftIO . Directory.setPermissions f
|
||||
, narIsExec = liftIO . (fmap (bool NonExecutable Executable . Directory.executable)) . Directory.getPermissions
|
||||
, narIsDir = fmap isDirectory . liftIO . getFileStatus
|
||||
, narIsSymLink = liftIO . Directory.pathIsSymbolicLink
|
||||
, narFileSize = fmap (fromIntegral . fileSize) . liftIO . getFileStatus
|
||||
@ -76,9 +82,10 @@ streamStringOutIO
|
||||
, MonadBaseControl IO m
|
||||
)
|
||||
=> FilePath
|
||||
-> IsExecutable
|
||||
-> m (Maybe ByteString)
|
||||
-> m ()
|
||||
streamStringOutIO f getChunk =
|
||||
streamStringOutIO f executable getChunk =
|
||||
Exception.Lifted.bracket
|
||||
(liftIO $ IO.openFile f WriteMode)
|
||||
(liftIO . IO.hClose)
|
||||
@ -93,6 +100,9 @@ streamStringOutIO f getChunk =
|
||||
Nothing -> pure ()
|
||||
Just c -> do
|
||||
liftIO $ Data.ByteString.hPut handle c
|
||||
Control.Monad.when (executable == Executable) $ liftIO $ do
|
||||
p <- Directory.getPermissions f
|
||||
Directory.setPermissions f (p { Directory.executable = True })
|
||||
go handle
|
||||
cleanupException (e :: Exception.Lifted.SomeException) = do
|
||||
liftIO $ Directory.removeFile f
|
||||
|
@ -268,13 +268,8 @@ parseFile = do
|
||||
|
||||
target <- currentFile
|
||||
streamFile <- getNarEffect Nar.narStreamFile
|
||||
Trans.lift (streamFile target getChunk)
|
||||
|
||||
when (s == "executable") $ do
|
||||
effs :: Nar.NarEffects m <- getNarEffects
|
||||
Trans.lift $ do
|
||||
p <- Nar.narGetPerms effs target
|
||||
Nar.narSetPerms effs target (p { Directory.executable = True })
|
||||
let isExecutable = bool Nar.NonExecutable Nar.Executable (s == "executable")
|
||||
Trans.lift (streamFile target isExecutable getChunk)
|
||||
|
||||
expectRawString (Bytes.replicate (padLen $ fromIntegral fSize) 0)
|
||||
|
||||
|
@ -7,7 +7,7 @@ module System.Nix.Nar.Streamer
|
||||
, dumpPath
|
||||
, streamNarIO
|
||||
, streamNarIOWithOptions
|
||||
, IsExecutable(..)
|
||||
, Nar.IsExecutable(..)
|
||||
) where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
@ -18,7 +18,6 @@ import Control.Monad ( forM_
|
||||
, when
|
||||
)
|
||||
import qualified Control.Monad.IO.Class as IO
|
||||
import Data.Bool ( bool )
|
||||
import qualified Data.ByteString as Bytes
|
||||
import qualified Data.ByteString.Lazy as Bytes.Lazy
|
||||
import qualified Data.Foldable
|
||||
@ -26,7 +25,6 @@ import qualified Data.List
|
||||
import qualified Data.Serialize as Serial
|
||||
import qualified Data.Text as T (pack, breakOn)
|
||||
import qualified Data.Text.Encoding as TE (encodeUtf8)
|
||||
import qualified System.Directory as Directory
|
||||
import System.FilePath ((</>))
|
||||
|
||||
import qualified System.Nix.Nar.Effects as Nar
|
||||
@ -107,9 +105,9 @@ streamNarIOWithOptions opts effs basePath yield = do
|
||||
yield $ strs ["name", serializedPath, "node"]
|
||||
parens $ go fullName
|
||||
else do
|
||||
isExec <- IO.liftIO $ isExecutable effs path
|
||||
isExec <- IO.liftIO $ Nar.narIsExec effs path
|
||||
yield $ strs ["type", "regular"]
|
||||
when (isExec == Executable) $ yield $ strs ["executable", ""]
|
||||
when (isExec == Nar.Executable) $ yield $ strs ["executable", ""]
|
||||
fSize <- IO.liftIO $ Nar.narFileSize effs path
|
||||
yield $ str "contents"
|
||||
yield $ int fSize
|
||||
@ -127,20 +125,6 @@ streamNarIOWithOptions opts effs basePath yield = do
|
||||
mapM_ yield . Bytes.Lazy.toChunks =<< IO.liftIO (Nar.narReadFile effs path)
|
||||
yield $ Bytes.replicate (padLen $ fromIntegral fsize) 0
|
||||
|
||||
data IsExecutable = NonExecutable | Executable
|
||||
deriving (Eq, Show)
|
||||
|
||||
isExecutable
|
||||
:: Functor m
|
||||
=> Nar.NarEffects m
|
||||
-> FilePath
|
||||
-> m IsExecutable
|
||||
isExecutable effs fp =
|
||||
bool
|
||||
NonExecutable
|
||||
Executable
|
||||
. Directory.executable <$> Nar.narGetPerms effs fp
|
||||
|
||||
-- | Distance to the next multiple of 8
|
||||
padLen :: Int -> Int
|
||||
padLen n = (8 - n) `mod` 8
|
||||
|
Loading…
Reference in New Issue
Block a user