My current simple TCP echo server code looks like this
import Network.Socket
main :: IO ()
main = setup
setup :: IO ()
setup = do
sock <- socket AF_INET Stream 0
bind sock (SockAddrInet 5000 iNADDR_ANY);
listen sock 5
loop sock
loop :: Socket -> IO()
loop sock = do
conn <- accept sock
handleConnection conn
loop sock
handleConnection :: (Socket, SockAddr) -> IO ()
handleConnection (clntSock, clntAddr) = do
putStrLn $ "Handling client: " ++ show clntAddr
clntMsg <- recv clntSock 256
_ <- send clntSock clntMsg
close clntSock
The loop runs forever. I tried few methods to listen for keyboard press and then exit. But they all blocked main loop. So that server wasn't responding to client and was just waiting for key press.
How to interact with command line while still serving clients?
You need to wait for input, probably on standard in.
Modifying your existing code ever so slightly:
loop sock = do
conn <- accept sock
handleConnection conn
done <- hWaitForInput stdin 1
if done then return () else loop sock
You'll also need to add this import:
import System.IO (hWaitForInput, stdin)
Related
I wrote this simple tcp server:
import Network
import Network.Socket.ByteString
main :: IO()
main = do
sock <- listenOn $ PortNumber 2000
contents <- recv sock 4096
print contents
Stack built successfully, so then I ran the server, using telnet to test it, but I got an error:
On linux:
Network.Socket.recvBuf:invalid argument (Transport endpoint is not connected)
On windows:
Network.Socket.recvBuf:failed(No error)
What's wrong with the program?
listenOn just creates a "listen socket" which "listen" new connections to your server. You should to use the accept function to obtain new clients, like this:
main :: IO ()
main = do
sock <- listenOn $ PortNumber 2000
(client, _, _) <- accept sock
contents <- hGetContents client
print contents
sClose sock
Or use lowlevel the accept function (from the Network.Socket module) to obtain socket:
main :: IO ()
main = do
sock <- listenOn $ PortNumber 2000
(client, _) <- accept sock
contents <- recv client 4096
print contents
sClose client
sClose sock
If you want to handle more clients you can use forkIO like this:
main :: IO ()
main = do
sock <- listenOn $ PortNumber 2000
forever $ do
(client, _) <- accept sock
forkIO $ do
contents <- recv client 4096
print contents
sClose client
I'm new to trying to program with Unix sockets, and struggling to get a simple server working. I'd like this to stay running and print messages it receives, but instead it prints the first message and exits. Depends on network, and bytestring.
module Main where
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as C
import Control.Monad
main :: IO ()
main = withSocketsDo $ do
sock <- socket AF_UNIX Stream 0 -- and try UDP?
bind sock (SockAddrUnix "/tmp/test_sock.ipc")
listen sock maxListenQueue -- TODO is maxListenQueue what we want?
(conn, _) <- accept sock
talk conn
close conn
close sock
putStrLn "DONE"
where
talk :: Socket -> IO ()
talk conn =
do msg <- recv conn 1024
unless (C.null msg) $ do
C.putStrLn msg
talk conn
I'm testing with socat, which I also don't really know how to use:
echo "FOOOOO" | socat - UNIX-CONNECT:/tmp/test_sock.ipc
Any pointers on the haskell code, and what I might be misunderstanding about unix sockets would be helpful.
EDIT Using Datagram instead of Stream I'm able to get more or less what I want:
main :: IO ()
main = withSocketsDo $ do
sock <- socket AF_UNIX Datagram 0 -- and try UDP?
bind sock (SockAddrUnix "/tmp/test_sock.ipc")
-- for Datagram:
talk sock
close sock
putStrLn "DONE"
where
talk :: Socket -> IO ()
talk conn =
do msg <- recv conn 1024
unless (C.null msg) $ do
C.putStrLn msg
talk conn
And I can test successfully with:
echo "FOOOOO" | socat - UNIX-SENDTO:/tmp/test_sock.ipc
I think I'm interested in datagram sockets anyway, but I'll leave this open if anyone wants to explain things to me.
Your code only runs "accept" once, so it can only handle one connection. If you want to handle multiple connections, the "accept" part has to be repeated, not just the "recv" part.
module Main where
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as C
import Control.Monad
main :: IO ()
main = withSocketsDo $ do
sock <- socket AF_UNIX Stream 0 -- and try UDP?
bind sock (SockAddrUnix "/tmp/test_sock.ipc")
listen sock maxListenQueue -- TODO is maxListenQueue what we want?
go sock
close conn
close sock
putStrLn "DONE"
where
go sock = do
(conn,_) <- accept sock
talk conn
go sock
talk :: Socket -> IO ()
talk conn =
do msg <- recv conn 1024
unless (C.null msg) $ do
C.putStrLn msg
talk conn
I am creating a simple chat server using Haskell's Network library. The server has to do two things:
Broadcast a message every n ticks to all of the currently connected clients
Receive any messages from the clients sent to the server.
The server and client are defined as
data Server = Server {
sSocket :: Socket,
sPort :: Port,
sClients :: MVar (Set.Set ClientAddress)
}
newtype ClientAddress = ClientAddress (Handle, HostName, PortNumber)
deriving (Show)
A server is constructed by running the following function
startServer :: Port -> IO ThreadId --
startServer port = withSocketsDo $ do
socket <- listenOn $ PortNumber $ fromIntegral port
clients <- newMVar Set.empty
let server = Server socket port clients
forkIO $ forever $ do
client#(handle, host, port) <- accept socket
modifyMVar_ clients (\cs -> return $ Set.insert (ClientAddress client) cs)
forkIO $ forever $ serve $ ClientAddress client
forkIO $ forever $ sendServerUpdates 1000000 server
Note that the last two lines fork two different threads: the first for handling client connections and "serving" their messages, and the second for sending server broadcasts to the clients.
Broadcasting to the clients works as follows
sendServerUpdates :: Microsecond -> Server -> IO ()
sendServerUpdates frequency server = do
withMVar (sClients server) (mapM_ sendServerUpdate)
threadDelay frequency
sendServerUpdate :: ClientAddress -> IO ()
sendServerUpdate (ClientAddress (handle, host, port)) = do
putStrLn "Sending update."
The issue I have, is that receiving messages from the clients seem to block. I receive messages by checking if the handle has contents
serve :: ClientAddress -> IO ()
serve (ClientAddress (handle, host, port)) = do
b <- hIsEOF handle
putStrLn $ show $ b -- <-- It never makes it this far...
Unfortunately, the code never makes it to the second line to call the putStrLn. It seems like hIsEOF encounters some exception, although the documentation doesn't seem to mention it.
Why does my code block on hIsEOF forever?
In hIsEOF's documentation I found the following:
NOTE: hIsEOF may block, because it has to attempt to read from the
stream to determine whether there is any more data to be read.
I wouldn't have expected this. I wonder if hReady or hGetBufNonBlocking are any better? I've never tried the whole non-blocking IO bit in Haskell.
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
I'm trying to figure out how to properly use the OpenSSL.Session API in a concurrent context
E.g. assume I want to implement a stunnel-style ssl-wrapper, I'd expect to have the following basic skeleton structure, which implements a naive full-duplex tcp-port-forwarder:
runProxy :: PortID -> AddrInfo -> IO ()
runProxy localPort#(PortNumber lpn) serverAddrInfo = do
listener <- listenOn localPort
forever $ do
(sClient, clientAddr) <- accept listener
let finalize sServer = do
sClose sServer
sClose sClient
forkIO $ do
tidToServer <- myThreadId
bracket (connectToServer serverAddrInfo) finalize $ \sServer -> do
-- execute one 'copySocket' thread for each data direction
-- and make sure that if one direction dies, the other gets
-- pulled down as well
bracket (forkIO (copySocket sServer sClient
`finally` killThread tidToServer))
(killThread) $ \_ -> do
copySocket sClient sServer -- "controlling" thread
where
-- |Copy data from source to dest until EOF occurs on source
-- Copying may also be aborted due to exceptions
copySocket :: Socket -> Socket -> IO ()
copySocket src dst = go
where
go = do
buf <- B.recv src 4096
unless (B.null buf) $ do
B.sendAll dst buf
go
-- |Create connection to given AddrInfo target and return socket
connectToServer saddr = do
sServer <- socket (addrFamily saddr) Stream defaultProtocol
connect sServer (addrAddress saddr)
return sServer
How do I transform the above skeleton into a full-duplex ssl-wrapping tcp-forwarding proxy? Where are the dangers W.R.T to concurrent/parallel execution (in the context of the above use-case) of the function calls provided by the HsOpenSSL API?
PS: I'm still struggling to fully comprehend how to make the code robust w.r.t. to exceptions and resource-leaks. So, albeit not being the primary focus of this question, if you notice something bad in the code above, please leave a comment.
To do this you need to replace copySocket with two different functions, one to handle data from the plain socket to SSL and the other from SSL to the plain socket:
copyIn :: SSL.SSL -> Socket -> IO ()
copyIn src dst = go
where
go = do
buf <- SSL.read src 4096
unless (B.null buf) $ do
SB.sendAll dst buf
go
copyOut :: Socket -> SSL.SSL -> IO ()
copyOut src dst = go
where
go = do
buf <- SB.recv src 4096
unless (B.null buf) $ do
SSL.write dst buf
go
Then you need to modify connectToServer so that it establishes an SSL connection
-- |Create connection to given AddrInfo target and return socket
connectToServer saddr = do
sServer <- socket (addrFamily saddr) Stream defaultProtocol
putStrLn "connecting"
connect sServer (addrAddress saddr)
putStrLn "establishing ssl context"
ctx <- SSL.context
putStrLn "setting ciphers"
SSL.contextSetCiphers ctx "DEFAULT"
putStrLn "setting verfication mode"
SSL.contextSetVerificationMode ctx SSL.VerifyNone
putStrLn "making ssl connection"
sslServer <- SSL.connection ctx sServer
putStrLn "doing handshake"
SSL.connect sslServer
putStrLn "connected"
return sslServer
and change finalize to shut down the SSL session
let finalize sServer = do
putStrLn "shutting down ssl"
SSL.shutdown sServer SSL.Unidirectional
putStrLn "closing server socket"
maybe (return ()) sClose (SSL.sslSocket sServer)
putStrLn "closing client socket"
sClose sClient
Finally, don't forget to run your main stuff within withOpenSSL as in
main = withOpenSSL $ do
let hints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }
addrs <- getAddrInfo (Just hints) (Just "localhost") (Just "22222")
let addr = head addrs
print addr
runProxy (PortNumber 11111) addr