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 14:21:14 -04:00
parent 20fb9057ca
commit 53ece3a155
Failed to extract signature
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Propellor/CmdLine.hs
View File

@ -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 ()