{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module NixDaemon where import Prelude import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Exception (bracket) import Control.Concurrent (threadDelay) import Data.Either (isRight, isLeft, fromRight) import Data.Binary.Put import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.Lazy as B64 import qualified Data.ByteString.Lazy as BSL import Data.Monoid ((<>)) import Data.Maybe (fromJust) import Data.Proxy import Data.Time import qualified Data.Text as T import qualified Data.Text.Lazy.Builder import qualified Data.HashSet as HS import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Vector as V import System.Directory import qualified System.Environment import System.IO.Temp import qualified System.IO as IO (hGetContents, hPutStr, openFile) import qualified System.Process as P import System.Posix.User as U import System.Linux.Namespaces as NS import Test.Tasty as T import Test.Tasty.Hspec (Spec, HasCallStack, describe, context) import qualified Test.Tasty.Hspec as Hspec import Test.Hspec.Expectations.Lifted import qualified Test.Tasty.HUnit as HU import Test.Tasty.QuickCheck import Text.Read (readMaybe) import System.FilePath import System.Nix.Build import System.Nix.Hash import System.Nix.StorePath import System.Nix.ReadonlyStore import System.Nix.Nar import qualified System.Nix.StorePathMetadata as VP import System.Nix.Store.Remote import System.Nix.Store.Remote.Logger import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Protocol import System.Nix.Store.Remote.Util import Derivation createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle createProcessEnv fp proc args = do mPath <- System.Environment.lookupEnv "PATH" (_, _, _, ph) <- P.createProcess (P.proc proc args) { P.cwd = Just $ fp , P.env = Just $ mockedEnv mPath fp } return ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] mockedEnv mEnvPath fp = map (\(a, b) -> (a, b)) [ ("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") -- , ("NIX_REMOTE", "daemon") ] ++ (maybe [] (\x -> [("PATH", x)]) mEnvPath) waitSocket :: FilePath -> Int -> IO () waitSocket fp 0 = fail "No socket" waitSocket fp x = do ex <- doesFileExist fp case ex of True -> return () False -> threadDelay 100000 >> waitSocket fp (x - 1) writeConf fp = do 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 :: FilePath -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger])) startDaemon fp = do writeConf (fp "etc" "nix.conf") p <- createProcessEnv fp "nix-daemon" [] waitSocket sockFp 30 return (p, runStoreOpts sockFp (fp "store")) where sockFp = fp "var/nix/daemon-socket/socket" enterNamespaces = do uid <- getEffectiveUserID gid <- getEffectiveGroupID unshare [User, Network, Mount] -- map our (parent) uid to root writeUserMappings Nothing [UserMapping 0 uid 1] -- map our (parent) gid to root group writeGroupMappings Nothing [GroupMapping 0 gid 1] True withNixDaemon action = do withSystemTempDirectory "test-nix-store" $ \path -> do mapM_ (createDirectory . snd) (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv Nothing path) ini <- createProcessEnv path "nix-store" ["--init"] P.waitForProcess ini writeFile (path "dummy") "Hello World" setCurrentDirectory path bracket (startDaemon path) (P.terminateProcess . fst) (\x -> action . snd $ x) checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst)) it name action check = Hspec.it name $ \run -> (run (action >> return ())) `checks` check itRights name action = it name action isRight itLefts name action = it name action isLeft withPath action = do path <- addTextToStore "hnix-store" "test" (HS.fromList []) False action path -- | dummy path, adds /dummpy with "Hello World" contents dummy = do let Right n = makeStorePathName "dummy" res <- addToStore @SHA256 n "dummy" False (pure True) False return res invalidPath :: StorePath invalidPath = let Right n = makeStorePathName "invalid" in StorePath (hash "invalid") n "no_such_root" withBuilder action = do path <- addTextToStore "builder" builderSh (HS.fromList []) False action path builderSh = T.concat [ "declare -xp", "export > $out" ] spec_protocol :: Spec spec_protocol = Hspec.around withNixDaemon $ do describe "store" $ do context "syncWithGC" $ do itRights "syncs with garbage collector" syncWithGC context "verifyStore" $ do itRights "check=False repair=False" $ do verifyStore False False `shouldReturn` False itRights "check=True repair=False" $ do verifyStore True False `shouldReturn` False --privileged itRights "check=True repair=True" $ do verifyStore True True `shouldReturn` False context "addTextToStore" $ do itRights "adds text to store" $ withPath $ const return () context "isValidPathUncached" $ do itRights "validates path" $ withPath $ \path -> do liftIO $ putStrLn $ show path (isValidPathUncached path) `shouldReturn` True itLefts "fails on invalid path" $ isValidPathUncached $ invalidPath context "queryAllValidPaths" $ do itRights "empty query" $ queryAllValidPaths itRights "non-empty query" $ withPath $ \path -> queryAllValidPaths `shouldReturn` (HS.fromList [path]) context "queryPathInfoUncached" $ do itRights "queries path info" $ withPath $ queryPathInfoUncached context "ensurePath" $ do itRights "simple ensure" $ withPath $ ensurePath context "addTempRoot" $ do itRights "simple addition" $ withPath $ addTempRoot context "addIndirectRoot" $ do itRights "simple addition" $ withPath $ addIndirectRoot context "buildPaths" $ do itRights "build Normal" $ withPath $ \path -> do let pathSet = HS.fromList [path] buildPaths pathSet Normal itRights "build Check" $ withPath $ \path -> do let pathSet = HS.fromList [path] buildPaths pathSet Check itLefts "build Repair" $ withPath $ \path -> do let pathSet = HS.fromList [path] buildPaths pathSet Repair context "roots" $ do context "findRoots" $ do itRights "empty roots" $ (findRoots `shouldReturn` M.empty) itRights "path added as a temp root" $ withPath $ \path -> do roots <- findRoots roots `shouldSatisfy` ((==1) . M.size) context "optimiseStore" $ do itRights "optimises" $ optimiseStore context "queryMissing" $ do itRights "queries" $ withPath $ \path -> do let pathSet = HS.fromList [path] queryMissing pathSet `shouldReturn` (HS.empty, HS.empty, HS.empty, 0, 0) context "addToStore" $ do itRights "adds file to store" $ do fp <- liftIO $ writeSystemTempFile "addition" "lal" let Right n = makeStorePathName "tmp-addition" res <- addToStore @SHA256 n fp False (pure True) False liftIO $ print res context "with dummy" $ do itRights "adds dummy" dummy itRights "valid dummy" $ do path <- dummy liftIO $ putStrLn $ show path (isValidPathUncached path) `shouldReturn` True context "derivation" $ do itRights "build derivation" $ do withDerivation $ \path drv -> do result <- buildDerivation path drv Normal result `shouldSatisfy` ((==AlreadyValid) . status)