From 07e007db294b7dcb22142811a49e2c65a2070a9b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 4 Jul 2017 11:32:26 -0400 Subject: Bootstrap.clonedFrom: Fix bug that broke copying .git/config into chroot. --- debian/changelog | 2 ++ 1 file changed, 2 insertions(+) (limited to 'debian/changelog') diff --git a/debian/changelog b/debian/changelog index be8ae96e..29eb985e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,8 @@ propellor (4.0.7) UNRELEASED; urgency=medium exposed. * Bugfix: Apache.httpsVirtualHost' must create ssl/hn/ dir earlier Thanks, Sean Whitton. + * Bootstrap.clonedFrom: Fix bug that broke copying .git/config into + chroot. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 -- cgit v1.2.3 From aa171af9aee49b0dbd2800d19a029e3506423f3f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 4 Jul 2017 11:54:31 -0400 Subject: Diskimage.imageExists: Align disk image size to multiple of 4096 sector size Since some programs (such as VBoxManage convertdd) refuse to operate on disk images not aligned to a sector size. This commit was sponsored by Boyd Stephen Smith Jr. on Patreon. --- debian/changelog | 3 +++ src/Propellor/Property/DiskImage.hs | 8 +++++++- 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'debian/changelog') diff --git a/debian/changelog b/debian/changelog index 29eb985e..8fdfdf00 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,9 @@ propellor (4.0.7) UNRELEASED; urgency=medium Thanks, Sean Whitton. * Bootstrap.clonedFrom: Fix bug that broke copying .git/config into chroot. + * Diskimage.imageExists: Align disk image size to multiple of 4096 + sector size, since some programs (such as VBoxManage convertdd) + refuse to operate on disk images not aligned to a sector size. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 90b7010b..d5898d7c 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -247,7 +247,7 @@ getMountSz szm l (Just mntpt) = -- -- If the file is too large, truncates it down to the specified size. imageExists :: FilePath -> ByteSize -> Property Linux -imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do +imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do ms <- catchMaybeIO $ getFileStatus img case ms of Just s @@ -258,6 +258,12 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do _ -> do L.writeFile img (L.replicate (fromIntegral sz) 0) return MadeChange + where + sz = ceiling (fromInteger isz / sectorsize) * ceiling sectorsize + -- Disks have a sector size, and making a disk image not + -- aligned to a sector size will confuse some programs. + -- Common sector sizes are 512 and 4096; use 4096 as it's larger. + sectorsize = 4096 :: Double -- | A pair of properties. The first property is satisfied within the -- chroot, and is typically used to download the boot loader. -- cgit v1.2.3 From c503e4f8458f4794ef153f3eda2cceb9c9741804 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 4 Jul 2017 12:23:41 -0400 Subject: Bootstrap.bootstrappedFrom: Fix bug that caused propellor to only be built from the bootstrapped config the first time. When the config changes, the bootstrapped propellor needs to get rebuilt. This commit was sponsored by Fernando Jimenez on Patreon. --- debian/changelog | 2 ++ src/Propellor/Bootstrap.hs | 2 ++ src/Propellor/Property/Bootstrap.hs | 3 ++- 3 files changed, 6 insertions(+), 1 deletion(-) (limited to 'debian/changelog') diff --git a/debian/changelog b/debian/changelog index 8fdfdf00..7ef4dfe7 100644 --- a/debian/changelog +++ b/debian/changelog @@ -10,6 +10,8 @@ propellor (4.0.7) UNRELEASED; urgency=medium * Diskimage.imageExists: Align disk image size to multiple of 4096 sector size, since some programs (such as VBoxManage convertdd) refuse to operate on disk images not aligned to a sector size. + * Bootstrap.bootstrappedFrom: Fix bug that caused propellor to only + be built from the bootstrapped config the first time. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index a3b7f315..4b3f2da2 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -3,6 +3,8 @@ module Propellor.Bootstrap ( checkBinaryCommand, installGitCommand, buildPropellor, + checkDepsCommand, + buildCommand, ) where import Propellor.Base diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index c6abe6b6..099559ad 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -35,7 +35,8 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource assumeChange $ exposeTrueLocaldir $ const $ runShellCommand $ buildShellCommand [ "cd " ++ localdir - , bootstrapPropellorCommand system + , checkDepsCommand system + , buildCommand ] -- | Clones the propellor repeository into /usr/local/propellor/ -- cgit v1.2.3 From faca829d537fd1e284483ba1bd0cfb8eaf0ed047 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 4 Jul 2017 12:38:21 -0400 Subject: Bootstrap.bootstrappedFrom: Avoid doing anything when not run in a chroot. This way, when a disk image is built using this property, and booted up, running propellor won't try to ensure this property again. This commit was sponsored by Jeff Goeke-Smith on Patreon. --- debian/changelog | 2 ++ src/Propellor/Property/Bootstrap.hs | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'debian/changelog') diff --git a/debian/changelog b/debian/changelog index 7ef4dfe7..c52b8329 100644 --- a/debian/changelog +++ b/debian/changelog @@ -12,6 +12,8 @@ propellor (4.0.7) UNRELEASED; urgency=medium refuse to operate on disk images not aligned to a sector size. * Bootstrap.bootstrappedFrom: Fix bug that caused propellor to only be built from the bootstrapped config the first time. + * Bootstrap.bootstrappedFrom: Avoid doing anything when not run in a + chroot. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 099559ad..767d6ef7 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -17,17 +17,17 @@ data RepoSource -- | Bootstraps a propellor installation into -- /usr/local/propellor/ -- --- Normally, propellor is already bootstrapped when it runs, so this --- property is not useful. However, this can be useful inside a --- chroot used to build a disk image, to make the disk image --- have propellor installed. +-- This property only does anything when used inside a chroot. +-- This is particularly useful inside a chroot used to build a +-- disk image, to make the disk image have propellor installed. -- -- The git repository is cloned (or pulled to update if it already exists). -- -- All build dependencies are installed, using distribution packages -- or falling back to using cabal. bootstrappedFrom :: RepoSource -> Property Linux -bootstrappedFrom reposource = go `requires` clonedFrom reposource +bootstrappedFrom reposource = check inChroot $ + go `requires` clonedFrom reposource where go :: Property Linux go = property "Propellor bootstrapped" $ do -- cgit v1.2.3 From 2b9d5ca90f053ad21fbbab89b3045bd0822400d5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Jul 2017 13:52:29 -0400 Subject: avoid buffering container chain output When provisioning a container, output was buffered until the whole process was done; now output will be displayed immediately. I know this didn't used to be a problem. I belive it was introduced by accident when propellor started using concurrent-output. I know I've seen it for a while and never was bothered enough to get to the bottom of it; apparently "a while" was longer than I thought. Also refactored code to do with chain provisioning to all be in Propellor.Engine and avoided some duplication. This commit was sponsored by Anthony DeRobertis on Patreon. --- debian/changelog | 2 ++ src/Propellor/Engine.hs | 56 ++++++++++++++++++++++++++++++++++++++++ src/Propellor/Message.hs | 23 ----------------- src/Propellor/Property/Chroot.hs | 18 +++++-------- src/Propellor/Property/Docker.hs | 10 +++---- 5 files changed, 69 insertions(+), 40 deletions(-) (limited to 'debian/changelog') diff --git a/debian/changelog b/debian/changelog index c52b8329..34ea28f4 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,6 +14,8 @@ propellor (4.0.7) UNRELEASED; urgency=medium be built from the bootstrapped config the first time. * Bootstrap.bootstrappedFrom: Avoid doing anything when not run in a chroot. + * When provisioning a container, output was buffered until the whole + process was done; now output will be displayed immediately. -- Joey Hess Tue, 20 Jun 2017 10:55:37 -0400 diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 08f535e0..f54da929 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -8,6 +8,8 @@ module Propellor.Engine ( fromHost, fromHost', onlyProcess, + chainPropellor, + runChainPropellor, ) where import System.Exit @@ -17,7 +19,9 @@ import "mtl" Control.Monad.RWS.Strict import System.PosixCompat import System.Posix.IO import System.FilePath +import System.Console.Concurrent import Control.Applicative +import Control.Concurrent.Async import Prelude import Propellor.Types @@ -28,6 +32,8 @@ import Propellor.Exception import Propellor.Info import Utility.Exception import Utility.Directory +import Utility.Process +import Utility.PartialPrelude -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done. @@ -96,3 +102,53 @@ onlyProcess lockfile a = bracket lock unlock (const a) return l unlock = closeFd alreadyrunning = error "Propellor is already running on this host!" + +-- | Chains to a propellor sub-Process, forwarding its output on to the +-- display, except for the last line which is a Result. +chainPropellor :: CreateProcess -> IO Result +chainPropellor p = + -- We want to use outputConcurrent to display output + -- as it's received. If only stdout were captured, + -- concurrent-output would buffer all outputConcurrent. + -- Also capturing stderr avoids that problem. + withOEHandles createProcessSuccess p $ \(outh, errh) -> do + (r, ()) <- processChainOutput outh + `concurrently` forwardChainError errh + return r + +-- | Reads and displays each line from the Handle, except for the last line +-- which is a Result. +processChainOutput :: Handle -> IO Result +processChainOutput h = go Nothing + where + go lastline = do + v <- catchMaybeIO (hGetLine h) + case v of + Nothing -> case lastline of + Nothing -> do + return FailedChange + Just l -> case readish l of + Just r -> pure r + Nothing -> do + outputConcurrent (l ++ "\n") + return FailedChange + Just s -> do + outputConcurrent $ + maybe "" (\l -> if null l then "" else l ++ "\n") lastline + go (Just s) + +forwardChainError :: Handle -> IO () +forwardChainError h = do + v <- catchMaybeIO (hGetLine h) + case v of + Nothing -> return () + Just s -> do + errorConcurrent (s ++ "\n") + forwardChainError h + +-- | Used by propellor sub-Processes that are run by chainPropellor. +runChainPropellor :: Host -> Propellor Result -> IO () +runChainPropellor h a = do + r <- runPropellor h a + flushConcurrentOutput + putStrLn $ "\n" ++ show r diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index c56f0c5a..7715088f 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -14,7 +14,6 @@ module Propellor.Message ( infoMessage, errorMessage, stopPropellorMessage, - processChainOutput, messagesDone, createProcessConcurrent, withConcurrentOutput, @@ -31,7 +30,6 @@ import Prelude import Propellor.Types import Propellor.Types.Exception -import Utility.PartialPrelude import Utility.Monad import Utility.Exception @@ -142,27 +140,6 @@ colorLine intensity color msg = concat <$> sequence , pure "\n" ] --- | Reads and displays each line from the Handle, except for the last line --- which is a Result. -processChainOutput :: Handle -> IO Result -processChainOutput h = go Nothing - where - go lastline = do - v <- catchMaybeIO (hGetLine h) - case v of - Nothing -> case lastline of - Nothing -> do - return FailedChange - Just l -> case readish l of - Just r -> pure r - Nothing -> do - outputConcurrent (l ++ "\n") - return FailedChange - Just s -> do - outputConcurrent $ - maybe "" (\l -> if null l then "" else l ++ "\n") lastline - go (Just s) - -- | Called when all messages about properties have been printed. messagesDone :: IO () messagesDone = outputConcurrent diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index ad2ae705..65749e34 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -37,7 +37,6 @@ import Utility.Split import qualified Data.Map as M import System.Posix.Directory -import System.Console.Concurrent -- | Specification of a chroot. Normally you'll use `debootstrapped` or -- `bootstrapped` to construct a Chroot value. @@ -201,9 +200,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " , "--continue" , show cmd ] - let p' = p { env = Just pe } - r <- liftIO $ withHandle StdoutHandle createProcessSuccess p' - processChainOutput + r <- liftIO $ chainPropellor (p { env = Just pe }) liftIO cleanup return r @@ -223,13 +220,12 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = go h = do changeWorkingDirectory localdir when onconsole forceConsole - onlyProcess (provisioningLock loc) $ do - r <- runPropellor (setInChroot h) $ ensureChildProperties $ - if systemdonly - then [toChildProperty Systemd.installed] - else hostProperties h - flushConcurrentOutput - putStrLn $ "\n" ++ show r + onlyProcess (provisioningLock loc) $ + runChainPropellor (setInChroot h) $ + ensureChildProperties $ + if systemdonly + then [toChildProperty Systemd.installed] + else hostProperties h chain _ _ = errorMessage "bad chain command" inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ()) diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index d53bab71..66418253 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -576,8 +576,7 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d let p = inContainerProcess cid (if isConsole msgh then ["-it"] else []) (shim : params) - r <- withHandle StdoutHandle createProcessSuccess p $ - processChainOutput + r <- chainPropellor p when (r /= FailedChange) $ setProvisionedFlag cid return r @@ -596,10 +595,9 @@ chain hostlist hn s = case toContainerId s of where go cid h = do changeWorkingDirectory localdir - onlyProcess (provisioningLock cid) $ do - r <- runPropellor h $ ensureChildProperties $ hostProperties h - flushConcurrentOutput - putStrLn $ "\n" ++ show r + onlyProcess (provisioningLock cid) $ + runChainPropellor h $ + ensureChildProperties $ hostProperties h stopContainer :: ContainerId -> IO Bool stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ] -- cgit v1.2.3