Merge branch 'joeyconfig'

1 files changed, 57 insertions, 0 deletions

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
new file mode 100644
index 00000000..99afb31f
--- /dev/null
+++ b/src/Propellor/Protocol.hs
@@ -0,0 +1,57 @@
+-- | 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 be ignored.
+
+module Propellor.Protocol where
+
+import Data.List
+
+import Propellor
+
+data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush
+	deriving (Read, Show, Eq)
+
+type Marker = String
+type Marked = String
+
+statusMarker :: Marker
+statusMarker = "STATUS"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+repoUrlMarker :: String
+repoUrlMarker = "REPOURL "
+
+gitPushMarker :: String
+gitPushMarker = "GITPUSH"
+
+toMarked :: Marker -> String -> String
+toMarked = (++)
+
+fromMarked :: Marker -> Marked -> Maybe String
+fromMarked marker s
+	| marker `isPrefixOf` s = Just $ drop (length marker) s
+	| otherwise = Nothing
+
+sendMarked :: Handle -> Marker -> String -> IO ()
+sendMarked h marker s = do
+	-- Prefix string with newline because sometimes a
+	-- incomplete line has been output, and the marker needs to
+	-- come at the start of a line.
+	hPutStrLn h ("\n" ++ toMarked marker s)
+	hFlush h
+
+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 -> getMarked h marker
+		Just v -> return (Just v)
+
+req :: Stage -> Marker -> (String -> IO ()) -> IO ()
+req stage marker a = do
+	sendMarked stdout statusMarker (show stage)
+	maybe noop a =<< getMarked stdin marker