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. --- src/Propellor/Engine.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) (limited to 'src/Propellor/Engine.hs') 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 -- cgit v1.2.3