b9 0.5.68.1 → 0.5.68.2

raw patch · 10 files changed

+200/−101 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +85/−3
• b9.cabal +1/−1
• src/lib/B9/Artifact.hs +16/−1
• src/lib/B9/B9Config.hs +10/−9
• src/lib/B9/B9Monad.hs +3/−2
• src/lib/B9/BuildInfo.hs +7/−2
• src/lib/B9/DiskImageBuilder.hs +4/−3
• src/lib/B9/Shake/Actions.hs +4/−3
• src/lib/B9/Shake/SharedImageRules.hs +64/−77

@@ -1,5 +1,11 @@ # Changelog for B9 +## 0.5.68.2++* Fix a bug in the shared image Shake rule causing unnecessary rebuilds++* Rename the `buildDirRoot` string template environment variable to `buildDir`+ ## 0.5.68.1  * Fix positional argument enumeration in the `Enviromnent`; CLI arguments 

@@ -1,9 +1,91 @@-# B9 - A Benign VM-Build Tool+# B9 - A Benign VM-Build Tool [![changelog](https://img.shields.io/badge/changelog-green.svg?style=flat)](CHANGELOG.md) -[![Build Status](https://travis-ci.org/sheyll/b9-vm-image-builder.svg?branch=0.5)](https://travis-ci.org/sheyll/b9-vm-image-builder) [![Hackage](https://img.shields.io/badge/hackage-B9-green.svg?style=flat)](http://hackage.haskell.org/package/b9) [![b9 LTS](http://stackage.org/package/b9/badge/lts)](http://stackage.org/lts/package/b9)+[![Build Status](https://travis-ci.org/sheyll/b9-vm-image-builder.svg?branch=0.5)](https://travis-ci.org/sheyll/b9-vm-image-builder) [![b9 LTS](http://stackage.org/package/b9/badge/lts)](http://stackage.org/lts/package/b9)[![Hackage](https://img.shields.io/badge/hackage-B9-green.svg?style=flat)](http://hackage.haskell.org/package/b9) +**An algebraic data type to describe virtual machine images generation.**++### Overview++There is a *DSL* that is described by a few benign Haskell `data` types that can +be `B9` can `read` and `show`. It can be put into a **text file** and be interpreted+by a **command line invokation**. ++Also, `B9` can be used as **Haskell library**. ++### Installation on NixOS++* As **command line utility** in current directory:++      $ nix-build -E 'import ((fetchTarball https://github.com/sheyll/b9-vm-image-builder/archive/0.5.tar.gz) + "/release.nix") {}'+    +  Now the executable `b9c` is in `./result/bin/`:++      $ result/bin/b9c      ++### Installation as Hackage Library with Stack++**Add a dependency to `b9` in your `.cabal` file.**    ++Update the `extra-deps` section in your `stack.yaml`:+    +    extra-deps:+    - b9-0.5.68.2++### Installation of custom version as Library with Stack ++**Instead** of adding to `extra-deps` one can use version **not on Hackage**.+Update the `packages` section in your `stack.yaml`:++    # Local packages, usually specified by relative directory name+    packages:+    +    - location:+        git: git@github.com:sheyll/b9-vm-image-builder.git+        tag: 0.5.68.2+        extra-dep: true++### Features++* Disk image creation+  * Growing shrinking of disk images and file systems+  * File system creation+  * Using existing Disk/File system as input+  * Libvirt/LXC based shell script execution+  * ISO/VFAT cloud-init images without Libvirt/LXC+  * **Artifact Caching and Sharing**+     * Shake rules+ * (Source-) File Creation+   * Example: Merge yaml config snippets, with template parameterers replaced into a text file+              included on the output image.    +   * text-files+   * structured text files with merging:+      * raw+      * yaml+      * erlang+      * Syntax trees for *objects* that can be converted to raw text, yaml or erlang+   * base64 encoded binaries+   * content fetched via HTTP+   * simple template support with `${variableName}`+* Repetition and Reuse++### Supported Formats++Supported Disk Images and File system types:++  * Cloud-init +    * ISOs+    * VFAT floppys+    * raw directories+  * VMDK files+  * QCOW images+  * RAW images +  * MBR partitioned disk images+  * EXT-4++### Old Readme+ Use B9 to compile your software into a deployable set of Linux-VM- or-configuration images, from a set of scripts and input files and templates+configuration images, from a set of scripts and input files and templates.  The main goal of this tool is to provide a build tool to increase automation and reduce redundancy when creating configured, ready-to-run VM-images.

