propellor spin
This commit is contained in:
parent
6d13790afa
commit
392a0d3c1c
|
@ -166,8 +166,8 @@ spin target relay hst = do
|
|||
void $ actionMessage "Push to central git repository" $
|
||||
boolSystem "git" [Param "push"]
|
||||
|
||||
cacheparams <- toCommand <$> sshCachingParams hn
|
||||
when (isJust relay) $
|
||||
cacheparams <- toCommand <$> sshCachingParams hn viarelay
|
||||
when viarelay $
|
||||
void $ boolSystem "ssh-add" []
|
||||
|
||||
-- Install, or update the remote propellor.
|
||||
|
@ -175,12 +175,14 @@ spin target relay hst = do
|
|||
(proc "ssh" $ cacheparams ++ [user, updatecmd])
|
||||
|
||||
-- And now we can run it.
|
||||
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ runparams)) $
|
||||
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
|
||||
error $ "remote propellor failed"
|
||||
where
|
||||
hn = fromMaybe target relay
|
||||
user = "root@"++hn
|
||||
|
||||
relaying = relay == Just target
|
||||
viarelay = isJust relay && not relaying
|
||||
|
||||
mkcmd = shellWrap . intercalate " ; "
|
||||
|
||||
|
@ -193,22 +195,16 @@ spin target relay hst = do
|
|||
, "else " ++ intercalate " && "
|
||||
[ "cd " ++ localdir
|
||||
, "if ! test -x ./propellor; then make deps build; fi"
|
||||
, if isNothing relay
|
||||
-- Still using --boot for back-compat...
|
||||
then "./propellor --boot " ++ target
|
||||
else "./propellor --continue " ++
|
||||
, if viarelay
|
||||
then "./propellor --continue " ++
|
||||
shellEscape (show (Update (Just target)))
|
||||
-- Still using --boot for back-compat...
|
||||
else "./propellor --boot " ++ target
|
||||
]
|
||||
, "fi"
|
||||
]
|
||||
|
||||
runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
|
||||
cmd = if isNothing relay
|
||||
then "--continue " ++ shellEscape (show (SimpleRun target))
|
||||
else "--serialized " ++ shellEscape (show (Spin target (Just target)))
|
||||
runparams = catMaybes
|
||||
[ if isJust relay then Just "-A" else Nothing
|
||||
, Just "-t"
|
||||
, Just user
|
||||
, Just runcmd
|
||||
]
|
||||
cmd = if viarelay
|
||||
then "--serialized " ++ shellEscape (show (Spin target (Just target)))
|
||||
else "--continue " ++ shellEscape (show (SimpleRun target))
|
||||
|
|
|
@ -131,7 +131,7 @@ sendGitUpdate hn fromh toh =
|
|||
sendGitClone :: HostName -> IO ()
|
||||
sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
|
||||
branch <- getCurrentBranch
|
||||
cacheparams <- sshCachingParams hn
|
||||
cacheparams <- sshCachingParams hn False
|
||||
withTmpFile "propellor.git" $ \tmp _ -> allM id
|
||||
[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
|
||||
, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
|
||||
|
@ -156,7 +156,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor
|
|||
withTmpDir "propellor" go
|
||||
where
|
||||
go tmpdir = do
|
||||
cacheparams <- sshCachingParams hn
|
||||
cacheparams <- sshCachingParams hn False
|
||||
let shimdir = takeFileName localdir
|
||||
createDirectoryIfMissing True (tmpdir </> shimdir)
|
||||
changeWorkingDirectory (tmpdir </> shimdir)
|
||||
|
|
|
@ -14,15 +14,17 @@ import Data.Time.Clock.POSIX
|
|||
-- minutes, and if so stop that ssh process, in order to not try to
|
||||
-- use an old stale connection. (atime would be nicer, but there's
|
||||
-- a good chance a laptop uses noatime)
|
||||
sshCachingParams :: HostName -> IO [CommandParam]
|
||||
sshCachingParams hn = do
|
||||
sshCachingParams :: HostName -> Bool -> IO [CommandParam]
|
||||
sshCachingParams hn viarelay = do
|
||||
home <- myHomeDir
|
||||
let cachedir = home </> ".ssh" </> "propellor"
|
||||
createDirectoryIfMissing False cachedir
|
||||
let socketfile = cachedir </> hn ++ ".sock"
|
||||
let ps =
|
||||
[ Param "-o", Param ("ControlPath=" ++ socketfile)
|
||||
, Params "-o ControlMaster=auto -o ControlPersist=yes"
|
||||
let ps = catMaybes
|
||||
[ if viarelay then Just (Param "-A") else Nothing
|
||||
, Just $ Param "-o"
|
||||
, Just $ Param ("ControlPath=" ++ socketfile)
|
||||
, Just $ Params "-o ControlMaster=auto -o ControlPersist=yes"
|
||||
]
|
||||
|
||||
maybe noop (expireold ps socketfile)
|
||||
|
|
Loading…
Reference in New Issue