summaryrefslogtreecommitdiff
path: root/src/Propellor/Protocol.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Protocol.hs')
-rw-r--r--src/Propellor/Protocol.hs47
1 files changed, 47 insertions, 0 deletions
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)