b9 3.1.0 → 3.2.0

raw patch · 5 files changed

+84/−15 lines, 5 filesdep +temporaryPVP ok

version bump matches the API change (PVP)

Dependencies added: temporary

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +13/−1
• b9.cabal +2/−1
• src/lib/B9/B9Config/LibVirtLXC.hs +12/−3
• src/lib/B9/LibVirtLXC.hs +51/−10

@@ -1,5 +1,11 @@ # Changelog for B9 +## 3.2.0++* Workarounds for libvirtd path length restrictions; +  Libvirt doesn't like paths longer than 63+* Add config file option `image_file_names_shortener_base_path`+ ## 3.1.0  * Introduced `getVirtualSizeForRawImage`, `cmdStdout`, `hostCmdStdoutEither`, `HostCommandStdout`.

@@ -25,7 +25,7 @@  * As **command line utility** in current directory: -      $ nix-env -f https://github.com/sheyll/b9-vm-image-builder/archive/3.1.0.tar.gz -iA b9c+      $ nix-env -f https://github.com/sheyll/b9-vm-image-builder/archive/3.2.0.tar.gz -iA b9c      ### Runtime dependencies @@ -595,3 +595,15 @@ * Default: `[]`  List of options for `mkfs.ext4 -O`.++#### `image_file_names_shortener_base_path`++* Default: `Nothing`++If `(Just "/path")` is specified, images passed to libvirt are hard linked to +a random subdirectory in `/path/`, such that the name will be short enough+to match libvirtds file name length restriction.+NOTE: The hard links have to be on the same file system as their targets.++Together with `keep_temp_dirs` the paths can be inspected, but also have to +be manually removed.

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                b9-version:             3.1.0+version:             3.2.0  synopsis:            A tool and library for building virtual machine images. @@ -183,6 +183,7 @@                    , syb >= 0.6 && < 1                    , tagged >= 0.8 && < 0.9                    , template >= 0.2 && < 1+                   , temporary >= 1.3 && < 1.4                    , time >= 1.6 && < 2                    , transformers >= 0.5 && < 1                    , unix >= 2.7 && < 3

@@ -26,7 +26,8 @@         virshURI :: FilePath,         _networkId :: Maybe String,         guestCapabilities :: [ContainerCapability],-        guestRamSize :: RamSize+        guestRamSize :: RamSize,+        imageFileNameShortenerBasePath :: Maybe FilePath       }   deriving (Read, Show, Eq) @@ -38,7 +39,8 @@     smaller arbitraryFilePath <*>     smaller (oneof [pure Nothing, Just <$> listOf1 arbitraryLetter]) <*>     smaller arbitrary <*>-    pure (RamSize 4 GB)+    pure (RamSize 4 GB) <*>+    smaller (oneof [pure Nothing, Just <$> arbitraryFilePath])  makeLenses ''LibVirtLXCConfig @@ -60,6 +62,7 @@       CAP_SYS_MODULE     ]     (RamSize 1 GB)+    Nothing  cfgFileSection :: String cfgFileSection = "libvirt-lxc"@@ -84,6 +87,9 @@ guestRamSizeK :: String guestRamSizeK = "guest_ram_size" +imageFileNamesShortenerBasePathK :: String+imageFileNamesShortenerBasePathK = "image_file_names_shortener_base_path"+ libVirtLXCConfigToCPDocument ::   LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument libVirtLXCConfigToCPDocument c cp = do@@ -93,7 +99,9 @@   cp4 <- setCP cp3 cfgFileSection virshURIK $ virshURI c   cp5 <- setShowCP cp4 cfgFileSection networkIdK $ _networkId c   cp6 <- containerCapsToCPDocument cp5 cfgFileSection $ guestCapabilities c-  setShowCP cp6 cfgFileSection guestRamSizeK $ guestRamSize c+  cp7 <- setShowCP cp6 cfgFileSection guestRamSizeK $ guestRamSize c+  cpFinal <- setShowCP cp7 cfgFileSection imageFileNamesShortenerBasePathK $ imageFileNameShortenerBasePath c+  return cpFinal  parseLibVirtLXCConfig :: CPDocument -> Either CPError LibVirtLXCConfig parseLibVirtLXCConfig cp =@@ -106,6 +114,7 @@         <*> getr networkIdK         <*> parseContainerCapabilities cp cfgFileSection         <*> getr guestRamSizeK+        <*> getr imageFileNamesShortenerBasePathK  -- | Return the path to @/usr/lib/libvirt/libexec/libvirt_lxc@ --  the 'emulatorK' field from the config file, or set the path

