summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs5
-rw-r--r--src/Propellor/Gpg.hs22
-rw-r--r--src/Propellor/Message.hs2
-rw-r--r--src/Propellor/PrivData.hs6
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Spin.hs22
7 files changed, 36 insertions, 25 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 4bca3986..4a4f71fe 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -120,8 +120,9 @@ defaultMain hostlist = withConcurrentOutput $ do
go False (Spin hs mrelay) = do
commitSpin
forM_ hs $ \hn -> withhost hn $ spin mrelay hn
- go False cmdline@(SimpleRun hn) = buildFirst cmdline $
- go False (Run hn)
+ go False cmdline@(SimpleRun hn) = do
+ forceConsole
+ buildFirst cmdline $ go False (Run hn)
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
( onlyprocess $ withhost hn mainProperties
, go True (Spin [hn] Nothing)
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index 60b0d52d..960c70d3 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -7,6 +7,8 @@ import System.Directory
import Data.Maybe
import Data.List.Utils
import Control.Monad
+import System.Console.Concurrent
+import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
import Propellor.PrivData.Paths
import Propellor.Message
@@ -111,10 +113,7 @@ gitCommitKeyRing action = do
-- Commit explicitly the keyring and privdata files, as other
-- changes may be staged by the user and shouldn't be committed.
tocommit <- filterM doesFileExist [ privDataFile, keyring]
- gitCommit $ (map File tocommit) ++
- [ Param "-m"
- , Param ("propellor " ++ action)
- ]
+ gitCommit (Just ("propellor " ++ action)) (map File tocommit)
-- Adds --gpg-sign if there's a keyring.
gpgSignParams :: [CommandParam] -> IO [CommandParam]
@@ -124,10 +123,17 @@ gpgSignParams ps = ifM (doesFileExist keyring)
)
-- Automatically sign the commit if there'a a keyring.
-gitCommit :: [CommandParam] -> IO Bool
-gitCommit ps = do
- ps' <- gpgSignParams ps
- boolSystem "git" (Param "commit" : ps')
+gitCommit :: Maybe String -> [CommandParam] -> IO Bool
+gitCommit msg ps = do
+ let ps' = Param "commit" : ps ++
+ maybe [] (\m -> [Param "-m", Param m]) msg
+ ps'' <- gpgSignParams ps'
+ if isNothing msg
+ then do
+ (_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $
+ proc "git" (toCommand ps'')
+ checkSuccessProcess p
+ else boolSystem "git" ps''
gpgDecrypt :: FilePath -> IO String
gpgDecrypt f = ifM (doesFileExist f)
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 7df5104a..e964c664 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -25,9 +25,9 @@ import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Applicative
import System.IO.Unsafe (unsafePerformIO)
import Control.Concurrent
+import System.Console.Concurrent
import Propellor.Types
-import Utility.ConcurrentOutput
import Utility.PartialPrelude
import Utility.Monad
import Utility.Exception
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index e59f42c3..a1e34abc 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -36,6 +36,8 @@ import "mtl" Control.Monad.Reader
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L
+import System.Console.Concurrent
+import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
import Propellor.Types
import Propellor.Types.PrivData
@@ -54,6 +56,7 @@ import Utility.FileMode
import Utility.Env
import Utility.Table
import Utility.FileSystemEncoding
+import Utility.Process
-- | Allows a Property to access the value of a specific PrivDataField,
-- for use in a specific Context or HostContext.
@@ -192,7 +195,8 @@ editPrivData field context = do
hClose th
maybe noop (\p -> writeFileProtected' f (`L.hPut` privDataByteString p)) v
editor <- getEnvDefault "EDITOR" "vi"
- unlessM (boolSystem editor [File f]) $
+ (_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $ proc editor [f]
+ unlessM (checkSuccessProcess p) $
error "Editor failed; aborting."
PrivData <$> readFile f
setPrivDataTo field context v'
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 0c00e8f4..8d1a2388 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -27,11 +27,11 @@ import qualified Propellor.Property.Systemd.Core as Systemd
import qualified Propellor.Property.File as File
import qualified Propellor.Shim as Shim
import Propellor.Property.Mount
-import Utility.ConcurrentOutput
import qualified Data.Map as M
import Data.List.Utils
import System.Posix.Directory
+import System.Console.Concurrent
-- | Specification of a chroot. Normally you'll use `debootstrapped` or
-- `bootstrapped` to construct a Chroot value.
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index f2dbaaf5..0cc8212b 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -56,7 +56,6 @@ import qualified Propellor.Property.Cmd as Cmd
import qualified Propellor.Shim as Shim
import Utility.Path
import Utility.ThreadScheduler
-import Utility.ConcurrentOutput
import Control.Concurrent.Async hiding (link)
import System.Posix.Directory
@@ -65,6 +64,7 @@ import Prelude hiding (init)
import Data.List hiding (init)
import Data.List.Utils
import qualified Data.Map as M
+import System.Console.Concurrent
installed :: Property NoInfo
installed = Apt.installed ["docker.io"]
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 478d1517..ae7e7af5 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -29,12 +29,12 @@ import Propellor.Types.Info
import qualified Propellor.Shim as Shim
import Utility.FileMode
import Utility.SafeCommand
-import Utility.ConcurrentOutput
commitSpin :: IO ()
commitSpin = do
void $ actionMessage "Git commit" $
- gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param spinCommitMessage]
+ gitCommit (Just spinCommitMessage)
+ [Param "--allow-empty", Param "-a"]
-- Push to central origin repo first, if possible.
-- The remote propellor will pull from there, which avoids
-- us needing to send stuff directly to the remote host.
@@ -61,10 +61,9 @@ spin' mprivdata relay target hst = do
updateServer target relay hst
(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
- getprivdata
+ =<< getprivdata
-- And now we can run it.
- flushConcurrentOutput
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
error "remote propellor failed"
where
@@ -191,16 +190,16 @@ updateServer
-> Host
-> CreateProcess
-> CreateProcess
- -> IO PrivMap
+ -> PrivMap
-> IO ()
-updateServer target relay hst connect haveprecompiled getprivdata =
+updateServer target relay hst connect haveprecompiled privdata =
withIOHandles createProcessSuccess connect go
where
hn = fromMaybe target relay
go (toh, fromh) = do
let loop = go (toh, fromh)
- let restart = updateServer hn relay hst connect haveprecompiled getprivdata
+ let restart = updateServer hn relay hst connect haveprecompiled privdata
let done = return ()
v <- maybe Nothing readish <$> getMarked fromh statusMarker
case v of
@@ -208,7 +207,7 @@ updateServer target relay hst connect haveprecompiled getprivdata =
sendRepoUrl toh
loop
(Just NeedPrivData) -> do
- sendPrivData hn toh =<< getprivdata
+ sendPrivData hn toh privdata
loop
(Just NeedGitClone) -> do
hClose toh
@@ -219,7 +218,7 @@ updateServer target relay hst connect haveprecompiled getprivdata =
hClose toh
hClose fromh
sendPrecompiled hn
- updateServer hn relay hst haveprecompiled (error "loop") getprivdata
+ updateServer hn relay hst haveprecompiled (error "loop") privdata
(Just NeedGitPush) -> do
sendGitUpdate hn fromh toh
hClose fromh
@@ -338,8 +337,9 @@ mergeSpin = do
old_head <- getCurrentGitSha1 branch
old_commit <- findLastNonSpinCommit
rungit "reset" [Param old_commit]
- rungit "commit" [Param "-a", Param "--allow-empty"]
- rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head]
+ unlessM (gitCommit Nothing [Param "-a", Param "--allow-empty"]) $
+ error "git commit failed"
+ rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head, Param "--no-edit"]
current_commit <- getCurrentGitSha1 branch
rungit "update-ref" [Param branchref, Param current_commit]
rungit "checkout" [Param branch]