@@ -1,6 +1,6 @@ cabal-version:     2.2 name:                b9-version:             0.5.68.1+version:             0.5.68.2  synopsis:            A tool and library for building virtual machine images. 

@@ -1,4 +1,4 @@--- | Programmatic Interaface to b9 artifact generation.+-- | Programmatic Interface to b9 artifact generation. -- -- An extensible approach to vm deployment configuration management. --@@ -6,5 +6,20 @@ -- -- @since 1.0.0 module B9.Artifact () where+++---- | Build Environment+--disks = let+--  rootImg = loadSharedImage "prod-19.2" (Resize (GB 8))+--+--  dataImgWithContent =+--    let foo = "http://test.localdomain/data-foo.zip"+--        bar = "http://test.localdomain/data-bar.zip"+--        emptyImg = emptyExt4FileSystem "data" (GB 4)+--    in onFileSystem emptyImg $+--         directory "foo" $ do+--          unZipped (remoteBinary foo)+--          fileAttributes (\_f -> UnixFilePermissions 0 7 5 5 "root" "root")+--  

@@ -91,6 +91,7 @@ import System.FilePath ((<.>)) import System.IO.B9Extras (SystemPath(..), ensureDir, resolve) import Text.Printf (printf)+import GHC.Stack  data ExecEnvType =   LibVirtLXC@@ -148,7 +149,7 @@ -- | Run a 'B9ConfigReader'. -- -- @since 0.5.65-runB9ConfigReader :: B9Config -> Eff (B9ConfigReader ': e) a -> Eff e a+runB9ConfigReader :: HasCallStack => B9Config -> Eff (B9ConfigReader ': e) a -> Eff e a runB9ConfigReader = runReader  -- | Return the runtime configuration, that should be the configuration merged@@ -265,7 +266,7 @@ type B9ConfigWriter = Writer (Semigroup.Endo B9Config)  -- | Add a modification to the permanent configuration file.-modifyPermanentConfig :: Member B9ConfigWriter e => Endo B9Config -> Eff e ()+modifyPermanentConfig :: (HasCallStack, Member B9ConfigWriter e) => Endo B9Config -> Eff e () modifyPermanentConfig = tell  -- | Execute a 'B9ConfigAction'.@@ -282,7 +283,7 @@ -- See also 'runB9ConfigAction', which does not need the 'B9ConfigOverride' parameter. -- -- @since 0.5.65-runB9ConfigActionWithOverrides :: B9ConfigAction a -> B9ConfigOverride -> IO a+runB9ConfigActionWithOverrides :: HasCallStack => B9ConfigAction a -> B9ConfigOverride -> IO a runB9ConfigActionWithOverrides act cfg = do   configuredCfgPath <- traverse resolve (cfg ^. customB9ConfigPath)   fallbackCfgPath <- resolve defaultB9ConfigFile@@ -320,13 +321,13 @@ -- See 'runB9ConfigActionWithOverrides' for more details. -- -- @since 0.5.65-runB9ConfigAction :: B9ConfigAction a -> IO a+runB9ConfigAction :: HasCallStack => B9ConfigAction a -> IO a runB9ConfigAction = flip runB9ConfigActionWithOverrides noB9ConfigOverride  -- | Open the configuration file that contains the 'B9Config'. -- If the configuration does not exist, write a default configuration file, -- and create a all missing directories.-openOrCreateB9Config :: MonadIO m => FilePath -> m CPDocument+openOrCreateB9Config :: (HasCallStack, MonadIO m) => FilePath -> m CPDocument openOrCreateB9Config cfgFile = do   ensureDir cfgFile   liftIO $ do@@ -341,7 +342,7 @@ -- | Write the configuration in the 'CPDocument' to either the user supplied -- configuration file path or to 'defaultB9ConfigFile'. -- Create all missing (parent) directories.-writeB9CPDocument :: MonadIO m => Maybe SystemPath -> CPDocument -> m ()+writeB9CPDocument :: (HasCallStack, MonadIO m) => Maybe SystemPath -> CPDocument -> m () writeB9CPDocument cfgFileIn cp = do   cfgFile <- resolve (fromMaybe defaultB9ConfigFile cfgFileIn)   ensureDir cfgFile@@ -408,7 +409,7 @@   return (mergeCP cp cp2)  -- | Append a config file section for the 'B9Config' to an empty 'CPDocument'.-b9ConfigToCPDocument :: B9Config -> Either CPError CPDocument+b9ConfigToCPDocument :: HasCallStack => B9Config -> Either CPError CPDocument b9ConfigToCPDocument c = do   cp1 <- addSectionCP emptyCP cfgFileSection   cp2 <- setShowCP cp1 cfgFileSection verbosityK (_verbosity c)@@ -423,10 +424,10 @@   cpFinal <- foldr (>=>) return (remoteRepoToCPDocument <$> _remoteRepos c) cpA   setShowCP cpFinal cfgFileSection repositoryK (_repository c) -readB9Config :: MonadIO m => Maybe SystemPath -> m CPDocument+readB9Config :: (HasCallStack, MonadIO m) => Maybe SystemPath -> m CPDocument readB9Config cfgFile = readCPDocument (fromMaybe defaultB9ConfigFile cfgFile) -parseB9Config :: CPDocument -> Either CPError B9Config+parseB9Config :: HasCallStack => CPDocument -> Either CPError B9Config parseB9Config cp =   let getr :: (CPGet a) => CPOptionSpec -> Either CPError a       getr = readCP cp cfgFileSection

