propellor spin
This commit is contained in:
parent
20fb9057ca
commit
53ece3a155
|
@ -71,6 +71,7 @@ spin host = do
|
||||||
status <- getstatus fromh `catchIO` error "protocol error"
|
status <- getstatus fromh `catchIO` error "protocol error"
|
||||||
case status of
|
case status of
|
||||||
NeedKeyRing -> do
|
NeedKeyRing -> do
|
||||||
|
putStrLn $ "Sending " ++ keyring ++ " to " ++ host
|
||||||
s <- toB64 <$> readFile keyring
|
s <- toB64 <$> readFile keyring
|
||||||
hPutStrLn toh $ toMarked keyringMarker s
|
hPutStrLn toh $ toMarked keyringMarker s
|
||||||
HaveKeyRing -> noop
|
HaveKeyRing -> noop
|
||||||
|
@ -100,7 +101,7 @@ spin host = do
|
||||||
]
|
]
|
||||||
getstatus :: Handle -> IO BootStrapStatus
|
getstatus :: Handle -> IO BootStrapStatus
|
||||||
getstatus h = maybe (getstatus h) return
|
getstatus h = maybe (getstatus h) return
|
||||||
. readish . fromMarked statusMarker
|
. (readish <=< fromMarked statusMarker)
|
||||||
=<< hGetLine h
|
=<< hGetLine h
|
||||||
|
|
||||||
data BootStrapStatus = HaveKeyRing | NeedKeyRing
|
data BootStrapStatus = HaveKeyRing | NeedKeyRing
|
||||||
|
@ -121,10 +122,13 @@ privDataMarker = "PRIVDATA "
|
||||||
toMarked :: Marker -> String -> String
|
toMarked :: Marker -> String -> String
|
||||||
toMarked marker = unlines . map (marker ++) . lines
|
toMarked marker = unlines . map (marker ++) . lines
|
||||||
|
|
||||||
fromMarked :: Marker -> Marked -> String
|
fromMarked :: Marker -> Marked -> Maybe String
|
||||||
fromMarked marker = unlines . map (drop len) . filter (marker `isPrefixOf`) . lines
|
fromMarked marker s
|
||||||
|
| null matches = Nothing
|
||||||
|
| otherwise = Just $ unlines $ map (drop len) matches
|
||||||
where
|
where
|
||||||
len = length marker
|
len = length marker
|
||||||
|
matches = filter (marker `isPrefixOf`) $ lines s
|
||||||
|
|
||||||
boot :: [Property] -> IO ()
|
boot :: [Property] -> IO ()
|
||||||
boot props = do
|
boot props = do
|
||||||
|
@ -133,13 +137,14 @@ boot props = do
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
reply <- getContents
|
reply <- getContents
|
||||||
|
|
||||||
hPutStrLn stderr $ fromMarked keyringMarker reply
|
hPutStrLn stderr $ show $ fromMarked keyringMarker reply
|
||||||
hFlush stderr
|
hFlush stderr
|
||||||
|
|
||||||
makePrivDataDir
|
makePrivDataDir
|
||||||
writeFileProtected privDataLocal $ fromMarked privDataMarker reply
|
maybe noop (writeFileProtected privDataLocal) $
|
||||||
maybe noop (writeFileProtected keyring) $ fromB64Maybe $
|
fromMarked privDataMarker reply
|
||||||
fromMarked keyringMarker reply
|
maybe noop (writeFileProtected keyring) $
|
||||||
|
fromB64Maybe =<< fromMarked keyringMarker reply
|
||||||
ensureProperties props
|
ensureProperties props
|
||||||
|
|
||||||
addKey :: String -> IO ()
|
addKey :: String -> IO ()
|
||||||
|
|
Loading…
Reference in New Issue