summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-11-22 12:13:41 -0400
committerJoey Hess2014-11-22 12:13:41 -0400
commit7cbf4841de39761953cf31d32ed86bb4bd949672 (patch)
tree3d8bb9ecd83a24494a40de5211a10f19036a2949 /src/Propellor
parent557fab609175d7d0a59ffe1269fed02f49f8004e (diff)
parent57ec60d6f307dbf3e237b924e635b90ba889af18 (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs27
-rw-r--r--src/Propellor/Engine.hs15
-rw-r--r--src/Propellor/Git.hs2
-rw-r--r--src/Propellor/Protocol.hs2
-rw-r--r--src/Propellor/Server.hs63
-rw-r--r--src/Propellor/Shim.hs2
6 files changed, 85 insertions, 26 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 142efa1d..ec2ca7ed 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -114,16 +114,19 @@ unknownhost h hosts = errorMessage $ unlines
]
buildFirst :: CmdLine -> IO () -> IO ()
-buildFirst cmdline next = do
- oldtime <- getmtime
- ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
- ( do
- newtime <- getmtime
- if newtime == oldtime
- then next
- else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
- , errorMessage "Propellor build failed!"
- )
+buildFirst cmdline next = ifM (doesFileExist "Makefile")
+ ( do
+ oldtime <- getmtime
+ ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
+ ( do
+ newtime <- getmtime
+ if newtime == oldtime
+ then next
+ else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
+ , errorMessage "Propellor build failed!"
+ )
+ , next
+ )
where
getmtime = catchMaybeIO $ getModificationTime "propellor"
@@ -172,11 +175,11 @@ spin hn hst = do
updatecmd = mkcmd
[ "if [ ! -d " ++ localdir ++ " ]"
- , "then " ++ intercalate " && "
+ , "then (" ++ intercalate " && "
[ "apt-get update"
, "apt-get --no-install-recommends --no-upgrade -y install git make"
, "echo " ++ toMarked statusMarker (show NeedGitClone)
- ]
+ ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
, "else " ++ intercalate " && "
[ "cd " ++ localdir
, "if ! test -x ./propellor; then make deps build; fi"
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 969769ce..b551ca05 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -11,7 +11,6 @@ import "mtl" Control.Monad.Reader
import Control.Exception (bracket)
import System.PosixCompat
import System.Posix.IO
-import Data.Maybe
import Propellor.Types
import Propellor.Message
@@ -28,7 +27,9 @@ mainProperties :: Host -> IO ()
mainProperties host = do
r <- runPropellor host $
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
- setTitle "propellor: done"
+ h <- mkMessageHandle
+ whenConsole h $
+ setTitle "propellor: done"
hFlush stdout
case r of
FailedChange -> exitWith (ExitFailure 1)
@@ -74,8 +75,14 @@ processChainOutput h = go Nothing
go lastline = do
v <- catchMaybeIO (hGetLine h)
case v of
- Nothing -> pure $ fromMaybe FailedChange $
- readish =<< lastline
+ Nothing -> case lastline of
+ Nothing -> pure FailedChange
+ Just l -> case readish l of
+ Just r -> pure r
+ Nothing -> do
+ putStrLn l
+ hFlush stdout
+ return FailedChange
Just s -> do
maybe noop (\l -> unless (null l) (putStrLn l)) lastline
hFlush stdout
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 73de1def..e5f464c0 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -38,7 +38,7 @@ getRepoUrl = getM get urls
_ -> Nothing
hasOrigin :: IO Bool
-hasOrigin = do
+hasOrigin = catchDefaultIO False $ do
rs <- lines <$> readProcess "git" ["remote"]
return $ "origin" `elem` rs
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 68c2443b..95a671bc 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -13,7 +13,7 @@ import Data.List
import Propellor
-data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush
+data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled
deriving (Read, Show, Eq)
type Marker = String
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index 513a81f4..19a2c901 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -1,3 +1,7 @@
+-- When propellor --spin is running, the local host acts as a server,
+-- which connects to the remote host's propellor and responds to its
+-- requests.
+
module Propellor.Server (
update,
updateServer,
@@ -8,7 +12,9 @@ import Data.List
import System.Exit
import System.PosixCompat
import System.Posix.IO
+import System.Posix.Directory
import Control.Concurrent.Async
+import Control.Exception (bracket)
import qualified Data.ByteString as B
import Propellor
@@ -16,6 +22,7 @@ import Propellor.Protocol
import Propellor.PrivData.Paths
import Propellor.Git
import Propellor.Ssh
+import qualified Propellor.Shim as Shim
import Utility.FileMode
import Utility.SafeCommand
@@ -24,17 +31,19 @@ import Utility.SafeCommand
-- running the updateServer
update :: IO ()
update = do
- req NeedRepoUrl repoUrlMarker setRepoUrl
+ whenM hasOrigin $
+ req NeedRepoUrl repoUrlMarker setRepoUrl
makePrivDataDir
req NeedPrivData privDataMarker $
writeFileProtected privDataLocal
- req NeedGitPush gitPushMarker $ \_ -> do
- hin <- dup stdInput
- hout <- dup stdOutput
- hClose stdin
- hClose stdout
- unlessM (boolSystem "git" (pullparams hin hout)) $
- errorMessage "git pull from client failed"
+ whenM hasOrigin $
+ req NeedGitPush gitPushMarker $ \_ -> do
+ hin <- dup stdInput
+ hout <- dup stdOutput
+ hClose stdin
+ hClose stdout
+ unlessM (boolSystem "git" (pullparams hin hout)) $
+ errorMessage "git pull from client failed"
where
pullparams hin hout =
[ Param "pull"
@@ -69,6 +78,11 @@ updateServer hn hst connect = connect go
hClose fromh
sendGitClone hn
updateServer hn hst connect
+ (Just NeedPrecompiled) -> do
+ hClose toh
+ hClose fromh
+ sendPrecompiled hn
+ updateServer hn hst connect
Nothing -> return ()
sendRepoUrl :: Handle -> IO ()
@@ -113,6 +127,39 @@ sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
, "rm -f " ++ remotebundle
]
+-- Send a tarball containing the precompiled propellor, and libraries.
+-- This should be reasonably portable, as long as the remote host has the
+-- same architecture as the build host.
+sendPrecompiled :: HostName -> IO ()
+sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do
+ bracket getWorkingDirectory changeWorkingDirectory $ \_ ->
+ withTmpDir "propellor" go
+ where
+ go tmpdir = do
+ cacheparams <- sshCachingParams hn
+ let shimdir = takeFileName localdir
+ createDirectoryIfMissing True (tmpdir </> shimdir)
+ changeWorkingDirectory (tmpdir </> shimdir)
+ me <- readSymbolicLink "/proc/self/exe"
+ shim <- Shim.setup me "."
+ when (shim /= "propellor") $
+ renameFile shim "propellor"
+ changeWorkingDirectory tmpdir
+ withTmpFile "propellor.tar." $ \tarball _ -> allM id
+ [ boolSystem "strip" [File me]
+ , boolSystem "tar" [Param "czf", File tarball, File shimdir]
+ , boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
+ , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+ ]
+
+ remotetarball = "/usr/local/propellor.tar"
+
+ unpackcmd = shellWrap $ intercalate " && "
+ [ "cd " ++ takeDirectory remotetarball
+ , "tar xzf " ++ remotetarball
+ , "rm -f " ++ remotetarball
+ ]
+
-- Shim for git push over the propellor ssh channel.
-- Reads from stdin and sends it to hout;
-- reads from hin and sends it to stdout.
diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs
index 5b5aa68e..1bfbb0ca 100644
--- a/src/Propellor/Shim.hs
+++ b/src/Propellor/Shim.hs
@@ -45,6 +45,8 @@ setup propellorbin dest = do
modifyFileMode shim (addModes executeModes)
return shim
+-- Called when the shimmed propellor is running, so that commands it runs
+-- don't see it.
cleanEnv :: IO ()
cleanEnv = void $ unsetEnv "GCONV_PATH"