summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-03-31 16:37:19 -0400
committerJoey Hess2014-03-31 16:37:19 -0400
commit4a7e60cc53c31e81e431a68da6907e2724f06af5 (patch)
tree865d7cdbf382cf67516e3a421227efe73a74be55 /Propellor
parent78b05d22ff1d452ee690a9aaf97c8f67a70c4f73 (diff)
propellor spin
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/CmdLine.hs65
1 files 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