From 4a7e60cc53c31e81e431a68da6907e2724f06af5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 31 Mar 2014 16:37:19 -0400 Subject: propellor spin --- Propellor/CmdLine.hs | 65 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 41 insertions(+), 24 deletions(-) diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index 4188e8f8..ed00f51a 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -14,6 +14,20 @@ data CmdLine | Boot HostName | Set HostName PrivDataField | AddKey String + | Continue CmdLine + deriving (Read, Show, Eq) + +usage :: IO a +usage = do + putStrLn $ unlines + [ "Usage:" + , " propellor" + , " propellor hostname" + , " propellor --spin hostname" + , " propellor --set hostname field" + , " propellor --add-key keyid" + ] + exitFailure processCmdLine :: IO CmdLine processCmdLine = go =<< getArgs @@ -25,6 +39,9 @@ processCmdLine = go =<< getArgs go ("--set":h:f:[]) = case readish f of Just pf -> return $ Set h pf Nothing -> error $ "Unknown privdata field " ++ f + go ("--continue":s:[]) =case readish s of + Just cmdline -> return $ Continue cmdline + Nothing -> error "--continue serialization failure" go (h:[]) = return $ Run h go [] = do s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] @@ -32,27 +49,18 @@ processCmdLine = go =<< getArgs then error "Cannot determine hostname! Pass it on the command line." else return $ Run s go _ = usage - -usage :: IO a -usage = do - putStrLn $ unlines - [ "Usage:" - , " propellor" - , " propellor hostname" - , " propellor --spin hostname" - , " propellor --set hostname field" - , " propellor --add-key keyid" - ] - exitFailure defaultMain :: (HostName -> Maybe [Property]) -> IO () -defaultMain getprops = go =<< processCmdLine +defaultMain getprops = go True =<< processCmdLine where - go (Run host) = withprops host $ pullFirst . ensureProperties - go (Spin host) = withprops host $ const $ spin host - go (Boot host) = withprops host $ pullFirst . boot - go (Set host field) = setPrivData host field - go (AddKey keyid) = addKey keyid + go _ (Continue cmdline) = go False cmdline + go _ (Set host field) = setPrivData host field + go _ (AddKey keyid) = addKey keyid + go _ (Spin host) = withprops host $ const $ spin host + go True cmdline = pullFirst cmdline $ go False cmdline + go _ (Run host) = withprops host $ ensureProperties + go _ (Boot host) = withprops host $ boot + withprops host a = maybe (unknownhost host) a (getprops host) unknownhost :: HostName -> IO a @@ -61,8 +69,8 @@ unknownhost h = error $ unwords , "(perhaps you should specify the real hostname on the command line?)" ] -pullFirst :: IO () -> IO () -pullFirst next = do +pullFirst :: CmdLine -> IO () -> IO () +pullFirst cmdline next = do branchref <- takeWhile (/= '\n') <$> readProcess "git" ["symbolic-ref", "HEAD"] let originbranch = "origin" takeFileName branchref @@ -84,13 +92,22 @@ pullFirst next = do (Just [("GNUPGHOME", privDataDir)]) nukeFile $ privDataDir "trustring.gpg" nukeFile $ privDataDir "gpg.conf" - if s /= "U\n" && s/= "G\n" - then error $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it!" - else putStrLn "git branch " ++ originbranch ++ " gpg signature verified; merging" + if s == "U\n" || s == "G\n" + then putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging" + else error $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it!" + oldsha <- getCurrentGitSha1 void $ boolSystem "git" [Param "merge", Param originbranch] + newsha <- getCurrentGitSha1 + + if oldsha == newsha + then next + else do + void $ boolSystem "make" [Param "build"] + void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)] - next +getCurrentGitSha1 :: IO String +getCurrentGitSha1 = readProcess "git" ["show-ref", "--hash", "HEAD"] spin :: HostName -> IO () spin host = do -- cgit v1.2.3