blob: 4dc7e6bb715b7252a419bde12399371485e32cd6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
-- | 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 | RepoUrl
deriving (Read, Show, Eq)
type Marker = String
type Marked = String
statusMarker :: Marker
statusMarker = "STATUS"
privDataMarker :: String
privDataMarker = "PRIVDATA "
repoUrlMarker :: String
repoUrlMarker = "REPOURL "
toMarked :: Marker -> String -> String
toMarked marker = intercalate "\n" . map (marker ++) . lines
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 -> do
putStrLn l
getMarked h marker
Just v -> return (Just v)
|
