diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog for B9 +## 2.1.0 + +* Add a new config parameter for the default Ext4 file system attributes. +* `Ext4_64` is deprecated from now on, please use `Ext4` and configure the + `ext4_attributes: ["64bit"]`. + ## 2.0.0 ### Breaking Changes diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -592,4 +592,8 @@ _TODO document this option._ +#### `ext4_attributes` +* Default: `[]` + +List of options for `mkfs.ext4 -O`. diff --git a/b9.cabal b/b9.cabal --- a/b9.cabal +++ b/b9.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: b9 -version: 2.0.0 +version: 2.1.0 synopsis: A tool and library for building virtual machine images. @@ -71,6 +71,7 @@ , lens == 4.* , neat-interpolation >= 0.3 && < 1 , optparse-applicative >= 0.13 && < 1 + , process >= 1.4 && < 2 , shake >= 0.17.6 && < 0.19 , text == 1.2.* , unordered-containers >= 0.2 && < 1 @@ -176,7 +177,6 @@ , parsec >= 3.1 && < 4 , pretty >= 1.1 && < 2 , pretty-show >= 1.6 && < 2 - , process >= 1.4 && < 2 , random >= 1.1 && < 2 , syb >= 0.6 && < 1 , tagged >= 0.8 && < 0.9 @@ -208,6 +208,7 @@ , B9.Content.ErlangPropListSpec , B9.Content.YamlObjectSpec , B9.DiskImagesSpec + , B9.DiskImageBuilderSpec , B9.EnvironmentSpec , B9.RepositoryIOSpec , B9.RepositorySpec diff --git a/src/lib/B9/B9Config.hs b/src/lib/B9/B9Config.hs --- a/src/lib/B9/B9Config.hs +++ b/src/lib/B9/B9Config.hs @@ -16,6 +16,7 @@ B9ConfigWriter, verbosity, logFile, + ext4Attributes, projectRoot, keepTempDirs, uniqueBuildDirs, @@ -49,6 +50,7 @@ overrideTimeoutFactor, overrideVerbosity, overrideKeepBuildDirs, + overrideExt4Attributes, defaultB9ConfigFile, defaultRepositoryCache, defaultB9Config, @@ -149,7 +151,8 @@ _libVirtLXCConfigs :: Maybe LibVirtLXCConfig, _remoteRepos :: Set RemoteRepo, _defaultTimeout :: Maybe Timeout, - _timeoutFactor :: Maybe Int + _timeoutFactor :: Maybe Int, + _ext4Attributes :: [String] } deriving (Show, Eq) @@ -171,6 +174,7 @@ <*> smaller arbitrary <*> smaller arbitrary <*> (fmap QuickCheck.getPositive <$> smaller arbitrary) + <*> smaller (QuickCheck.sublistOf ["opt1","opt2","opt3"]) instance Semigroup B9Config where c <> c' = @@ -189,12 +193,13 @@ _libVirtLXCConfigs = getLast ((mappend `on` (Last . _libVirtLXCConfigs)) c c'), _remoteRepos = (mappend `on` _remoteRepos) c c', _defaultTimeout = getLast $ on mappend (Last . _defaultTimeout) c c', - _timeoutFactor = getLast $ on mappend (Last . _timeoutFactor) c c' + _timeoutFactor = getLast $ on mappend (Last . _timeoutFactor) c c', + _ext4Attributes = on mappend _ext4Attributes c c' } instance Monoid B9Config where mappend = (<>) - mempty = B9Config Nothing Nothing Nothing False True Nothing Nothing Nothing Nothing Nothing Nothing Nothing mempty (Just (TimeoutMicros (60 * 60 * 1_000_000))) Nothing + mempty = B9Config Nothing Nothing Nothing False True Nothing Nothing Nothing Nothing Nothing Nothing Nothing mempty (Just (TimeoutMicros (60 * 60 * 1_000_000))) Nothing [] -- | Reader for 'B9Config'. See 'getB9Config' and 'localB9Config'. -- @@ -313,6 +318,11 @@ overrideKeepBuildDirs :: Bool -> B9ConfigOverride -> B9ConfigOverride overrideKeepBuildDirs = overrideB9Config . Lens.set keepTempDirs +-- | Overwrite the 'ext4Attributes' +overrideExt4Attributes :: [String] -> B9ConfigOverride -> B9ConfigOverride +overrideExt4Attributes = overrideB9Config . Lens.set ext4Attributes + + -- | A monad that gives access to the (transient) 'B9Config' to be used at -- _runtime_ with 'getB9Config' or 'localB9Config', and that allows -- to write permanent 'B9Config' changes back to the configuration file using @@ -441,7 +451,8 @@ _dockerConfigs = Just defaultDockerConfig, _remoteRepos = mempty, _defaultTimeout = Just (TimeoutMicros (3_600_000_000)), - _timeoutFactor = Nothing + _timeoutFactor = Nothing, + _ext4Attributes = [] } defaultRepositoryCache :: SystemPath @@ -483,6 +494,10 @@ cfgFileSection :: String cfgFileSection = "global" +ext4AttributesK :: String +ext4AttributesK = "ext4_attributes" + + -- | Parse a 'B9Config', modify it, and merge it back to the given 'CPDocument'. modifyCPDocument :: CPDocument -> Endo B9Config -> Either CPError CPDocument modifyCPDocument cp f = do @@ -507,17 +522,22 @@ cpD <- foldr (>=>) return (libVirtLXCConfigToCPDocument <$> _libVirtLXCConfigs c) cpC cpE <- foldr (>=>) return ( remoteRepoToCPDocument <$> Set.toList (_remoteRepos c)) cpD cpF <- setShowCP cpE cfgFileSection repositoryK (_repository c) - cpFinal <- maybe (pure cpF) (setShowCP cpF cfgFileSection defaultTimeoutK) + cpG <- maybe (pure cpF) (setShowCP cpF cfgFileSection defaultTimeoutK) ( case _defaultTimeout c of Just (TimeoutMicros t) -> Just (t `div` 1_000_000) Nothing -> Nothing ) - maybe (pure cpFinal) (setShowCP cpFinal cfgFileSection timeoutFactorK) (_timeoutFactor c) + cpH <- maybe (pure cpG) (setShowCP cpG cfgFileSection timeoutFactorK) (_timeoutFactor c) + cpFinal <- setShowCP cpH cfgFileSection ext4AttributesK (_ext4Attributes c) + return cpFinal readB9Config :: (HasCallStack, MonadIO m) => Maybe SystemPath -> m CPDocument readB9Config cfgFile = readCPDocument (fromMaybe defaultB9ConfigFile cfgFile) +defaultExt4Attributes :: [String] +defaultExt4Attributes = ["^64bit"] + parseB9Config :: HasCallStack => CPDocument -> Either CPError B9Config parseB9Config cp = let getr :: (CPGet a) => CPOptionSpec -> Either CPError a @@ -538,6 +558,7 @@ <*> (Set.fromList <$> parseRemoteRepos cp) <*> pure (either (const Nothing) Just (parseDefaultTimeoutConfig cp)) <*> pure (either (const Nothing) Just (getr timeoutFactorK)) + <*> pure (either (const defaultExt4Attributes) id (getr ext4AttributesK)) -- TODO: Differentiate (NoOption _, _) from others parseDefaultTimeoutConfig :: CPDocument -> Either CPError Timeout parseDefaultTimeoutConfig cp = do diff --git a/src/lib/B9/DiskImageBuilder.hs b/src/lib/B9/DiskImageBuilder.hs --- a/src/lib/B9/DiskImageBuilder.hs +++ b/src/lib/B9/DiskImageBuilder.hs @@ -31,7 +31,7 @@ import B9.RepositoryIO import Control.Eff import qualified Control.Exception as IO -import Control.Lens ((^.)) +import Control.Lens (view, (^.)) import Control.Monad import Control.Monad.IO.Class import Data.Generics.Aliases @@ -300,9 +300,11 @@ dbgL (printf "Creating file system %s" (show imgFs)) cmd (printf "%s -F -L '%s' -O 64bit -q '%s'" fsCmd fsLabel imgFile) (Raw, Ext4) -> do + ext4Options <- view ext4Attributes <$> getB9Config + let fsOptions = "-O " <> intercalate "," ext4Options let fsCmd = "mkfs.ext4" dbgL (printf "Creating file system %s" (show imgFs)) - cmd (printf "%s -F -L '%s' -O ^64bit -q '%s'" fsCmd fsLabel imgFile) + cmd (printf "%s -F -L '%s' %s -q '%s'" fsCmd fsLabel fsOptions imgFile) (imageType, fs) -> error ( printf diff --git a/src/tests/B9/B9ConfigSpec.hs b/src/tests/B9/B9ConfigSpec.hs --- a/src/tests/B9/B9ConfigSpec.hs +++ b/src/tests/B9/B9ConfigSpec.hs @@ -48,6 +48,7 @@ verbosity: Just LogNothing timeout_factor: 3 default_timeout_seconds: 10 + ext4_attributes: ["attr1", "attr2"] |] it "correctly parses verbosity" $ do cfg <- withConfig exampleConfig getB9Config @@ -60,6 +61,28 @@ it "correctly parses default_timeout" $ do cfg <- withConfig exampleConfig getB9Config _defaultTimeout cfg `shouldBe` Just (TimeoutMicros 10_000_000) + + it "correctly parses ext4_attributes" $ do + cfg <- withConfig exampleConfig getB9Config + _ext4Attributes cfg `shouldBe` ["attr1", "attr2"] + + it "correctly parses missing ext4_attributes" $ do + let exampleConfigNoExt4 = Text.unpack [Neat.text| + [global] + build_dir_root: Nothing + keep_temp_dirs: False + log_file: Nothing + max_cached_shared_images: Just 2 + repository: Nothing + repository_cache: Just (InB9UserDir "repo-cache") + unique_build_dirs: True + verbosity: Just LogNothing + timeout_factor: 3 + default_timeout_seconds: 10 + |] + cfg <- withConfig exampleConfigNoExt4 getB9Config + _ext4Attributes cfg `shouldBe` ["^64bit"] + renderThenParseB9Config :: B9Config -> Either CPError B9Config renderThenParseB9Config = b9ConfigToCPDocument >=> parseB9Config diff --git a/src/tests/B9/DiskImageBuilderSpec.hs b/src/tests/B9/DiskImageBuilderSpec.hs new file mode 100644 --- /dev/null +++ b/src/tests/B9/DiskImageBuilderSpec.hs @@ -0,0 +1,71 @@ +module B9.DiskImageBuilderSpec (spec) where + +import Test.Hspec +import B9 +import Control.Exception +import Control.Eff +import System.Directory +import System.Environment +import System.Process +import Control.Arrow ((>>>)) + +spec :: Spec +spec = + it "passes the mkfs.ext4 options defined in the B9Config" $ do + let expectedOptions = ["^metadata_csum", "64bit"] + actual <- b9Wrapper expectedOptions $ do + d <- getBuildDir + let outFile = d "test.raw" + materializeImageSource + (EmptyImage "test" Ext4 Raw (ImageSize 10 MB)) + (Image outFile Raw Ext4) + lift (readProcess "tune2fs" ["-l", outFile] "") + let fsOptions = lines >>> map (stripPrefix "Filesystem features:") >>> catMaybes >>> mconcat >>> words $ actual + fsOptions `shouldContain` ["64bit"] + fsOptions `shouldNotContain` ["metadata_csum"] + +b9Wrapper :: HasCallStack => [String] -> B9 a -> IO a +b9Wrapper ext4TestAttributes effect = + withTempBuildDirs $ \cfgOverride -> + let cfg = overrideExt4Attributes ext4TestAttributes cfgOverride + in runB9ConfigActionWithOverrides (runB9 effect) cfg + +withTempBuildDirs :: HasCallStack => (B9ConfigOverride -> IO a) -> IO a +withTempBuildDirs k = + bracket acquire release use + where + acquire = do + nixOutDirEnv <- lookupEnv "NIX_BUILD_TOP" + let rootDir = maybe InTempDir (((.) . (.)) Path ()) nixOutDirEnv + repoRelPath <- printf "testsDiskImageBuilderSpec-test-repo-%U" <$> randomUUID + buildRelPath <- printf "DiskImageBuilderSpec-root-%U" <$> randomUUID + cfgRelPath <- printf "DiskImageBuilderSpec-b9cfg-%U" <$> randomUUID + let tmpRepoPath = rootDir ("tests" repoRelPath) + tmpBuildPath = rootDir ("tests" buildRelPath) + tmpCfgPath = rootDir ("tests" cfgRelPath) + ensureSystemPath tmpRepoPath + ensureSystemPath tmpBuildPath + tmpBuildPathFileName <- resolve tmpBuildPath + return (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) + release (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) = do + let cleanupTmpPath = removePathForcibly <=< resolve + cleanupTmpPath tmpRepoPath + cleanupTmpPath tmpCfgPath + removePathForcibly tmpBuildPathFileName + use (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) = + let mkCfg cfgIn = + cfgIn + { _repositoryCache = Just tmpRepoPath, + _projectRoot = Just tmpBuildPathFileName + } + oCfg = + overrideB9Config + mkCfg + ( overrideWorkingDirectory + tmpBuildPathFileName + ( overrideDefaultB9ConfigPath + tmpCfgPath + noB9ConfigOverride + ) + ) + in k oCfg