diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/b9.cabal b/b9.cabal --- a/b9.cabal +++ b/b9.cabal @@ -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 diff --git a/src/lib/B9/B9Config/LibVirtLXC.hs b/src/lib/B9/B9Config/LibVirtLXC.hs --- a/src/lib/B9/B9Config/LibVirtLXC.hs +++ b/src/lib/B9/B9Config/LibVirtLXC.hs @@ -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 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 @@ -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 =