summaryrefslogtreecommitdiff
path: root/src/Propellor/Spin.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-07 16:36:36 -0400
committerJoey Hess2016-03-07 16:36:36 -0400
commit16a95afa2fe22a4df9c371489c4ee7ffdef8e07b (patch)
tree6e0869e78aba03be2591569369e1e099bb86568e /src/Propellor/Spin.hs
parent9bbc292b3f903a1476e3524bb9198e58ce300401 (diff)
parent822694e790102efa2a5bb4a0c3d62c6fce1d4e87 (diff)
Merge remote-tracking branch 'remotes/misandrist/FreeBSD' into wip
Diffstat (limited to 'src/Propellor/Spin.hs')
-rw-r--r--src/Propellor/Spin.hs34
1 files changed, 19 insertions, 15 deletions
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 83654105..a2afe29f 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -1,3 +1,5 @@
+{-# Language ScopedTypeVariables #-}
+
module Propellor.Spin (
commitSpin,
spin,
@@ -42,7 +44,7 @@ commitSpin = do
currentBranch <- getCurrentBranch
when (b /= currentBranch) $
error ("spin aborted: check out "
- ++ b ++ " branch first")
+ ++ b ++ " branch first")
-- safety check #2: check we can commit with a dirty tree
noDirtySpin <- getGitConfigBool "propellor.forbid-dirty-spin"
@@ -53,7 +55,7 @@ commitSpin = do
error "spin aborted: commit changes first"
void $ actionMessage "Git commit" $
- gitCommit (Just 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
@@ -77,10 +79,12 @@ spin' mprivdata relay target hst = do
Just r -> pure r
Nothing -> getSshTarget target hst
+ let (InfoVal o) = (getInfo $ hostInfo hst) :: InfoVal System
+
-- Install, or update the remote propellor.
updateServer target relay hst
- (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
- (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap (probecmd o)])
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap (updatecmd o)])
=<< getprivdata
-- And now we can run it.
@@ -92,19 +96,19 @@ spin' mprivdata relay target hst = do
relaying = relay == Just target
viarelay = isJust relay && not relaying
- probecmd = intercalate " ; "
- [ "if [ ! -d " ++ localdir ++ "/.git ]"
+ probecmd sys = intercalate " ; "
+ ["if [ ! -d " ++ localdir ++ "/.git ]"
, "then (" ++ intercalate " && "
- [ installGitCommand
+ [ installGitCommand sys
, "echo " ++ toMarked statusMarker (show NeedGitClone)
] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
- , "else " ++ updatecmd
+ , "else " ++ (updatecmd sys)
, "fi"
]
-
- updatecmd = intercalate " && "
+
+ updatecmd sys = intercalate " && "
[ "cd " ++ localdir
- , bootstrapPropellorCommand
+ , bootstrapPropellorCommand sys
, if viarelay
then "./propellor --continue " ++
shellEscape (show (Relay target))
@@ -117,7 +121,7 @@ spin' mprivdata relay target hst = do
cmdline
| viarelay = Spin [target] (Just target)
| otherwise = SimpleRun target
-
+
getprivdata = case mprivdata of
Nothing
| relaying -> do
@@ -125,12 +129,12 @@ spin' mprivdata relay target hst = do
d <- readPrivDataFile f
nukeFile f
return d
- | otherwise ->
+ | otherwise ->
filterPrivData hst <$> decryptPrivData
Just pd -> pure pd
-- Check if the Host contains an IP address that matches one of the IPs
--- in the DNS for the HostName. If so, the HostName is used as-is,
+-- in the DNS for the HostName. If so, the HostName is used as-is,
-- but if the DNS is out of sync with the Host config, or doesn't have
-- the host in it at all, use one of the Host's IPs instead.
getSshTarget :: HostName -> Host -> IO String
@@ -200,7 +204,7 @@ update forhost = do
, Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout
, Param "."
]
-
+
-- When --spin --relay is run, get a privdata file
-- to be relayed to the target host.
privfile = maybe privDataLocal privDataRelay forhost