From 46076e9a37efad076125f1a8d3c4eff745f6fde9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 13:29:50 -0400 Subject: reorg and clean up bootstrap protocol --- src/Propellor/Protocol.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 src/Propellor/Protocol.hs (limited to 'src/Propellor/Protocol.hs') diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs new file mode 100644 index 00000000..a1643187 --- /dev/null +++ b/src/Propellor/Protocol.hs @@ -0,0 +1,47 @@ +-- | This is a simple line-based protocol used for communication between +-- a local and remote propellor. It's sent over a ssh channel, and lines of +-- the protocol can be interspersed with other, non-protocol lines +-- that should just be passed through to be displayed. + +module Propellor.Protocol where + +import Data.List + +import Propellor + +data BootStrapStatus = Ready | NeedGitClone + deriving (Read, Show, Eq) + +type Marker = String +type Marked = String + +statusMarker :: Marker +statusMarker = "STATUS" + +privDataMarker :: String +privDataMarker = "PRIVDATA " + +toMarked :: Marker -> String -> String +toMarked marker = intercalate "\n" . map (marker ++) . lines + +sendMarked :: Handle -> Marker -> String -> IO () +sendMarked h marker s = do + -- Prefix string with newline because sometimes a + -- incomplete line is output. + hPutStrLn h ("\n" ++ toMarked marker s) + hFlush h + +fromMarked :: Marker -> Marked -> Maybe String +fromMarked marker s + | marker `isPrefixOf` s = Just $ drop (length marker) s + | otherwise = Nothing + +getMarked :: Handle -> Marker -> IO (Maybe String) +getMarked h marker = go =<< catchMaybeIO (hGetLine h) + where + go Nothing = return Nothing + go (Just l) = case fromMarked marker l of + Nothing -> do + putStrLn l + getMarked h marker + Just v -> return (Just v) -- cgit v1.2.3