cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propellor spin

This commit is contained in:
Joey Hess 2014-07-06 17:37:10 -04:00
parent 2fde19656e
commit e2019aa7a8
Failed to extract signature
2 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Propellor/CmdLine.hs
View File

@ -84,7 +84,7 @@ defaultMain hostlist = do
go _ (Docker hn) = Docker.chain hn go _ (Docker hn) = Docker.chain hn
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline 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 $ const $ spin hn go False (Spin hn) = withhost hn $ spin 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)
@ -176,14 +176,16 @@ updateFirst cmdline next = do
getCurrentGitSha1 :: String -> IO String getCurrentGitSha1 :: String -> IO String
getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref] getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
spin :: HostName -> IO () spin :: HostName -> Host -> IO ()
spin hn = do spin hn hst = do
url <- getUrl url <- getUrl
void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
void $ boolSystem "git" [Param "push"] void $ boolSystem "git" [Param "push"]
cacheparams <- toCommand <$> sshCachingParams hn cacheparams <- toCommand <$> sshCachingParams hn
go cacheparams url =<< gpgDecrypt privDataFile go cacheparams url =<< hostprivdata
where where
hostprivdata = show . filterPrivData hst <$> decryptPrivData
go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
let finish = do let finish = do
senddata toh "privdata" privDataMarker privdata senddata toh "privdata" privDataMarker privdata

12
src/Propellor/PrivData.hs
View File

@ -29,6 +29,8 @@ import Utility.FileMode
import Utility.Env import Utility.Env
import Utility.Table import Utility.Table
type PrivMap = M.Map (PrivDataField, Context) PrivData
-- | Allows a Property to access the value of a specific PrivDataField, -- | Allows a Property to access the value of a specific PrivDataField,
-- for use in a specific Context. -- for use in a specific Context.
-- --
@ -68,7 +70,13 @@ getLocalPrivData field context =
where where
localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
getPrivData :: PrivDataField -> Context -> (M.Map (PrivDataField, Context) PrivData) -> Maybe PrivData {- Get only the set of PrivData that the Host's Info says it uses. -}
filterPrivData :: Host -> PrivMap -> PrivMap
filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
where
used = _privDataFields $ hostInfo host
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
getPrivData field context = M.lookup (field, context) getPrivData field context = M.lookup (field, context)
setPrivData :: PrivDataField -> Context -> IO () setPrivData :: PrivDataField -> Context -> IO ()
@ -124,7 +132,7 @@ setPrivDataTo field context value = do
| end s == "\n" = chomp (beginning s) | end s == "\n" = chomp (beginning s)
| otherwise = s | otherwise = s
decryptPrivData :: IO (M.Map (PrivDataField, Context) PrivData) decryptPrivData :: IO PrivMap
decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
makePrivDataDir :: IO () makePrivDataDir :: IO ()