cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add debuggin for simplesh

This commit is contained in:
Joey Hess 2014-04-29 20:05:39 -04:00
parent 2a90e99fa5
commit 820db65ff0
1 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Propellor/SimpleSh.hs
View File

@ -70,13 +70,17 @@ simpleSh namedpipe = do
simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
simpleShClient namedpipe cmd params handler = do simpleShClient namedpipe cmd params handler = do
debug ["simplesh connecting"]
s <- socket AF_UNIX Stream defaultProtocol s <- socket AF_UNIX Stream defaultProtocol
connect s (SockAddrUnix namedpipe) connect s (SockAddrUnix namedpipe)
h <- socketToHandle s ReadWriteMode h <- socketToHandle s ReadWriteMode
hPutStrLn h $ show $ Cmd cmd params hPutStrLn h $ show $ Cmd cmd params
hFlush h hFlush h
debug ["simplesh sent command"]
resps <- catMaybes . map readish . lines <$> hGetContents h resps <- catMaybes . map readish . lines <$> hGetContents h
hClose h `after` handler resps v <- hClose h `after` handler resps
debug ["simplesh processed response"]
return v
simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
simpleShClientRetry retries namedpipe cmd params handler = go retries simpleShClientRetry retries namedpipe cmd params handler = go retries
@ -88,7 +92,8 @@ simpleShClientRetry retries namedpipe cmd params handler = go retries
v <- tryIO run v <- tryIO run
case v of case v of
Right r -> return r Right r -> return r
Left _ -> do Left e -> do
debug ["simplesh connection retry", show e]
threadDelaySeconds (Seconds 1) threadDelaySeconds (Seconds 1)
go (n - 1) go (n - 1)