b9 2.0.0 → 2.1.0

raw patch · 7 files changed

+138/−10 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +4/−0
• b9.cabal +3/−2
• src/lib/B9/B9Config.hs +27/−6
• src/lib/B9/DiskImageBuilder.hs +4/−2
• src/tests/B9/B9ConfigSpec.hs +23/−0
• src/tests/B9/DiskImageBuilderSpec.hs +71/−0

@@ -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

@@ -592,4 +592,8 @@  _TODO document this option._ +#### `ext4_attributes` +* Default: `[]`++List of options for `mkfs.ext4 -O`.

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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