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

propellor spin

This commit is contained in:
Joey Hess 2014-03-31 12:28:40 -04:00
parent ceab15aef5
commit 8331629fa7
Failed to extract signature
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Propellor/CmdLine.hs
View File

@ -69,21 +69,22 @@ spin host = do
withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd url]) $ \(toh, fromh) -> do withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd url]) $ \(toh, fromh) -> do
hPutStrLn stderr "PRE-STATUS" hPutStrLn stderr "PRE-STATUS"
hFlush stderr hFlush stderr
status <- readish . fromMarked statusMarker <$> hGetContents fromh status <- getstatus fromh `catchIO` error "protocol error"
hPutStrLn stderr "POST-STATUS" hPutStrLn stderr "POST-STATUS"
hFlush stderr hFlush stderr
case status of case status of
Nothing -> error "protocol error" NeedKeyRing -> do
Just NeedKeyRing -> do
hPutStrLn stderr "SEND-KEYRING" hPutStrLn stderr "SEND-KEYRING"
hFlush stderr hFlush stderr
s <- readProcess "gpg" $ gpgopts ++ ["--export", "-a"] s <- readProcess "gpg" $ gpgopts ++ ["--export", "-a"]
hPutStrLn toh $ toMarked keyringMarker s hPutStrLn toh $ toMarked keyringMarker s
Just HaveKeyRing -> noop HaveKeyRing -> noop
hPutStrLn stderr "POST-KEYRING" hPutStrLn stderr "POST-KEYRING"
hFlush stderr hFlush stderr
hPutStrLn toh $ toMarked privDataMarker privdata hPutStrLn toh $ toMarked privDataMarker privdata
hFlush toh hFlush toh
void $ tryIO $ forever $
putStrLn =<< hGetLine fromh
hClose fromh hClose fromh
where where
@ -101,6 +102,10 @@ spin host = do
, "make pull build" , "make pull build"
, "./propellor --boot " ++ host , "./propellor --boot " ++ host
] ]
getstatus :: Handle -> IO BootStrapStatus
getstatus h = maybe (getstatus h) return
. readish . fromMarked statusMarker
=<< hGetLine h
data BootStrapStatus = HaveKeyRing | NeedKeyRing data BootStrapStatus = HaveKeyRing | NeedKeyRing
deriving (Read, Show, Eq) deriving (Read, Show, Eq)
@ -129,9 +134,9 @@ boot :: [Property] -> IO ()
boot props = do boot props = do
havering <- doesFileExist keyring havering <- doesFileExist keyring
putStrLn $ toMarked statusMarker $ show $ if havering then HaveKeyRing else NeedKeyRing putStrLn $ toMarked statusMarker $ show $ if havering then HaveKeyRing else NeedKeyRing
hFlush stdout
hPutStrLn stderr "SENT STATUS" hPutStrLn stderr "SENT STATUS"
hFlush stderr hFlush stderr
hFlush stdout
reply <- getContents reply <- getContents
hPutStrLn stderr $ "GOT " ++ reply hPutStrLn stderr $ "GOT " ++ reply
hFlush stderr hFlush stderr