--via implemented
This commit is contained in:
parent
61945b4ff3
commit
fd3335e40e
|
@ -3,8 +3,9 @@ propellor (1.0.1) UNRELEASED; urgency=medium
|
||||||
* propellor --spin can now deploy propellor to hosts that do not have
|
* propellor --spin can now deploy propellor to hosts that do not have
|
||||||
git, ghc, or apt-get. This is accomplished by uploading a fairly
|
git, ghc, or apt-get. This is accomplished by uploading a fairly
|
||||||
portable precompiled tarball of propellor.
|
portable precompiled tarball of propellor.
|
||||||
* --spin host --via host causes propellor to bounce through an intermediate
|
* --spin target --via relay causes propellor to bounce through an
|
||||||
host, which handles any necessary provisioning of the host being spun.
|
intermediate relay host, which handles any necessary provisioning
|
||||||
|
of the target host.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Sat, 22 Nov 2014 00:12:35 -0400
|
-- Joey Hess <joeyh@debian.org> Sat, 22 Nov 2014 00:12:35 -0400
|
||||||
|
|
||||||
|
|
|
@ -20,11 +20,18 @@ action as needed to satisfy the configured properties of the local host.
|
||||||
|
|
||||||
# OPTIONS
|
# OPTIONS
|
||||||
|
|
||||||
* --spin hostname
|
* --spin targethost [--via relayhost]
|
||||||
|
|
||||||
Causes propellor to automatically install itself on the specified host,
|
Causes propellor to automatically install itself on the specified target
|
||||||
or if it's already installed there, push any updates. Propellor is then
|
host, or if it's already installed there, push any updates. Propellor is
|
||||||
run on the host, to satisfy its configured properties.
|
then run on the target host, to satisfy its configured properties.
|
||||||
|
|
||||||
|
When run with --via, propellor sshes to the relay host and runs
|
||||||
|
`propellor --spin hostname` from there. This can be useful when
|
||||||
|
propellor is installing itself, since most of the data transfer
|
||||||
|
is done between relay host and target host. Note that propellor
|
||||||
|
uses ssh agent forwarding to make this work, and the relay host
|
||||||
|
sees any privdata belonging to the target host.
|
||||||
|
|
||||||
* --add-key keyid
|
* --add-key keyid
|
||||||
|
|
||||||
|
|
|
@ -24,7 +24,7 @@ usage h = hPutStrLn h $ unlines
|
||||||
[ "Usage:"
|
[ "Usage:"
|
||||||
, " propellor"
|
, " propellor"
|
||||||
, " propellor hostname"
|
, " propellor hostname"
|
||||||
, " propellor --spin hostname"
|
, " propellor --spin targethost [--via relayhost]"
|
||||||
, " propellor --add-key keyid"
|
, " propellor --add-key keyid"
|
||||||
, " propellor --set field context"
|
, " propellor --set field context"
|
||||||
, " propellor --dump field context"
|
, " propellor --dump field context"
|
||||||
|
@ -41,7 +41,8 @@ processCmdLine :: IO CmdLine
|
||||||
processCmdLine = go =<< getArgs
|
processCmdLine = go =<< getArgs
|
||||||
where
|
where
|
||||||
go ("--run":h:[]) = return $ Run h
|
go ("--run":h:[]) = return $ Run h
|
||||||
go ("--spin":h:[]) = return $ Spin h
|
go ("--spin":h:[]) = return $ Spin h Nothing
|
||||||
|
go ("--spin":h:"--via":r:[]) = return $ Spin h (Just r)
|
||||||
go ("--add-key":k:[]) = return $ AddKey k
|
go ("--add-key":k:[]) = return $ AddKey k
|
||||||
go ("--set":f:c:[]) = withprivfield f c Set
|
go ("--set":f:c:[]) = withprivfield f c Set
|
||||||
go ("--dump":f:c:[]) = withprivfield f c Dump
|
go ("--dump":f:c:[]) = withprivfield f c Dump
|
||||||
|
@ -50,8 +51,8 @@ processCmdLine = go =<< getArgs
|
||||||
go ("--help":_) = do
|
go ("--help":_) = do
|
||||||
usage stdout
|
usage stdout
|
||||||
exitFailure
|
exitFailure
|
||||||
go ("--update":h:[]) = return $ Update h
|
go ("--update":_:[]) = return $ Update Nothing
|
||||||
go ("--boot":h:[]) = return $ Update h -- for back-compat
|
go ("--boot":_:[]) = return $ Update Nothing -- for back-compat
|
||||||
go ("--continue":s:[]) = case readish s of
|
go ("--continue":s:[]) = case readish s of
|
||||||
Just cmdline -> return $ Continue cmdline
|
Just cmdline -> return $ Continue cmdline
|
||||||
Nothing -> errorMessage $ "--continue serialization failure (" ++ s ++ ")"
|
Nothing -> errorMessage $ "--continue serialization failure (" ++ s ++ ")"
|
||||||
|
@ -89,15 +90,16 @@ defaultMain hostlist = do
|
||||||
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
|
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
|
||||||
go _ (DockerInit hn) = Docker.init hn
|
go _ (DockerInit hn) = Docker.init hn
|
||||||
go _ (GitPush fin fout) = gitPushHelper fin fout
|
go _ (GitPush fin fout) = gitPushHelper fin fout
|
||||||
go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update)
|
go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing))
|
||||||
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
|
go _ (Update (Just h)) = forceConsole >> fetchFirst (update (Just h))
|
||||||
|
go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline
|
||||||
go True cmdline = updateFirst cmdline $ go False cmdline
|
go True cmdline = updateFirst cmdline $ go False cmdline
|
||||||
go False (Spin hn) = withhost hn $ spin hn
|
go False (Spin hn r) = withhost hn $ spin hn r
|
||||||
go False cmdline@(SimpleRun hn) = buildFirst cmdline $
|
go False cmdline@(SimpleRun hn) = buildFirst cmdline $
|
||||||
go False (Run hn)
|
go False (Run hn)
|
||||||
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
|
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
|
||||||
( onlyprocess $ withhost hn mainProperties
|
( onlyprocess $ withhost hn mainProperties
|
||||||
, go True (Spin hn)
|
, go True (Spin hn Nothing)
|
||||||
)
|
)
|
||||||
|
|
||||||
withhost :: HostName -> (Host -> IO ()) -> IO ()
|
withhost :: HostName -> (Host -> IO ()) -> IO ()
|
||||||
|
@ -148,8 +150,8 @@ updateFirst' cmdline next = ifM fetchOrigin
|
||||||
, next
|
, next
|
||||||
)
|
)
|
||||||
|
|
||||||
spin :: HostName -> Host -> IO ()
|
spin :: HostName -> Maybe HostName -> Host -> IO ()
|
||||||
spin hn hst = do
|
spin target relay hst = do
|
||||||
void $ actionMessage "Git commit" $
|
void $ actionMessage "Git commit" $
|
||||||
gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
|
gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
|
||||||
-- Push to central origin repo first, if possible.
|
-- Push to central origin repo first, if possible.
|
||||||
|
@ -160,15 +162,18 @@ spin hn hst = do
|
||||||
boolSystem "git" [Param "push"]
|
boolSystem "git" [Param "push"]
|
||||||
|
|
||||||
cacheparams <- toCommand <$> sshCachingParams hn
|
cacheparams <- toCommand <$> sshCachingParams hn
|
||||||
|
when (isJust relay) $
|
||||||
|
void $ boolSystem "ssh-add" []
|
||||||
|
|
||||||
-- Install, or update the remote propellor.
|
-- Install, or update the remote propellor.
|
||||||
updateServer hn hst $ withBothHandles createProcessSuccess
|
updateServer target relay hst $ withBothHandles createProcessSuccess
|
||||||
(proc "ssh" $ cacheparams ++ [user, updatecmd])
|
(proc "ssh" $ cacheparams ++ [user, updatecmd])
|
||||||
|
|
||||||
-- And now we can run it.
|
-- And now we can run it.
|
||||||
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
|
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
|
||||||
error $ "remote propellor failed"
|
error $ "remote propellor failed"
|
||||||
where
|
where
|
||||||
|
hn = fromMaybe target relay
|
||||||
user = "root@"++hn
|
user = "root@"++hn
|
||||||
|
|
||||||
mkcmd = shellWrap . intercalate " ; "
|
mkcmd = shellWrap . intercalate " ; "
|
||||||
|
@ -183,10 +188,17 @@ spin hn hst = do
|
||||||
, "else " ++ intercalate " && "
|
, "else " ++ intercalate " && "
|
||||||
[ "cd " ++ localdir
|
[ "cd " ++ localdir
|
||||||
, "if ! test -x ./propellor; then make deps build; fi"
|
, "if ! test -x ./propellor; then make deps build; fi"
|
||||||
, "./propellor --boot " ++ hn
|
, if isNothing relay
|
||||||
|
-- Still using --boot for back-compat...
|
||||||
|
then "./propellor --boot " ++ target
|
||||||
|
else "./propellor --continue " ++
|
||||||
|
shellEscape (show (Update (Just target)))
|
||||||
]
|
]
|
||||||
, "fi"
|
, "fi"
|
||||||
]
|
]
|
||||||
|
|
||||||
runcmd = mkcmd
|
runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
|
||||||
[ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (SimpleRun hn)) ]
|
cmd = if isNothing relay
|
||||||
|
then "--continue " ++ shellEscape (show (SimpleRun target))
|
||||||
|
else "--spin " ++ shellEscape target
|
||||||
|
|
||||||
|
|
|
@ -10,3 +10,6 @@ privDataFile = privDataDir </> "privdata.gpg"
|
||||||
|
|
||||||
privDataLocal :: FilePath
|
privDataLocal :: FilePath
|
||||||
privDataLocal = privDataDir </> "local"
|
privDataLocal = privDataDir </> "local"
|
||||||
|
|
||||||
|
privDataRelay :: String -> FilePath
|
||||||
|
privDataRelay host = privDataDir </> "relay" </> host
|
||||||
|
|
|
@ -29,13 +29,16 @@ import Utility.SafeCommand
|
||||||
-- Update the privdata, repo url, and git repo over the ssh
|
-- Update the privdata, repo url, and git repo over the ssh
|
||||||
-- connection, talking to the user's local propellor instance which is
|
-- connection, talking to the user's local propellor instance which is
|
||||||
-- running the updateServer
|
-- running the updateServer
|
||||||
update :: IO ()
|
update :: Maybe HostName -> IO ()
|
||||||
update = do
|
update forhost = do
|
||||||
whenM hasOrigin $
|
whenM hasOrigin $
|
||||||
req NeedRepoUrl repoUrlMarker setRepoUrl
|
req NeedRepoUrl repoUrlMarker setRepoUrl
|
||||||
|
|
||||||
makePrivDataDir
|
makePrivDataDir
|
||||||
|
createDirectoryIfMissing True (takeDirectory privfile)
|
||||||
req NeedPrivData privDataMarker $
|
req NeedPrivData privDataMarker $
|
||||||
writeFileProtected privDataLocal
|
writeFileProtected privfile
|
||||||
|
|
||||||
whenM hasOrigin $
|
whenM hasOrigin $
|
||||||
req NeedGitPush gitPushMarker $ \_ -> do
|
req NeedGitPush gitPushMarker $ \_ -> do
|
||||||
hin <- dup stdInput
|
hin <- dup stdInput
|
||||||
|
@ -53,11 +56,16 @@ update = do
|
||||||
, Param "."
|
, Param "."
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- When --spin --relay is run, get a privdata file
|
||||||
|
-- to be relayed to the target host.
|
||||||
|
privfile = maybe privDataLocal privDataRelay forhost
|
||||||
|
|
||||||
-- The connect action should ssh to the remote host and run the provided
|
-- The connect action should ssh to the remote host and run the provided
|
||||||
-- calback action.
|
-- calback action.
|
||||||
updateServer :: HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
|
updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
|
||||||
updateServer hn hst connect = connect go
|
updateServer target relay hst connect = connect go
|
||||||
where
|
where
|
||||||
|
hn = fromMaybe target relay
|
||||||
go (toh, fromh) = do
|
go (toh, fromh) = do
|
||||||
let loop = go (toh, fromh)
|
let loop = go (toh, fromh)
|
||||||
v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
|
v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
|
||||||
|
@ -77,12 +85,12 @@ updateServer hn hst connect = connect go
|
||||||
hClose toh
|
hClose toh
|
||||||
hClose fromh
|
hClose fromh
|
||||||
sendGitClone hn
|
sendGitClone hn
|
||||||
updateServer hn hst connect
|
updateServer hn relay hst connect
|
||||||
(Just NeedPrecompiled) -> do
|
(Just NeedPrecompiled) -> do
|
||||||
hClose toh
|
hClose toh
|
||||||
hClose fromh
|
hClose fromh
|
||||||
sendPrecompiled hn
|
sendPrecompiled hn
|
||||||
updateServer hn hst connect
|
updateServer hn relay hst connect
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
sendRepoUrl :: Handle -> IO ()
|
sendRepoUrl :: Handle -> IO ()
|
||||||
|
|
|
@ -142,7 +142,7 @@ instance ActionResult Result where
|
||||||
|
|
||||||
data CmdLine
|
data CmdLine
|
||||||
= Run HostName
|
= Run HostName
|
||||||
| Spin HostName
|
| Spin HostName (Maybe HostName)
|
||||||
| SimpleRun HostName
|
| SimpleRun HostName
|
||||||
| Set PrivDataField Context
|
| Set PrivDataField Context
|
||||||
| Dump PrivDataField Context
|
| Dump PrivDataField Context
|
||||||
|
@ -150,7 +150,7 @@ data CmdLine
|
||||||
| ListFields
|
| ListFields
|
||||||
| AddKey String
|
| AddKey String
|
||||||
| Continue CmdLine
|
| Continue CmdLine
|
||||||
| Update HostName
|
| Update (Maybe HostName)
|
||||||
| DockerInit HostName
|
| DockerInit HostName
|
||||||
| DockerChain HostName String
|
| DockerChain HostName String
|
||||||
| ChrootChain HostName FilePath Bool Bool
|
| ChrootChain HostName FilePath Bool Bool
|
||||||
|
|
Loading…
Reference in New Issue