summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs27
-rw-r--r--src/Propellor/Git.hs2
-rw-r--r--src/Propellor/Protocol.hs2
-rw-r--r--src/Propellor/Server.hs32
4 files changed, 49 insertions, 14 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/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..786d1211 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -16,6 +16,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
@@ -69,6 +70,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 +119,32 @@ 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 " ++ hn) $ do
+ cacheparams <- sshCachingParams hn
+ withTmpDir "propellor" $ \tmpdir ->
+ bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
+ changeWorkingDirectory tmpdir
+ let shimdir = "propellor"
+ let me = localdir </> "propellor"
+ void $ Shim.setup me shimdir
+ withTmpFile "propellor.tar" $ \tarball -> allM id
+ [ boolSystem "strip" [File me]
+ , boolSystem "tar" [Param "cf", File tmp, File shimdir]
+ , boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)
+ , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+ ]
+ where
+ remotetarball = "/usr/local/propellor.tar"
+ unpackcmd = shellSwap $ intercalate " && "
+ [ "cd " ++ takeDirectory remotetarball
+ , "tar xf " ++ 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.