I wanna write a Haskell script which handles interaction with a minecraft server.
To send commands to the server, I have a file server.cmd where in the first line 1 command can be written which should be executed in the server (e.g. stop).
So, here is my code:
-- servermanager.hs
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module ServerManager where
import System.Process
import System.Exit
import GHC.IO.Handle
import Control.Monad
import System.Posix.Unistd
managerfile :: FilePath
managerfile = "manager.cmd"
serverfile :: FilePath
serverfile = "server.cmd"
main :: IO ()
main = do
(Just hin, _, _, _) <- createProcess (proc "java" ["-jar", "minecraft_server.1.8.9.jar", "nogui"]) {cwd = Just "/home/tekkkz/Downloads", std_in = CreatePipe, std_out = CreatePipe}
sleep 20
servercmd <- readFile serverfile
case servercmd of
"stop" -> do
putStrLn ">> [S] Stop"
hPutStr hin "stop"
_ -> return ()
When there is "stop" in my server.cmd file, it print's out the string but is not stopping the server ... why not?
You didn't flush the pipe, due to the lazyness of IO actions the program silently terminate before hPutStr has a chance to do its job.
Try add this line after hPutStr hin "stop":
hFlush hin
Related
I have a long running process which I need to start.
It takes a few seconds to start, and outputs logs to stdout, with one that indicates it is ready.
I would like to:
start the process silently, so that the stdout from the process is not displayed in my session.
capture the output as it streams so that I can determine that it is ready.
have some handle on the process so that I can stop the process at a later point.
I have come close using Shelly, Turtle and System.Process, but fail to capture the stdout.
Using System.Process I had:
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import System.IO
import System.Process
startService :: IO ProcessHandle
startService = do
let cmd = "./my-service"
args = [ "-p 1234" ]
(_, Just hout, _, p) <- createProcess $ (proc cmd args) { std_out = CreatePipe }
started <- either id id <$> race (checkStarted hout) timeOut
unless started $ fail "Service not started"
pure p
where
checkStarted :: Handle -> IO Bool
checkStarted h = do
str <- hGetLine h
-- check str for started log, else loop
timeOut :: IO Bool
timeOut = do
threadDelay 10000000
pure False
But The handler hout was never in a ready state.
Using Shelly I had:
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import Control.Concurrent.MVar
import Shelly
import System.IO
startService :: IO (Async ())
startService = do
let cmd = "./my-service"
args = [ "-p 1234" ]
startedMVar <- newEmptyMVar
async <- shelly $ asyncSh $ runHandle cmd args $ recordWhenStarted startedMVar
started <- either id id <$> race (readMVar startedMVar) timeOut
unless started $ fail "Service not started"
pure async
where
recordWhenStarted :: MVar Bool -> Text -> IO ()
recordWhenStarted mvar txt =
when (isStartedLog txt) $
modifyMVar_ mvar (const $ pure True)
timeOut :: IO Bool
timeOut = do
threadDelay 10000000
pure False
But the recordWhenStarted is never called.
The following is example of starting process and reading stdout in a program of mine:
runMystem :: [T.Text] -> IO T.Text
runMystem stemWords = do
(i, o, _, ph) <- createProcess (proc mystemExecutabe mystemParams) { std_in = CreatePipe, std_out = CreatePipe }
res <- flip (maybe (return T.empty)) i $ \hIn ->
flip (maybe (return T.empty)) o $ \hOut -> do
hSetEncoding hIn utf8
hSetEncoding hOut utf8
forM_ stemWords $ TIO.hPutStrLn hIn
TIO.hGetContents hOut
void $ waitForProcess ph
return res
This answer uses the process-streaming library (written by the author of this answer) which is a set of helpers over process.
{-# language OverloadedStrings #-}
{-# language NumDecimals #-}
import System.Process.Streaming (execute,piped,shell,foldOut,transduce1)
import qualified System.Process.Streaming.Text as PT
import Data.Text.Lazy (isInfixOf)
import Control.Applicative
import Control.Monad
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Concurrent.MVar
main :: IO ()
main = do
started <- newEmptyMVar
let execution =
execute (piped (shell "{ sleep 3 ; echo fooo ; sleep 3 ; }")) $
foldOut . transduce1 PT.utf8x . PT.eachLine $ lookline
lookline line = do
when (isInfixOf "foo" line) (putMVar started ())
return (Right ())
stopOrNot =
do abort <- race (threadDelay 4e6) (readMVar started)
case abort of
Left () -> return () -- stop immediately
Right () -> runConcurrently empty -- sleep forever
result <- race stopOrNot execution
print result
execute installs exception handlers that terminate the external process when an asynchronous exceptions arrives, to it is safe to use race with it.
execute also takes care to drain any standard stream that is not read explicitly (like stderr in this case) to avoid a common source of deadlocks.
I'm trying to pipe the stdin of my program to an external process using the following
import System.IO
import System.Posix.IO
import System.Posix.Process
import qualified System.Process as P
import Control.Concurrent (forkIO, killThread)
import Control.Monad
main :: IO ()
main = do
h <- fdToHandle stdInput
(Just hIn, _, _, p) <-
P.createProcess (P.shell "runhaskell echo.hs"){ P.std_in = P.CreatePipe }
hSetBuffering hIn NoBuffering
tid <- forkIO $ getInput hIn
e <- P.waitForProcess p
killThread tid
print e
getInput hin = do
forever $ do
l <- getLine
hPutStrLn hin l
where echo.hs just echoes stdin to stdout, but if I wait a couple seconds between giving new input, I get the following error:
pipes.hs: <stdin>: hGetLine: invalid argument (Bad file descriptor)
when I tried compiling with ghc pipes.hs, the compiled program would not redirect stdin to the stdin of echo.hs at all
Your fdToHandler stdInput call creates a new Handle pointing at file descriptor 0 (stdin) of the original process. After a bit of time, the garbage collector notices that it's no longer being used, and garbage collects the Handle, which in turn causes the underlying file descriptor to be closed. Then your getLine (which uses System.IO.stdin) call fails. That's because that Handle is still open, but the underlying file descriptor it's pointing at has been closed.
FWIW, I'd recommend using binary I/O on the handles to avoid issues with character encodings.
I'm writing a socket server with runTCPServer from conduit-extra (formerly known as network-conduit). My goal is to interact with my editor using this server --- activate the server from the editor (most likely just by calling external command), use it, and terminate the server when the work is done.
For simplicity, I start with a simple echo server, and let's say I'd like to shut down the whole process when the connection is closed.
So I tried:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Conduit
import Data.Conduit.Network
import Data.ByteString (ByteString)
import Control.Monad.IO.Class (liftIO)
import System.Exit (exitSuccess)
import Control.Exception
defaultPort :: Int
defaultPort = 4567
main :: IO ()
main = runTCPServer (serverSettings defaultPort "*") $ \ appData ->
appSource appData $$ conduit =$= appSink appData
conduit :: ConduitM ByteString ByteString IO ()
conduit = do
msg <- await
case msg of
Nothing -> liftIO $ do
putStrLn "Nothing left"
exitSuccess
-- I'd like the server to shut down here
(Just s) -> do
yield s
conduit
But this doesn't work -- the program continues to accept new connections. If I am not mistaken, this is because the thread listening to the connection we're dealing with exits with exitSuccess, but the entire process doesn't. So this is totally understandable, but I haven't been able to find a way to exit the whole process.
How do I terminate a server run by runTCPServer? Is runTCPServer something that's supposed to serve forever?
Here's a simple implementation of the idea described in comments:
main = do
mv <- newEmptyMVar
tid <- forkTCPServer (serverSettings defaultPort "*") $ \ appData ->
appSource appData $$ conduit mv =$= appSink appData
() <- takeMVar mv -- < -- wait for done signal
return ()
conduit :: MVar () -> ConduitM ByteString ByteString IO ()
conduit mv = do
msg <- await
case msg of
Nothing -> liftIO $ do
putStrLn "Nothing left"
putMVar mv () -- < -- signal that we're done
(Just s) -> do
yield s
conduit mv
I want to create a process and write some text from my haskell program into the process's stdin periodically (from an IO action).
The following works correctly in GHCi but don't work correctly when built and run. In GHCi everything works perfectly and the value from the IO action is fed in periodically. When built and run however, it seems to pause for arbitrarily long periods of time when writing to stdin of the process.
I've used CreateProcess (from System.Process) to create the handle and tried hPutStrLn (bufferent set to NoBuffering -- LineBuffering didnt work either).
So I'm trying the process-streaming package and pipes but can't seem to get anything to work at all.
The real question is this: How do i create a process from haskell and write to it periodically?
Minimal example that exhibits this behavior:
import System.Process
import Data.IORef
import qualified Data.Text as T -- from the text package
import qualified Data.Text.IO as TIO
import Control.Concurrent.Timer -- from the timers package
import Control.Concurrent.Suspend -- from the suspend package
main = do
(Just hin, _,_,_) <- createProcess_ "bgProcess" $
(System.Process.proc "grep" ["10"]) { std_in = CreatePipe }
ref <- newIORef 0 :: IO (IORef Int)
flip repeatedTimer (msDelay 1000) $ do
x <- atomicModifyIORef' ref $ \x -> (x + 1, x)
hSetBuffering hin NoBuffering
TIO.hPutStrLn hin $ T.pack $ show x
Any help will be greatly appreciated.
This is a pipes Producer that emits a sequence of numbers with a second delay:
{-# language NumDecimals #-}
import Control.Concurrent
import Pipes
import qualified Data.ByteString.Char8 as Bytes
periodic :: Producer Bytes.ByteString IO ()
periodic = go 0
where
go n = do
d <- liftIO (pure (Bytes.pack (show n ++ "\n"))) -- put your IO action here
Pipes.yield d
liftIO (threadDelay 1e6)
go (succ n)
And, using process-streaming, we can feed the producer to an external process like this:
import System.Process.Streaming
main :: IO ()
main = do
executeInteractive (shell "grep 10"){ std_in = CreatePipe } (feedProducer periodic)
I used executeInteractive, which sets std_in automatically to NoBuffering.
Also, if you pipe std_out and want to process each match immediately, be sure to pass the --line-buffered option to grep (or use the stdbuf command) to ensure that matches are immediately available at the output.
What about using threadDelay, e.g.:
import Control.Monad (forever)
import Control.Concurrent (threadDelay)
...
forever $ do
x <- atomicModifyIORef' ref $ \x -> (x + 1, x)
hSetBuffering hin NoBuffering
TIO.hPutStrLn hin $ T.pack $ show x
threadDelay 1000000 -- 1 sec
Spawn this off in another thread if you need to do other work at the same time.
You can remove he need for the IORef with:
loop h x = do
hSetBuffering h NoBuffering
TIO.hPutStrLn h $ T.pack $ show x
threadDelay 1000000
loop h (x+1)
And, of course, you only need to do the hSetBuffering once - e.g. do it just before you enter the loop.
I'm trying to implement simple TCP Client in Haskell. But it gets closed as soon as it connects. I don't know what is causing it to close. How could I make it so that it would print lines from server into stdout and send lines from stdin to server forever until stdin receives line ":quit"?
import Control.Monad (forever)
import Network (withSocketsDo, PortID(..), connectTo)
import System.IO
import Control.Concurrent (forkFinally)
import Control.Concurrent.Async (race)
main :: IO ()
main = withSocketsDo $ do
-- connect to my local tcp server
handle <- connectTo "192.168.137.1" (PortNumber 44444)
-- should close the connection using handle after everything is done
_ <- forkFinally (talk handle) (\_ -> hClose handle)
return ()
talk :: Handle -> IO ()
talk handle = do
hSetNewlineMode handle universalNewlineMode
hSetBuffering handle LineBuffering
-- if either one of them terminates, other one will get terminated
_ <- race (interactWithServer handle) (interactWithUser handle)
return ()
interactWithServer :: Handle -> IO ()
interactWithServer handle = forever $ do
line <- hGetLine handle
print line -- print a line that came from server into stdout
interactWithUser :: Handle -> IO ()
interactWithUser handle = do
line <- getLine
case line of
":quit" -> return () -- stop loop if user input is :quit
_ -> do hPutStrLn handle line
interactWithUser handle -- send, then continue looping
With Ørjan Johansen's help I figured it out. forkFinally was creating a thread then after that main thread was getting closed. That line was meant to wait until talk finished and then close the connection. It had to be (also shortened it)
main :: IO ()
main = withSocketsDo $ do
handle <- connectTo "192.168.137.1" (PortNumber 44444)
talk handle `finally` hClose handle
talk :: Handle -> IO ()
talk handle = do
hSetNewlineMode handle universalNewlineMode
hSetBuffering handle LineBuffering
_ <- race fromServer toServer
return ()
where
fromServer = forever $ do
line <- hGetLine handle
print line
toServer = do
line <- getLine
case line of
-- server accepts /quit as disconnect command so better send it to the server
":quit" -> do hPutStrLn handle "/quit"; return "Quit"
_ -> do hPutStrLn handle line; toServer
I hope this code is safe :D