@@ -1,3 +1,4 @@+{-# LANGUAGE InstanceSigs #-} -- | Implementation of an execution environment that uses "libvirt-lxc". module B9.LibVirtLXC   ( LibVirtLXC (..),@@ -6,10 +7,11 @@ where  import B9.B9Config-  ( B9ConfigReader,+  (getConfig,  B9ConfigReader,     ContainerCapability,     getB9Config,     libVirtLXCConfigs,+    keepTempDirs   ) import B9.B9Config.LibVirtLXC as X import B9.B9Error@@ -21,11 +23,12 @@ import B9.ExecEnv import B9.ShellScript import Control.Eff-import Control.Lens (view)+import Control.Lens ((^.), view) import Control.Monad.IO.Class   ( MonadIO,     liftIO,   )+import Control.Monad.Trans.Control import Data.Char (toLower) import System.Directory import System.FilePath@@ -33,6 +36,8 @@   ( UUID (),     randomUUID,   )+import qualified System.IO.Temp as Temp+import qualified System.Posix.Files as Files import Text.Printf (printf)  newtype LibVirtLXC = LibVirtLXC LibVirtLXCConfig@@ -41,20 +46,30 @@   getBackendConfig _ =     fmap LibVirtLXC . view libVirtLXCConfigs <$> getB9Config   supportedImageTypes _ = [Raw]-  runInEnvironment (LibVirtLXC cfgIn) env scriptIn =-    if emptyScript scriptIn-      then return True-      else setUp >>= execute+  runInEnvironment ::+    forall e.+    (Member BuildInfoReader e, CommandIO e, Member ExcB9 e) =>+    LibVirtLXC ->+    ExecEnv ->+    Script ->+    Eff e Bool+  runInEnvironment (LibVirtLXC cfgIn) env scriptIn = do+    imageFileNamesShortenerMechanism <- getImageFileNamesShortenerMechanism (imageFileNameShortenerBasePath cfgIn)+    control $ \runInIO -> do+      imageFileNamesShortenerMechanism $ \shortenImageFileNamesInEnvAction ->+        runInIO (if emptyScript scriptIn+          then return True+          else setUp shortenImageFileNamesInEnvAction >>= execute)     where-      setUp = do+      setUp shortenImageFileNamesInEnvAction = do         buildId <- getBuildId         buildBaseDir <- getBuildDir         uuid <- randomUUID         let scriptDirHost = buildDir </> "init-script"             scriptDirGuest = "/" ++ buildId             domainFile = buildBaseDir </> uuid' <.> domainConfig-            mkDomain =-              createDomain cfgIn env buildId uuid' scriptDirHost scriptDirGuest+            mkDomain envToUse =+              createDomain cfgIn envToUse buildId uuid' scriptDirHost scriptDirGuest             uuid' = printf "%U" uuid             setupEnv =               Begin@@ -67,9 +82,35 @@         liftIO $ do           createDirectoryIfMissing True scriptDirHost           writeSh (scriptDirHost </> initScript) script-          domain <- mkDomain+          envToUse <- shortenImageFileNamesInEnvAction env+          domain <- mkDomain envToUse           writeFile domainFile domain         return $ Context scriptDirHost uuid domainFile cfgIn++imageFileNamesShortenerTemplate :: String+imageFileNamesShortenerTemplate = ".t"++shortenImageFileNamesInEnv :: FilePath -> ExecEnv -> IO ExecEnv+shortenImageFileNamesInEnv tmpDir origEnv = do+  let images = envImageMounts origEnv+  newImages <- mapM shortenImageFileName (zip [0..] images)+  return origEnv { envImageMounts = newImages }+  where+    shortenImageFileName :: (Integer, Mounted Image) -> IO (Mounted Image)+    shortenImageFileName (num, (Image fp it fs, mp)) = do+      let newFp = tmpDir </> (show num) <.> takeExtension fp+      Files.createLink fp newFp+      return (Image newFp it fs, mp)++getImageFileNamesShortenerMechanism :: Member B9ConfigReader e => Maybe FilePath -> Eff e (((ExecEnv -> IO ExecEnv) -> IO a) -> IO a)+getImageFileNamesShortenerMechanism maybeShortImageLinkDir = case maybeShortImageLinkDir of+  Nothing -> return (\action -> action return)+  Just parent -> do+      b9config <- getConfig+      let tempDirCreator = if b9config ^. keepTempDirs+                                     then \t -> (Temp.createTempDirectory parent t >>=)+                                     else Temp.withTempDirectory parent+      return (\action -> tempDirCreator imageFileNamesShortenerTemplate $ \fp -> action (shortenImageFileNamesInEnv fp))  successMarkerCmd :: FilePath -> Script successMarkerCmd scriptDirGuest =