@@ -14,6 +14,7 @@ import           B9.Repository import           Control.Eff import           Data.Functor                   ( )+import           GHC.Stack  -- | Definition of the B9 monad. See 'B9Eff'. --@@ -36,13 +37,13 @@ -- | A constraint that contains all effects of 'B9Eff' -- -- @since 0.5.65-type IsB9 e = (Lifted IO e, CommandIO e, B9Eff <:: e)+type IsB9 e = (HasCallStack, Lifted IO e, CommandIO e, B9Eff <:: e)  -- | Execute a 'B9' effect and return an action that needs -- the 'B9Config'. -- -- @since 0.5.65-runB9 :: B9 a -> B9ConfigAction a+runB9 :: HasCallStack => B9 a -> B9ConfigAction a runB9 action = do   cfg <- getB9Config   env <- askEnvironment

@@ -34,6 +34,7 @@ import           System.Directory import           System.FilePath import           Text.Printf+import           GHC.Stack  -- | Build meta information. --@@ -52,8 +53,11 @@  -- | Create the build directories, generate (hash) the build-id and execute the given action. ----- Export the @projectRoot@ 'Environment' variable.+-- Bindings added to the text template parameter environment: --+-- * @projectRoot@ the directory that contains the sources of the project to build+-- * @buildDir@ the temporary directory used store the build artifacts passed into- or outof the build+-- -- Unless '_keepTempDirs' is @True@ clean up the build directories after the actions -- returns - even if the action throws a runtime exception. --@@ -65,6 +69,7 @@      , Member ExcB9 e      , Member EnvironmentReader e      , Member LoggerReader e+     , HasCallStack      )   => Eff (BuildInfoReader ': e) a   -> Eff e a@@ -113,7 +118,7 @@       traceL (printf "Project Root Directory: %s" rootD)       buildD <- getBuildDir       traceL (printf "Build Directory:        %s" buildD)-      r       <-  addLocalStringBinding ("buildDirRoot", buildD) action+      r       <-  addLocalStringBinding ("buildDir", buildD) action       tsAfter <- liftIO getCurrentTime       let duration = show (tsAfter `diffUTCTime` startTime)       infoL (printf "DURATION: %s" duration)

@@ -56,6 +56,7 @@ import           System.IO.Error                ( isDoesNotExistError ) import           Text.Printf                    ( printf ) import           Text.Show.Pretty               ( ppShow )+import           GHC.Stack  -- -- | Convert relative file paths of images, sources and mounted host directories -- -- to absolute paths relative to '_projectRoot'.@@ -68,7 +69,7 @@ -- | Replace $... variables inside an 'ImageTarget' substImageTarget   :: forall e-   . (Member EnvironmentReader e, Member ExcB9 e)+   . (HasCallStack, Member EnvironmentReader e, Member ExcB9 e)   => ImageTarget   -> Eff e ImageTarget substImageTarget = everywhereM gsubst@@ -124,7 +125,7 @@  -- | Return all supported source 'ImageType's compatible to a 'ImageDestinaion' -- in the preferred order.-preferredSourceImageTypes :: ImageDestination -> [ImageType]+preferredSourceImageTypes :: HasCallStack => ImageDestination -> [ImageType] preferredSourceImageTypes dest = case dest of   (Share _ fmt resize) ->     nub [fmt, Raw, QCow2, Vmdk] `intersect` allowedImageTypesForResize resize@@ -133,7 +134,7 @@   Transient -> [Raw, QCow2, Vmdk]   (LiveInstallerImage _name _repo _imgResize) -> [Raw] -allowedImageTypesForResize :: ImageResize -> [ImageType]+allowedImageTypesForResize :: HasCallStack => ImageResize -> [ImageType] allowedImageTypesForResize r = case r of   Resize _        -> [Raw]   ShrinkToMinimum -> [Raw]

@@ -8,18 +8,19 @@ import           B9 import           Control.Lens                   ( (?~) ) import           Development.Shake+import           GHC.Stack --- | Convert a 'B9Invocation' action into a Shake 'Action'. This is just+-- | Convert a 'B9ConfigAction' action into a Shake 'Action'. This is just -- an alias for 'runB9ConfigActionWithOverrides' since 'Action' is an instance of 'MonadIO' -- and 'runB9ConfigActionWithOverrides' work on any .-b9InvocationAction :: B9ConfigAction a -> B9ConfigOverride -> Action a+b9InvocationAction :: HasCallStack =>  B9ConfigAction a -> B9ConfigOverride -> Action a b9InvocationAction x y = liftIO (runB9ConfigActionWithOverrides x y)  -- | An action that does the equivalent of -- @b9c build -f <b9file> -- (args !! 0) (args !! 1) ... (args !! (length args - 1))@ -- with the current working directory changed to @b9Root@. -- The return value is the buildid, see 'getBuildId'-buildB9File :: FilePath -> FilePath -> [String] -> Action String+buildB9File :: HasCallStack => FilePath -> FilePath -> [String] -> Action String buildB9File b9Root b9File args = do   let f = b9Root </> b9File   need [f]

@@ -4,95 +4,82 @@   ( customSharedImageAction   , needSharedImage   , enableSharedImageRules-  )-where+  ) where -import           B9-import qualified Data.Binary                   as Binary-import qualified Data.ByteString               as ByteString-import qualified Data.ByteString.Builder       as Builder-import           Data.ByteString.Builder        ( stringUtf8 )-import qualified Data.ByteString.Lazy          as LazyByteString-import           Development.Shake-import           Development.Shake.Classes-import           Development.Shake.Rule+import B9+import qualified Data.Binary as Binary+import qualified Data.ByteString.Char8 as ByteString+import qualified Data.ByteString.Lazy.Char8 as LazyByteString+import Development.Shake+import Development.Shake.Classes+import Development.Shake.Rule+import GHC.Stack  -- | In order to use 'needSharedImage' and 'customSharedImageAction' you need to -- call this action before using any of the aforementioned 'Rules'.-enableSharedImageRules :: B9ConfigOverride -> Rules ()-enableSharedImageRules b9inv = addBuiltinRule noLint sharedImageIdentity go- where-  sharedImageIdentity :: BuiltinIdentity SharedImageName SharedImageBuildId-  sharedImageIdentity (SharedImageName k) (SharedImageBuildId v) = Just-    (LazyByteString.toStrict-      (Builder.toLazyByteString (stringUtf8 k <> stringUtf8 v))-    )-  go :: BuiltinRun SharedImageName SharedImageBuildId-  go nameQ mOldBIdBinary dependenciesChanged = do-    mCurrentBId <- getImgBuildId-    case mCurrentBId of-      Just currentBId ->-        let currentBIdBinary = encodeBuildId currentBId-        in  if dependenciesChanged-                 == RunDependenciesChanged-                 && mOldBIdBinary-                 == Just currentBIdBinary-              then return $ RunResult ChangedNothing currentBIdBinary currentBId-              else rebuild (Just currentBIdBinary)-      _ -> rebuild Nothing-   where-    getImgBuildId = liftIO-      (runB9ConfigActionWithOverrides (runLookupLocalSharedImage nameQ) b9inv)-    encodeBuildId :: SharedImageBuildId -> ByteString.ByteString-    encodeBuildId = LazyByteString.toStrict . Binary.encode-    rebuild-      :: Maybe ByteString.ByteString -> Action (RunResult SharedImageBuildId)-    rebuild mCurrentBIdBinary = do-      (_, act) <- getUserRuleOne nameQ (const Nothing) imgMatch-      act b9inv-      mNewBId <- getImgBuildId-      newBId  <- maybe-        (error-          (  "failed to get SharedImageBuildId for "-          ++ show nameQ-          ++ " in context of "-          ++ show b9inv-          )-        )-        return-        mNewBId-      let newBIdBinary = encodeBuildId newBId-      let change = if Just newBIdBinary == mCurrentBIdBinary-            then ChangedRecomputeSame-            else ChangedRecomputeDiff-      return $ RunResult change newBIdBinary newBId-     where-      imgMatch (SharedImageCustomActionRule name mkImage) =-        if name == nameQ then Just mkImage else Nothing+enableSharedImageRules :: HasCallStack => B9ConfigOverride -> Rules ()+enableSharedImageRules b9inv = addBuiltinRule noLint noIdentity go+  where+    go :: BuiltinRun SharedImageName SharedImageBuildId+    go nameQ mOldBIdBinary dependenciesChanged = do+      mCurrentBId <- getImgBuildId+      let mCurrentBIdBinary = encodeBuildId <$> mCurrentBId+      putLoud $+        "share image rule for: " +++        show nameQ +++        ". Deps: " +++        show dependenciesChanged +++        ", current BId: " +++        show mCurrentBId ++ " Binary: " ++ show mCurrentBIdBinary ++ ", old BId: " ++ show mOldBIdBinary+      case mCurrentBIdBinary of+        Just currentBIdBinary ->+          if dependenciesChanged == RunDependenciesSame && mOldBIdBinary == Just currentBIdBinary+            then return $ RunResult ChangedNothing currentBIdBinary (fromJust mCurrentBId)+            else rebuild (Just currentBIdBinary)+        Nothing -> rebuild Nothing+      where+        getImgBuildId = liftIO (runB9ConfigActionWithOverrides (runLookupLocalSharedImage nameQ) b9inv)+        encodeBuildId :: SharedImageBuildId -> ByteString.ByteString+        encodeBuildId = LazyByteString.toStrict . Binary.encode+        rebuild :: Maybe ByteString.ByteString -> Action (RunResult SharedImageBuildId)+        rebuild mCurrentBIdBinary = do+          (_, act) <- getUserRuleOne nameQ (const Nothing) imgMatch+          act b9inv+          mNewBId <- getImgBuildId+          newBId <-+            maybe+              (error ("failed to get SharedImageBuildId for " ++ show nameQ ++ " in context of " ++ show b9inv))+              return+              mNewBId+          let newBIdBinary = encodeBuildId newBId+          let change =+                if Just newBIdBinary == mCurrentBIdBinary+                  then ChangedRecomputeSame+                  else ChangedRecomputeDiff+          return $ RunResult change newBIdBinary newBId+          where+            imgMatch (SharedImageCustomActionRule name mkImage) =+              if name == nameQ+                then Just mkImage+                else Nothing  -- | Add a dependency to the creation of a 'SharedImage'. The build action -- for the shared image must have been supplied by e.g. 'customSharedImageAction'. -- NOTE: You must call 'enableSharedImageRules' before this action works.-needSharedImage :: SharedImageName -> Action SharedImageBuildId+needSharedImage :: HasCallStack => SharedImageName -> Action SharedImageBuildId needSharedImage = apply1  -- | Specify an arbitrary action that is supposed to build the given shared -- image identified by a 'SharedImageName'. -- NOTE: You must call 'enableSharedImageRules' before this action works.-customSharedImageAction :: SharedImageName -> Action () -> Rules ()-customSharedImageAction b9img customAction = addUserRule-  (SharedImageCustomActionRule b9img customAction')- where-  customAction' b9inv = do-    customAction-    mCurrentBuildId <- liftIO-      (runB9ConfigActionWithOverrides (runLookupLocalSharedImage b9img) b9inv)-    putLoud-      (printf "Finished custom action, for %s, build-id is: %s"-              (show b9img)-              (show mCurrentBuildId)-      )-    maybe (errorSharedImageNotFound b9img) return mCurrentBuildId+customSharedImageAction :: HasCallStack => SharedImageName -> Action () -> Rules ()+customSharedImageAction b9img customAction = addUserRule (SharedImageCustomActionRule b9img customAction')+  where+    customAction' b9inv = do+      customAction+      mCurrentBuildId <- liftIO (runB9ConfigActionWithOverrides (runLookupLocalSharedImage b9img) b9inv)+      putLoud (printf "Finished custom action, for %s, build-id is: %s" (show b9img) (show mCurrentBuildId))+      maybe (errorSharedImageNotFound b9img) return mCurrentBuildId  type instance RuleResult SharedImageName = SharedImageBuildId @@ -101,5 +88,5 @@                               (B9ConfigOverride -> Action SharedImageBuildId)   deriving (Typeable) -errorSharedImageNotFound :: Monad m => SharedImageName -> m a+errorSharedImageNotFound :: (HasCallStack, Monad m) => SharedImageName -> m a errorSharedImageNotFound = fail . printf "Error: %s not found." . show