propellor spin

This commit is contained in:
Joey Hess 2014-11-22 16:06:44 -04:00
parent 6d13790afa
commit 392a0d3c1c
Failed to extract signature
3 changed files with 21 additions and 23 deletions

View File

@ -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))

View File

@ -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)

View File

@ -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)