From 25c4d185037bcf0c7aa42a11dc0295914c128ddc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Apr 2014 02:37:48 -0400 Subject: simple socket server, will hopefully work with docker --- Makefile | 2 +- Propellor/CmdLine.hs | 6 ++++- Propellor/SimpleSh.hs | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ propellor.cabal | 5 ++-- 4 files changed, 82 insertions(+), 4 deletions(-) create mode 100644 Propellor/SimpleSh.hs diff --git a/Makefile b/Makefile index 2ba41b2b..0cf58fa5 100644 --- a/Makefile +++ b/Makefile @@ -8,7 +8,7 @@ build: deps dist/setup-config ln -sf dist/build/propellor/propellor deps: - @if [ $$(whoami) = root ]; then apt-get -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev; fi || true + @if [ $$(whoami) = root ]; then apt-get -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev; fi || true dist/setup-config: propellor.cabal cabal configure diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index e43cf0aa..05df86bf 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -5,6 +5,7 @@ import Data.List import System.Exit import Propellor +import Propellor.SimpleSh import Utility.FileMode import Utility.SafeCommand @@ -15,6 +16,7 @@ data CmdLine | Set HostName PrivDataField | AddKey String | Continue CmdLine + | SimpleSh FilePath deriving (Read, Show, Eq) usage :: IO a @@ -39,9 +41,10 @@ processCmdLine = go =<< getArgs go ("--set":h:f:[]) = case readish f of Just pf -> return $ Set h pf Nothing -> errorMessage $ "Unknown privdata field " ++ f - go ("--continue":s:[]) =case readish s of + go ("--continue":s:[]) = case readish s of Just cmdline -> return $ Continue cmdline Nothing -> errorMessage "--continue serialization failure" + go ("--simplesh":f:[]) = return $ SimpleSh f go (h:[]) = return $ Run h go [] = do s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] @@ -56,6 +59,7 @@ defaultMain getprops = go True =<< processCmdLine go _ (Continue cmdline) = go False cmdline go _ (Set host field) = setPrivData host field go _ (AddKey keyid) = addKey keyid + go _ (SimpleSh f) = simpleSh f go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline go False (Spin host) = withprops host $ const $ spin host diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs new file mode 100644 index 00000000..971fe502 --- /dev/null +++ b/Propellor/SimpleSh.hs @@ -0,0 +1,73 @@ +-- | 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.Chan +import Control.Concurrent.Async +import System.Process (std_in, std_out, std_err) +import System.Exit + +import Propellor + +data Cmd = Cmd String [String] + deriving (Read, Show) + +data Resp = StdoutLine String | StderrLine String | Done ExitCode + deriving (Read, Show) + +simpleSh :: FilePath -> IO () +simpleSh namedpipe = do + nukeFile namedpipe + s <- socket AF_UNIX Stream defaultProtocol + bind s (SockAddrUnix namedpipe) + listen s 2 + forever $ do + (client, _addr) <- accept s + h <- socketToHandle client ReadWriteMode + hSetBuffering h LineBuffering + maybe noop (run h) . readish =<< hGetLine h + where + run h (Cmd cmd params) = do + let p = (proc cmd params) + { std_in = Inherit + , std_out = CreatePipe + , std_err = CreatePipe + } + (Nothing, Just outh, Just errh, pid) <- createProcess p + chan <- newChan + + let runwriter = do + v <- readChan chan + hPutStrLn h (show v) + case v of + Done _ -> noop + _ -> runwriter + writer <- async runwriter + + let mkreader t from = maybe noop (const $ mkreader t from) + =<< catchMaybeIO (writeChan chan . t =<< hGetLine from) + void $ concurrently + (mkreader StdoutLine outh) + (mkreader StderrLine outh) + + writeChan chan . Done =<< waitForProcess pid + + wait writer + + hClose outh + hClose errh + 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 + hSetBuffering h LineBuffering + hPutStrLn h $ show $ Cmd cmd params + resps <- catMaybes . map readish . lines <$> hGetContents h + hClose h `after` handler resps diff --git a/propellor.cabal b/propellor.cabal index 4af11b27..d6070fa1 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -28,7 +28,7 @@ Executable propellor GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers + containers, network, async if (! os(windows)) Build-Depends: unix @@ -37,7 +37,7 @@ Library GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, dataenc + containers, network, async if (! os(windows)) Build-Depends: unix @@ -63,6 +63,7 @@ Library Propellor.Message Propellor.PrivData Propellor.Engine + Propellor.SimpleSh Propellor.Types Other-Modules: Utility.Applicative -- cgit v1.2.3