diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -1,1 +1,3 @@ language: haskell +ghc: + - 7.8 diff --git a/TODO.org b/TODO.org --- a/TODO.org +++ b/TODO.org @@ -86,4 +86,8 @@ * Make B9 a real library ** Restrict exposed modules ** Add pure library functions for munging Artifacts +** Move SharedImage functions from DiskImageBuilder to a better place +** Refactor the B9Monad.run function to not need a ConfigParser +** Move 'Repository' from B9.RepositoryIO to B9.Repository * Add building of RPMs and ARCHLINUX packages +* Use unique ids for vm image builds diff --git a/b9.cabal b/b9.cabal --- a/b9.cabal +++ b/b9.cabal @@ -1,5 +1,5 @@ name: b9 -version: 0.2.4 +version: 0.2.5 synopsis: A tool and library for building virtual machine images. diff --git a/src/lib/B9.hs b/src/lib/B9.hs --- a/src/lib/B9.hs +++ b/src/lib/B9.hs @@ -5,7 +5,11 @@ This module re-exports the modules needed to build a tool around the library, e.g. see @src\/cli\/Main.hs@ as an example. - -} + + "B9.ArtifactGenerator" is the module containing the basic data structure + used to describe a B9 build. + +-} module B9 ( module B9.Builder diff --git a/src/lib/B9/ArtifactGenerator.hs b/src/lib/B9/ArtifactGenerator.hs --- a/src/lib/B9/ArtifactGenerator.hs +++ b/src/lib/B9/ArtifactGenerator.hs @@ -30,15 +30,79 @@ import Test.QuickCheck --- | A single config generator specifies howto generate multiple output --- files/directories. It consists of a netsted set of variable bindings that are --- replaced inside the text files +{-| Artifacts represent the things B9 can build. A generator specifies howto +generate parameterized, multiple artifacts. The general structure is: + +@ + Let [ ... bindings ... ] + [ Sources + [ ... list all input files ... ] + [ Artifact ... + , Artifact ... + , Let [ ... ] [ ... ] + ] + ] +@ + +The reasons why 'Sources' takes a list of 'ArtifactGenerator's is that +1. this makes the value easier to read/write for humans +2. the sources are static files used in all children (e.g. company logo image) +3. the sources are parameterized by variables that bound to different values + for each artifact, e.g. a template network config file which contains + the host IP address. + +To bind such variables use 'Let', 'Each', 'LetX' or 'EachT'. + +String subtitution of these variables is done by "B9.Content.StringTemplate". +These variables can be used as value in nested 'Let's, in most file names/paths +and in source files added with 'B9.Content.StringTemplate.SourceFile' + +-} data ArtifactGenerator = Sources [ArtifactSource] [ArtifactGenerator] + -- ^ Add sources available to 'ArtifactAssembly's in + -- nested artifact generators. | Let [(String, String)] [ArtifactGenerator] + -- ^ Bind variables, variables are avaible in nested + -- generators. | LetX [(String, [String])] [ArtifactGenerator] - | EachT [String] [[String]] [ArtifactGenerator] + -- ^ A 'Let' where each variable is assigned to each + -- value; the nested generator is executed for each + -- permutation. + -- + -- @ + -- LetX [("x", ["1","2","3"]), ("y", ["a","b"])] [..] + -- @ + -- Is equal to: + -- + -- @ + -- Let [] [ + -- Let [("x", "1"), ("y", "a")] [..] + -- Let [("x", "1"), ("y", "b")] [..] + -- Let [("x", "2"), ("y", "a")] [..] + -- Let [("x", "2"), ("y", "b")] [..] + -- Let [("x", "3"), ("y", "a")] [..] + -- Let [("x", "3"), ("y", "b")] [..] + -- ] + -- @ | Each [(String,[String])] [ArtifactGenerator] + -- ^ Bind each variable to their first value, then each + -- variable to the second value, etc ... and execute the + -- nested generator in every step. 'LetX' represents a + -- product of all variables, whereas 'Each' represents a + -- sum of variable bindings - 'Each' is more like a /zip/ + -- whereas 'LetX' is more like a list comprehension. + | EachT [String] [[String]] [ArtifactGenerator] + -- ^ The transposed verison of 'Each': Bind the variables + -- in the first list to each a set of values from the + -- second argument; execute the nested generators for + -- each binding | Artifact InstanceId ArtifactAssembly + -- ^ Generate an artifact defined by an + -- 'ArtifactAssembly'; the assembly can access the files + -- created from the 'Sources' and variables bound by + -- 'Let'ish elements. An artifact has an instance id, + -- that is a unique, human readable string describing the + -- artifact to assemble. | EmptyArtifact deriving (Read, Show, Eq) @@ -48,33 +112,68 @@ x `mappend` (Let [] []) = x x `mappend` y = Let [] [x, y] --- | Explicit is better than implicit: Only files that have explicitly been --- listed will be included in any generated configuration. That's right: There's --- no "inlcude *.*". B9 will check that *all* files in the directory specified with 'FromDir' are referred to by nested 'ArtifactSource's. +-- | Describe how input files for artifacts to build are obtained. The general +-- structure of each constructor is __FromXXX__ /destination/ /source/ data ArtifactSource = FromFile FilePath SourceFile + -- ^ Copy a 'B9.Content.StringTemplate.SourceFile' + -- potentially replacing variabled defined in 'Let'-like + -- parent elements. | FromContent FilePath Content + -- ^ Create a file from some 'Content' | SetPermissions Int Int Int [ArtifactSource] + -- ^ Set the unix /file permissions/ to all files generated + -- by the nested list of 'ArtifactSource's. | FromDirectory FilePath [ArtifactSource] + -- ^ Assume a local directory as starting point for all + -- relative source files in the nested 'ArtifactSource's. | IntoDirectory FilePath [ArtifactSource] + -- ^ Specify an output directory for all the files + -- generated by the nested 'ArtifactSource's | Concatenation FilePath [ArtifactSource] + -- ^ __Deprecated__ Concatenate the files generated by the + -- nested 'ArtifactSource's. The nested, generated files + -- are not written when they are concatenated. deriving (Read, Show, Eq) +-- | Identify an artifact. __Deprecated__ TODO: B9 does not check if all +-- instances IDs are unique. newtype InstanceId = IID String deriving (Read, Show, Typeable, Data, Eq) +-- | The variable containing the instance id. __Deprecated__ instanceIdKey :: String instanceIdKey = "instance_id" +-- | The variable containing the buildId that identifies each execution of +-- B9. For more info about variable substitution in source files see +-- 'B9.Content.StringTemplate' buildIdKey :: String buildIdKey = "build_id" +-- | The variable containing the date and time a build was started. For more +-- info about variable substitution in source files see +-- 'B9.Content.StringTemplate' buildDateKey :: String buildDateKey = "build_date" +-- | Define an __output__ of a build. Assemblies are nested into +-- 'ArtifactGenerator's. They contain all the files defined by the 'Sources' +-- they are nested into. data ArtifactAssembly = CloudInit [CloudInitType] FilePath + -- ^ Generate a __cloud-init__ compatible directory, ISO- + -- or VFAT image, as specified by the list of + -- 'CloudInitType's. Every item will use the second + -- argument to create an appropriate /file name/, + -- e.g. for the 'CI_ISO' type the output is @second_param.iso@. | VmImages [ImageTarget] VmScript + -- ^ a set of VM-images that were created by executing a + -- build script on them. deriving (Read, Show, Typeable, Data, Eq) +-- | A type representing the targets assembled by +-- 'B9.ArtifactGeneratorImpl.assemble' from an 'ArtifactAssembly'. There is a +-- list of 'ArtifactTarget's because e.g. a single 'CloudInit' can produce upto +-- three output files, a directory, an ISO image and a VFAT image. data AssembledArtifact = AssembledArtifact InstanceId [ArtifactTarget] deriving (Read, Show, Typeable, Data, Eq) diff --git a/src/lib/B9/Content/AST.hs b/src/lib/B9/Content/AST.hs --- a/src/lib/B9/Content/AST.hs +++ b/src/lib/B9/Content/AST.hs @@ -34,25 +34,43 @@ import Test.QuickCheck import B9.QCUtil +-- | Types of values that can be parsed/rendered from/to 'ByteString's. This +-- class is used as basis for the 'ASTish' class. class (Semigroup a) => ConcatableSyntax a where - decodeSyntax :: FilePath -> B.ByteString -> Either String a + -- Parse a bytestring into an 'a', and return @Left errorMessage@ or @Right a@ + decodeSyntax :: FilePath -- ^ An arbitrary string for error messages that corresponds + -- to a possible input file. + -> B.ByteString -- ^ The raw input to parse + -> Either String a + -- Generate a string representation of @a@ encodeSyntax :: a -> B.ByteString instance ConcatableSyntax B.ByteString where decodeSyntax _ = Right encodeSyntax = id --- | A simple AST wrapper for merging embeded ASTs -data AST c a = ASTObj [(String, AST c a)] - | ASTArr [AST c a] - | ASTMerge [AST c a] - | ASTEmbed c - | ASTString String - | ASTParse SourceFile - | AST a +-- | Describe how to create structured content that has a tree-like syntactic +-- structure, e.g. yaml, JSON and erlang-proplists. The first parameter defines +-- a /context/ into which the 'AST' is embeded, +-- e.g. B9.Content.Generator.Content'. The second parameter defines a specifix +-- syntax, e.g 'B9.Content.ErlangPropList' that the 'AST' value generates. +data AST c a = ASTObj [(String, AST c a)] -- ^ Create an object similar to a + -- Json object. + | ASTArr [AST c a] -- ^ An array. + | ASTMerge [AST c a] -- ^ Merge the nested elements, this is a very + -- powerful tool that allows to combine + -- several inputs in a smart and safe way, + -- e.g. by merging the values of the same + -- fields in yaml objects. + | ASTEmbed c -- Embed some pure content. + | ASTString String -- A string literal. + | ASTParse SourceFile -- An 'AST' obtained from parsing a source + -- file that contains a string corresponding + -- to the type parameter @a@, e.g. 'YamlObject's + | AST a -- Embed a literal @a@. deriving (Read, Show, Typeable, Data, Eq) --- | Structure data into an abstract syntax tree +-- | Types of values that describe content, that can be created from an 'AST'. class (ConcatableSyntax a) => ASTish a where fromAST :: (CanRender c ,Applicative m @@ -62,7 +80,7 @@ => AST c a -> m a --- | Things that produce byte strings. +-- | Types of values that can be /rendered/ into a 'ByteString' class CanRender c where render :: (Functor m ,Applicative m diff --git a/src/lib/B9/Content/StringTemplate.hs b/src/lib/B9/Content/StringTemplate.hs --- a/src/lib/B9/Content/StringTemplate.hs +++ b/src/lib/B9/Content/StringTemplate.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} -{-| Utility functions bnased on 'Data.Text.Template' to offer @ $var @ variable +{-| Utility functions based on 'Data.Text.Template' to offer @ $var @ variable expansion in string throughout a B9 artifact. -} module B9.Content.StringTemplate (subst ,substE diff --git a/src/lib/B9/DiskImages.hs b/src/lib/B9/DiskImages.hs --- a/src/lib/B9/DiskImages.hs +++ b/src/lib/B9/DiskImages.hs @@ -1,12 +1,14 @@ {-| Data types that describe all B9 relevant elements of virtual machine disk - images. -} +images.-} module B9.DiskImages where import Data.Semigroup import Data.Data import System.FilePath --- | Build target for disk images. +-- | Build target for disk images; the destination, format and size of the image +-- to generate, as well as how to create or obtain the image before a +-- 'B9.Vm.VmScript' is executed with the image mounted at a 'MountPoint'. data ImageTarget = ImageTarget ImageDestination ImageSource @@ -19,22 +21,44 @@ -- | The destination of an image. data ImageDestination = Share String ImageType ImageResize + -- ^ Create the image and some meta data so that other + -- builds can use them as 'ImageSource's via 'From'. | LiveInstallerImage String FilePath ImageResize + -- ^ __DEPRECATED__ Export a raw image that can directly + -- be booted. | LocalFile Image ImageResize + -- ^ Write an image file to the path in the first + -- argument., possible resizing it, | Transient + -- ^ Do not export the image. Usefule if the main + -- objective of the b9 build is not an image file, but + -- rather some artifact produced by executing by a + -- containerize build. deriving (Read, Show, Typeable, Data,Eq) -- | Specification of how the image to build is obtained. data ImageSource = EmptyImage String FileSystem ImageType ImageSize + -- ^ Create an empty image file having a file system label + -- (first parameter), a file system type (e.g. 'Ext4') and an + -- 'ImageSize' | CopyOnWrite Image + -- ^ __DEPRECATED__ | SourceImage Image Partition ImageResize + -- ^ Clone an existing image file; if the image file contains + -- partitions, select the partition to use, b9 will extract + -- that partition by reading the offset of the partition from + -- the partition table and extract it using @dd@. | From String ImageResize + -- ^ Use an image previously shared by via 'Share'. deriving (Show,Read,Typeable,Data,Eq) -data Partition = NoPT | Partition Int - deriving (Eq, Show, Read, Typeable, Data) - +-- | The partition to extract. +data Partition = NoPT -- ^ There is no partition table on the image + | Partition Int -- ^ Extract partition @n@ @n@ must be in @0..3@ + deriving (Eq, Show, Read, Typeable, Data) +-- | A vm disk image file consisting of a path to the image file, and the type +-- and file system. data Image = Image FilePath ImageType FileSystem deriving (Eq, Show, Read, Typeable, Data) @@ -50,10 +74,20 @@ data SizeUnit = B | KB | MB | GB deriving (Eq, Show, Read, Ord, Typeable, Data) +-- | How to resize an image file. data ImageResize = ResizeImage ImageSize + -- ^ Resize the image __but not the file system__. Note that + -- a file system contained in the image file might be + -- corrupted by this operation. To not only resize the image + -- file but also the fil system contained in it, use + -- 'Resize'. | Resize ImageSize + -- ^ Resize an image and the contained file system. | ShrinkToMinimum + -- ^ Resize an image and the contained file system to the + -- smallest size to fit the contents of the file system. | KeepSize + -- ^ Do not change the image size. deriving (Eq, Show, Read, Typeable, Data) type Mounted a = (a, MountPoint) @@ -87,7 +121,8 @@ changeImageDirectory dir (Image img fmt fs) = Image img' fmt fs where img' = dir takeFileName img --- | 'SharedImage' holds all data necessary to identify an image shared. +-- | 'SharedImage' holds all data necessary to identify an image shared. Shared +-- images are stored in 'B9.Repository's. data SharedImage = SharedImage SharedImageName SharedImageDate SharedImageBuildId diff --git a/src/lib/B9/LibVirtLXC.hs b/src/lib/B9/LibVirtLXC.hs --- a/src/lib/B9/LibVirtLXC.hs +++ b/src/lib/B9/LibVirtLXC.hs @@ -32,22 +32,23 @@ setUp = do cfg <- configureLibVirtLXC buildId <- getBuildId - buildDir <- getBuildDir + buildBaseDir <- getBuildDir uuid <- randomUUID let scriptDirHost = buildDir "init-script" scriptDirGuest = "/" ++ buildId + domainFile = buildBaseDir uuid' <.> domainConfig domain = createDomain cfg env buildId uuid' scriptDirHost scriptDirGuest uuid' = printf "%U" uuid script = Begin [scriptIn, successMarkerCmd scriptDirGuest] - domainFile <- ( domainConfig) <$> getBuildDir + buildDir = buildBaseDir uuid' liftIO $ do createDirectoryIfMissing True scriptDirHost writeSh (scriptDirHost initScript) script writeFile domainFile domain return $ Context scriptDirHost uuid domainFile cfg successMarkerCmd scriptDirGuest = - As "root" [In scriptDirGuest [Run "touch" [successMarkerFile]]] + In scriptDirGuest [Run "touch" [successMarkerFile]] execute (Context scriptDirHost uuid domainFile cfg) = do let virsh = virshCommand cfg diff --git a/src/lib/B9/Repository.hs b/src/lib/B9/Repository.hs --- a/src/lib/B9/Repository.hs +++ b/src/lib/B9/Repository.hs @@ -1,9 +1,8 @@ -{-| B9 has a concept of shared images. Images can be pulled and pushed to/from - remote locations via rsync+ssh. B9 also maintains a local cache; the whole - thing is supposed to be build-server-safe, that means no two builds shall - interfere with each other. This is accomplished by refraining from - automatic cache updates from/to remote repositories. - -} +{-| B9 has a concept of 'B9.DiskImages.SharedImaged'. Shared images can be pulled and +pushed to/from remote locations via rsync+ssh. B9 also maintains a local cache; +the whole thing is supposed to be build-server-safe, that means no two builds +shall interfere with each other. This is accomplished by refraining from +automatic cache updates from/to remote repositories.-} module B9.Repository (RemoteRepo(..) ,remoteRepoRepoId ,RepoCache(..)