From c3962dcf7db5f4692a45fe0ff9802f819a97e2d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 01:04:11 -0400 Subject: propellor spin --- debian/changelog | 1 + propellor.cabal | 1 - src/Propellor/SimpleSh.hs | 101 ---------------------------------------------- 3 files changed, 1 insertion(+), 102 deletions(-) delete mode 100644 src/Propellor/SimpleSh.hs diff --git a/debian/changelog b/debian/changelog index 1e16fe4a..d29da290 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,6 +14,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. + * Docker code simplified by using `docker exec`; needs docker 1.2.0. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 diff --git a/propellor.cabal b/propellor.cabal index 82880d1e..d8a2ec40 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -116,7 +116,6 @@ Library Propellor.Git Propellor.Gpg Propellor.Server - Propellor.SimpleSh Propellor.Ssh Propellor.PrivData.Paths Propellor.Protocol diff --git a/src/Propellor/SimpleSh.hs b/src/Propellor/SimpleSh.hs deleted file mode 100644 index cc5c62cd..00000000 --- a/src/Propellor/SimpleSh.hs +++ /dev/null @@ -1,101 +0,0 @@ --- | Simple server, using a named pipe. Client connects, sends a command, --- and gets back all the output from the command, in a stream. --- --- This is useful for eg, docker. - -module Propellor.SimpleSh where - -import Network.Socket -import Control.Concurrent -import Control.Concurrent.Async -import System.Process (std_in, std_out, std_err) - -import Propellor -import Utility.FileMode -import Utility.ThreadScheduler - -data Cmd = Cmd String [String] - deriving (Read, Show) - -data Resp = StdoutLine String | StderrLine String | Done - deriving (Read, Show) - -simpleSh :: FilePath -> IO () -simpleSh namedpipe = do - nukeFile namedpipe - let dir = takeDirectory namedpipe - createDirectoryIfMissing True dir - modifyFileMode dir (removeModes otherGroupModes) - s <- socket AF_UNIX Stream defaultProtocol - bindSocket s (SockAddrUnix namedpipe) - listen s 2 - forever $ do - (client, _addr) <- accept s - forkIO $ do - h <- socketToHandle client ReadWriteMode - maybe noop (run h) . readish =<< hGetLine h - where - run h (Cmd cmd params) = do - chan <- newChan - let runwriter = do - v <- readChan chan - hPutStrLn h (show v) - hFlush h - case v of - Done -> noop - _ -> runwriter - writer <- async runwriter - - flip catchIO (\_e -> writeChan chan Done) $ do - let p = (proc cmd params) - { std_in = Inherit - , std_out = CreatePipe - , std_err = CreatePipe - } - (Nothing, Just outh, Just errh, pid) <- createProcess p - - let mkreader t from = maybe noop (const $ mkreader t from) - =<< catchMaybeIO (writeChan chan . t =<< hGetLine from) - void $ concurrently - (mkreader StdoutLine outh) - (mkreader StderrLine errh) - - void $ tryIO $ waitForProcess pid - - writeChan chan Done - - hClose outh - hClose errh - - wait writer - hClose h - -simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a -simpleShClient namedpipe cmd params handler = do - s <- socket AF_UNIX Stream defaultProtocol - connect s (SockAddrUnix namedpipe) - h <- socketToHandle s ReadWriteMode - hPutStrLn h $ show $ Cmd cmd params - hFlush h - resps <- catMaybes . map readish . lines <$> hGetContents h - v <- hClose h `after` handler resps - return v - -simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a -simpleShClientRetry retries namedpipe cmd params handler = go retries - where - run = simpleShClient namedpipe cmd params handler - go n - | n < 1 = run - | otherwise = do - v <- tryIO run - case v of - Right r -> return r - Left e -> do - debug ["simplesh connection retry", show e] - threadDelaySeconds (Seconds 1) - go (n - 1) - -getStdout :: Resp -> Maybe String -getStdout (StdoutLine s) = Just s -getStdout _ = Nothing -- cgit v1.2.3