diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/b9.cabal b/b9.cabal --- a/b9.cabal +++ b/b9.cabal @@ -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. diff --git a/src/lib/B9/Artifact.hs b/src/lib/B9/Artifact.hs --- a/src/lib/B9/Artifact.hs +++ b/src/lib/B9/Artifact.hs @@ -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") +-- 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 @@ -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 diff --git a/src/lib/B9/B9Monad.hs b/src/lib/B9/B9Monad.hs --- a/src/lib/B9/B9Monad.hs +++ b/src/lib/B9/B9Monad.hs @@ -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 diff --git a/src/lib/B9/BuildInfo.hs b/src/lib/B9/BuildInfo.hs --- a/src/lib/B9/BuildInfo.hs +++ b/src/lib/B9/BuildInfo.hs @@ -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) 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 @@ -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] diff --git a/src/lib/B9/Shake/Actions.hs b/src/lib/B9/Shake/Actions.hs --- a/src/lib/B9/Shake/Actions.hs +++ b/src/lib/B9/Shake/Actions.hs @@ -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 -- (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] diff --git a/src/lib/B9/Shake/SharedImageRules.hs b/src/lib/B9/Shake/SharedImageRules.hs --- a/src/lib/B9/Shake/SharedImageRules.hs +++ b/src/lib/B9/Shake/SharedImageRules.hs @@ -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