mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-11-30 12:53:11 +03:00
401 lines
11 KiB
Haskell
401 lines
11 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module NixDaemonSpec
|
|
( enterNamespaces
|
|
, spec
|
|
) where
|
|
|
|
import Control.Monad (forM_, unless, void)
|
|
import Control.Monad.Catch (MonadMask)
|
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
|
import Crypto.Hash (SHA256)
|
|
import Data.Some (Some(Some))
|
|
import Data.Text (Text)
|
|
import Test.Hspec (Spec, SpecWith, around, describe, context)
|
|
import Test.Hspec.Expectations.Lifted
|
|
import Test.Hspec.Nix (forceRight)
|
|
import System.FilePath ((</>))
|
|
import System.Linux.Namespaces (Namespace(..), GroupMapping(..), UserMapping(..))
|
|
import System.Nix.Hash (HashAlgo(HashAlgo_SHA256))
|
|
import System.Nix.Build (BuildMode(..))
|
|
import System.Nix.DerivedPath (DerivedPath(..))
|
|
import System.Nix.StorePath (StoreDir(..), StorePath)
|
|
import System.Nix.StorePath.Metadata (Metadata(..))
|
|
import System.Nix.Store.Remote
|
|
import System.Process (CreateProcess(..), ProcessHandle)
|
|
import qualified Control.Concurrent
|
|
import qualified Control.Exception
|
|
import qualified Data.ByteString.Char8
|
|
import qualified Data.Either
|
|
import qualified Data.HashSet
|
|
import qualified Data.Map
|
|
import qualified Data.Set
|
|
import qualified Data.Text
|
|
import qualified Data.Text.Encoding
|
|
import qualified System.Directory
|
|
import qualified System.Environment
|
|
import qualified System.IO.Temp
|
|
import qualified System.Linux.Namespaces
|
|
import qualified System.Nix.StorePath
|
|
import qualified System.Nix.Nar
|
|
import qualified System.Posix.User
|
|
import qualified System.Process
|
|
import qualified Test.Hspec
|
|
|
|
createProcessEnv
|
|
:: FilePath
|
|
-> String
|
|
-> [String]
|
|
-> IO ProcessHandle
|
|
createProcessEnv fp proc args = do
|
|
mPath <- System.Environment.lookupEnv "PATH"
|
|
|
|
(_, _, _, ph) <-
|
|
System.Process.createProcess (System.Process.proc proc args)
|
|
{ cwd = Just fp
|
|
, env = Just $ mockedEnv mPath fp
|
|
}
|
|
pure ph
|
|
|
|
mockedEnv
|
|
:: Maybe String
|
|
-> FilePath
|
|
-> [(String, FilePath)]
|
|
mockedEnv mEnvPath fp =
|
|
[ ("NIX_STORE_DIR" , fp </> "store")
|
|
, ("NIX_LOCALSTATE_DIR", fp </> "var")
|
|
, ("NIX_LOG_DIR" , fp </> "var" </> "log")
|
|
, ("NIX_STATE_DIR" , fp </> "var" </> "nix")
|
|
, ("NIX_CONF_DIR" , fp </> "etc")
|
|
, ("HOME" , fp </> "home")
|
|
-- , ("NIX_REMOTE", "daemon")
|
|
] <> foldMap (\x -> [("PATH", x)]) mEnvPath
|
|
|
|
waitSocket
|
|
:: FilePath
|
|
-> Int
|
|
-> IO ()
|
|
waitSocket _ 0 = fail "No socket"
|
|
waitSocket fp x = do
|
|
ex <- System.Directory.doesFileExist fp
|
|
unless ex $ do
|
|
Control.Concurrent.threadDelay 100000
|
|
waitSocket fp (x - 1)
|
|
|
|
writeConf :: FilePath -> IO ()
|
|
writeConf fp =
|
|
writeFile fp $ unlines
|
|
[ "build-users-group = "
|
|
, "trusted-users = root"
|
|
, "allowed-users = *"
|
|
, "fsync-metadata = false"
|
|
]
|
|
|
|
{-
|
|
- we run in user namespace as root but groups are failed
|
|
- => build-users-group has to be empty but we still
|
|
- get an error (maybe older nix-daemon)
|
|
-
|
|
uid=0(root) gid=65534(nobody) groups=65534(nobody)
|
|
|
|
drwxr-xr-x 3 0 65534 60 Nov 29 05:53 store
|
|
|
|
accepted connection from pid 22959, user root (trusted)
|
|
error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e5616122/store': Invalid argument
|
|
-}
|
|
|
|
startDaemon
|
|
:: ( MonadIO m
|
|
, MonadMask m
|
|
)
|
|
=> FilePath
|
|
-> IO (ProcessHandle, RemoteStoreT m a -> Run m a)
|
|
startDaemon fp = do
|
|
writeConf (fp </> "etc" </> "nix.conf")
|
|
procHandle <- createProcessEnv fp "nix-daemon" []
|
|
waitSocket sockFp 30
|
|
pure ( procHandle
|
|
, runStoreOpts sockFp
|
|
. (setStoreDir (StoreDir $ Data.ByteString.Char8.pack $ fp </> "store")
|
|
>>
|
|
)
|
|
)
|
|
where
|
|
sockFp = fp </> "var/nix/daemon-socket/socket"
|
|
|
|
enterNamespaces :: IO ()
|
|
enterNamespaces = do
|
|
uid <- System.Posix.User.getEffectiveUserID
|
|
gid <- System.Posix.User.getEffectiveGroupID
|
|
|
|
System.Linux.Namespaces.unshare
|
|
[User, Network, Mount]
|
|
|
|
-- fmap our (parent) uid to root
|
|
System.Linux.Namespaces.writeUserMappings
|
|
Nothing
|
|
[ UserMapping
|
|
0 -- inside namespace
|
|
uid -- outside namespace
|
|
1 --range
|
|
]
|
|
|
|
-- fmap our (parent) gid to root group
|
|
System.Linux.Namespaces.writeGroupMappings
|
|
Nothing
|
|
[ GroupMapping 0 gid 1 ]
|
|
True
|
|
|
|
withNixDaemon
|
|
:: ( MonadIO m
|
|
, MonadMask m
|
|
)
|
|
=> ((RemoteStoreT m a -> Run m a) -> IO a)
|
|
-> IO a
|
|
withNixDaemon action =
|
|
System.IO.Temp.withSystemTempDirectory "test-nix-store" $ \path -> do
|
|
|
|
mapM_ (System.Directory.createDirectory . snd)
|
|
(filter
|
|
((/= "NIX_REMOTE") . fst)
|
|
$ mockedEnv Nothing path)
|
|
|
|
ini <- createProcessEnv path "nix-store" ["--init"]
|
|
void $ System.Process.waitForProcess ini
|
|
|
|
writeFile (path </> "dummy") "Hello World"
|
|
|
|
System.Directory.setCurrentDirectory path
|
|
|
|
Control.Exception.bracket
|
|
(startDaemon path)
|
|
(System.Process.terminateProcess . fst)
|
|
(action . snd)
|
|
|
|
checks
|
|
:: ( Show a
|
|
, Show b
|
|
)
|
|
=> IO (a, b)
|
|
-> (a -> Bool)
|
|
-> IO ()
|
|
checks action check =
|
|
action >>= (`Test.Hspec.shouldSatisfy` (check . fst))
|
|
|
|
it
|
|
:: (Show a, Show b, Monad m)
|
|
=> String
|
|
-> m c
|
|
-> (a -> Bool)
|
|
-> SpecWith (m () -> IO (a, b))
|
|
it name action check =
|
|
Test.Hspec.it name $ \run -> run (void $ action) `checks` check
|
|
|
|
itRights
|
|
:: ( Show a
|
|
, Show b
|
|
, Show c
|
|
, Monad m
|
|
)
|
|
=> String
|
|
-> m d
|
|
-> SpecWith (m () -> IO (Either a b, c))
|
|
itRights name action = it name action Data.Either.isRight
|
|
|
|
itLefts
|
|
:: ( Show a
|
|
, Show b
|
|
, Show c
|
|
, Monad m
|
|
)
|
|
=> String
|
|
-> m d
|
|
-> SpecWith (m () -> IO (Either a b, c))
|
|
itLefts name action = it name action Data.Either.isLeft
|
|
|
|
withPath
|
|
:: MonadRemoteStore m
|
|
=> (StorePath -> m a)
|
|
-> m a
|
|
withPath action = do
|
|
path <-
|
|
addTextToStore
|
|
(StoreText
|
|
(forceRight $ System.Nix.StorePath.mkStorePathName "hnix-store")
|
|
"test"
|
|
)
|
|
mempty
|
|
RepairMode_DontRepair
|
|
action path
|
|
|
|
-- | dummy path, adds <tmp>/dummy with "Hello World" contents
|
|
dummy :: MonadRemoteStore m => m StorePath
|
|
dummy = do
|
|
addToStore
|
|
(forceRight $ System.Nix.StorePath.mkStorePathName "dummy")
|
|
(System.Nix.Nar.dumpPath "dummy")
|
|
FileIngestionMethod_Flat
|
|
(Some HashAlgo_SHA256)
|
|
RepairMode_DontRepair
|
|
|
|
invalidPath :: StorePath
|
|
invalidPath =
|
|
let name = forceRight $ System.Nix.StorePath.mkStorePathName "invalid"
|
|
in System.Nix.StorePath.unsafeMakeStorePath
|
|
(System.Nix.StorePath.mkStorePathHashPart
|
|
@SHA256
|
|
"invalid")
|
|
name
|
|
|
|
_withBuilder
|
|
:: MonadRemoteStore m
|
|
=> (StorePath -> m a)
|
|
-> m a
|
|
_withBuilder action = do
|
|
path <-
|
|
addTextToStore
|
|
(StoreText (forceRight $ System.Nix.StorePath.mkStorePathName "builder") builderSh)
|
|
mempty
|
|
RepairMode_DontRepair
|
|
action path
|
|
|
|
builderSh :: Text
|
|
builderSh = "declare -xpexport > $out"
|
|
|
|
spec :: Spec
|
|
spec = around withNixDaemon $
|
|
|
|
describe "store" $ do
|
|
|
|
context "syncWithGC" $
|
|
itRights "syncs with garbage collector" syncWithGC
|
|
|
|
context "verifyStore" $ do
|
|
itRights "check=False repair=False" $
|
|
verifyStore
|
|
CheckMode_DontCheck
|
|
RepairMode_DontRepair
|
|
`shouldReturn` False
|
|
|
|
itRights "check=True repair=False" $
|
|
verifyStore
|
|
CheckMode_DoCheck
|
|
RepairMode_DontRepair
|
|
`shouldReturn` False
|
|
|
|
--privileged
|
|
itRights "check=True repair=True" $
|
|
verifyStore
|
|
CheckMode_DoCheck
|
|
RepairMode_DoRepair
|
|
`shouldReturn` False
|
|
|
|
context "addTextToStore" $
|
|
itRights "adds text to store" $ withPath pure
|
|
|
|
context "isValidPath" $ do
|
|
itRights "validates path" $ withPath $ \path -> do
|
|
liftIO $ print path
|
|
isValidPath path `shouldReturn` True
|
|
itLefts "fails on invalid path" $ do
|
|
setStoreDir (StoreDir "/asdf")
|
|
isValidPath invalidPath
|
|
|
|
context "queryAllValidPaths" $ do
|
|
itRights "empty query" queryAllValidPaths
|
|
itRights "non-empty query" $ withPath $ \path ->
|
|
queryAllValidPaths `shouldReturn` Data.HashSet.fromList [path]
|
|
|
|
context "queryPathInfo" $
|
|
itRights "queries path info" $ withPath $ \path -> do
|
|
meta <- queryPathInfo path
|
|
(metadataReferences <$> meta) `shouldBe` (Just mempty)
|
|
|
|
context "ensurePath" $
|
|
itRights "simple ensure" $ withPath ensurePath
|
|
|
|
context "addTempRoot" $
|
|
itRights "simple addition" $ withPath addTempRoot
|
|
|
|
context "addIndirectRoot" $
|
|
itRights "simple addition" $ withPath addIndirectRoot
|
|
|
|
let toDerivedPathSet p = Data.Set.fromList [DerivedPath_Opaque p]
|
|
|
|
context "buildPaths" $ do
|
|
itRights "build Normal" $ withPath $ \path -> do
|
|
buildPaths (toDerivedPathSet path) BuildMode_Normal
|
|
|
|
itRights "build Check" $ withPath $ \path -> do
|
|
buildPaths (toDerivedPathSet path) BuildMode_Check
|
|
|
|
itLefts "build Repair" $ withPath $ \path -> do
|
|
buildPaths (toDerivedPathSet path) BuildMode_Repair
|
|
|
|
context "roots" $ context "findRoots" $ do
|
|
itRights "empty roots" (findRoots `shouldReturn` mempty)
|
|
|
|
itRights "path added as a temp root" $ withPath $ \_ -> do
|
|
roots <- findRoots
|
|
roots `shouldSatisfy` ((== 1) . Data.Map.size)
|
|
|
|
context "optimiseStore" $ itRights "optimises" optimiseStore
|
|
|
|
context "queryMissing" $
|
|
itRights "queries" $ withPath $ \path -> do
|
|
queryMissing (toDerivedPathSet path)
|
|
`shouldReturn`
|
|
Missing
|
|
{ missingWillBuild = mempty
|
|
, missingWillSubstitute = mempty
|
|
, missingUnknownPaths = mempty
|
|
, missingDownloadSize = 0
|
|
, missingNarSize = 0
|
|
}
|
|
|
|
context "addToStore" $
|
|
itRights "adds file to store" $ do
|
|
fp <-
|
|
liftIO
|
|
$ System.IO.Temp.writeSystemTempFile
|
|
"addition"
|
|
"yolo"
|
|
|
|
addToStore
|
|
(forceRight $ System.Nix.StorePath.mkStorePathName "tmp-addition")
|
|
(System.Nix.Nar.dumpPath fp)
|
|
FileIngestionMethod_Flat
|
|
(Some HashAlgo_SHA256)
|
|
RepairMode_DontRepair
|
|
|
|
context "with dummy" $ do
|
|
itRights "adds dummy" dummy
|
|
|
|
itRights "valid dummy" $ do
|
|
path <- dummy
|
|
isValidPath path `shouldReturn` True
|
|
|
|
context "collectGarbage" $ do
|
|
itRights "delete a specific path from the store" $ withPath $ \path -> do
|
|
-- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
|
|
storeDir <- getStoreDir
|
|
let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
|
|
tempRootList <-
|
|
liftIO
|
|
$ System.Directory.listDirectory
|
|
tempRootsDir
|
|
liftIO $ forM_ tempRootList $ \entry -> do
|
|
System.Directory.removeFile
|
|
$ mconcat [ tempRootsDir, "/", entry ]
|
|
|
|
GCResult{..} <-
|
|
collectGarbage
|
|
GCOptions
|
|
{ gcOptionsOperation = GCAction_DeleteSpecific
|
|
, gcOptionsIgnoreLiveness = False
|
|
, gcOptionsPathsToDelete = Data.HashSet.fromList [path]
|
|
, gcOptionsMaxFreed = maxBound
|
|
}
|
|
gcResultDeletedPaths `shouldBe` Data.HashSet.fromList [path]
|
|
gcResultBytesFreed `shouldBe` 4
|