remove simplsh debug code

Seems I have really fixed that bug!
This commit is contained in:
Joey Hess 2014-05-14 19:34:26 -04:00
parent ffce1f80ae
commit 5a5adab867
3 changed files with 4 additions and 30 deletions

View File

@ -354,12 +354,7 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
<*> pure (simpleLogFormatter "[$time] $msg")
updateGlobalLogger rootLoggerName $
setLevel DEBUG . setHandlers [f]
go _ = whenM ((==) "root" <$> myUserName) $ do
f <- setFormatter
<$> fileHandler "/usr/local/propellor/log" DEBUG
<*> pure (simpleLogFormatter "[$time] $msg")
updateGlobalLogger rootLoggerName $
setLevel DEBUG . setHandlers [f]
go _ = noop
-- Parameters can be passed to both ssh and scp, to enable a ssh connection
-- caching socket.

View File

@ -335,29 +335,19 @@ provisionContainer cid = containerDesc cid $ property "provision" $ liftIO $ do
go lastline (v:rest) = case v of
StdoutLine s -> do
debug ["stdout: ", show s]
maybe noop putStrLn lastline
hFlush stdout
go (Just s) rest
StderrLine s -> do
debug ["stderr: ", show s]
maybe noop putStrLn lastline
hFlush stdout
hPutStrLn stderr s
hFlush stderr
go Nothing rest
Done -> do
debug ["reached Done"]
ret lastline
go lastline [] = do
debug ["reached end of output"]
ret lastline
Done -> ret lastline
go lastline [] = ret lastline
ret lastline = do
let v = fromMaybe FailedChange $
readish =<< lastline
debug ["provisionContainer returning", show v]
return v
ret lastline = pure $ fromMaybe FailedChange $ readish =<< lastline
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]

View File

@ -36,11 +36,9 @@ simpleSh namedpipe = do
maybe noop (run h) . readish =<< hGetLine h
where
run h (Cmd cmd params) = do
debug ["simplesh run", cmd, show params]
chan <- newChan
let runwriter = do
v <- readChan chan
debug ["simplesh run", cmd, show params, "writer got:", show v]
hPutStrLn h (show v)
hFlush h
case v of
@ -55,7 +53,6 @@ simpleSh namedpipe = do
, std_err = CreatePipe
}
(Nothing, Just outh, Just errh, pid) <- createProcess p
debug ["simplesh run", cmd, show params, "started"]
let mkreader t from = maybe noop (const $ mkreader t from)
=<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
@ -63,33 +60,25 @@ simpleSh namedpipe = do
(mkreader StdoutLine outh)
(mkreader StderrLine errh)
debug ["simplesh run", cmd, show params, "waiting for process"]
void $ tryIO $ waitForProcess pid
debug ["simplesh run", cmd, show params, "sending Done"]
writeChan chan Done
hClose outh
hClose errh
debug ["simplesh run", cmd, show params, "wait writer"]
wait writer
debug ["simplesh run", cmd, show params, "wait writer complete"]
hClose h
debug ["simplesh run", cmd, show params, "fully done"]
simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
simpleShClient namedpipe cmd params handler = do
debug ["simplesh connecting"]
s <- socket AF_UNIX Stream defaultProtocol
connect s (SockAddrUnix namedpipe)
h <- socketToHandle s ReadWriteMode
hPutStrLn h $ show $ Cmd cmd params
hFlush h
debug ["simplesh sent command"]
resps <- catMaybes . map readish . lines <$> hGetContents h
v <- hClose h `after` handler resps
debug ["simplesh processed response"]
return v
simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a