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
Related
currently I have some code which creates a server and a client for some testing purposes.
Server code
import Network.Socket
import Network.Socket.ByteString as NSB
import Network.Socket.ByteString.Lazy as NSBL
import Data.ByteString.Lazy as BSL
import Data.ByteString as BS
import Data.HashMap as HM
import System.IO as IO
main = withSocketsDo $ do
sock <- socket AF_INET Stream 0
setSocketOption sock ReuseAddr 1
bindSocket sock (SockAddrInet (fromInteger 8585) iNADDR_ANY)
listen sock 100
servLoop sock
servLoop sock = do
client = accept sock
IO.putStrLn "Got a connection"
h <- SocketToHandle client ReadWriteMode
hSetBuffering h NoBuffering
req <- BSL.hGet h 1024
IO.putStrLn "Got some contents:"
IO.putStrLn $ show req
Client Code
import Network.Socket
import Network.BSD
import Control.Monad
import System.IO as IO
import Data.Text as T
import Data.ByteString.Lazy as BSL
import Data.MessagePack as MP
main = withSocketsDo $ do
sock <- socket AF_INET Stream 0
setSocketOption sock ReuseAddr 1
addr <- liftM hostAddresses $ getHostByName "localhost"
connect sock $ SockAddrInet (fromInteger 8585) (Prelude.head addr)
handle <- socketToHandle sock ReadWriteMode
replicateM_ 5 $ BSL.hPut handle $ MP.pack ("Hello host" :: Text)
hFlush handle
getLine
replicateM_ 5 $ BSL.hPut handle $ MP.pack ("Hello host" :: Text)
hFlush handle
hClose handle
The observed behaviour is that the message is not sent until hClose handle is called on the client side. However, I would like to keep the handle open for sending more requests and receiving responses rapidly. Am I going about this the right way? And if so, is there a way to keep the handle open but read and write the socket?
hGet keeps trying to read until it has as many bytes as you asked for, namely 1024. You probably want to use hGetNonBlocking instead. Or something like:
do
r1 <- BSL.hGet h 1
rRest <- BSL.hGetNonBlocking h 1024
return (r1 BS.append rRest)
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 trying to create a simple server using Haskell. When clients connect to the server, the server records their address. Every n microseconds the server sends out a broadcast.
Here is the server
data Server = Server {
sSocket :: Socket,
sPort :: Port,
sClients :: MVar [ClientAddress]
}
(Notice the MVar that allows the clients to be used from multiple threads.)
This is how a server is created
startServer port = withSocketsDo $ do
socket <- listenOn $ PortNumber $ fromIntegral port
clients <- newEmptyMVar
let server = Server socket port clients
forkIO $ forever $ accept socket >>= forkIO . (handleClientRequest server)
forever $ updateClients server 1000000
The server uses its thread and forks another. The forked thread handles any incoming client requests
handleClientRequest server client = do
clients <- takeMVar $ sClients server
putMVar (sClients server) (client : clients)
and the broadcast is sent using the updateClients function
updateClients server frequency = do
putStrLn "1"
clients <- (takeMVar $ sClients server)
putStrLn "2"
putStrLn $ show $ length clients
threadDelay frequency
The problem I encounter is that "2" is never printed to the screen. I believe this is because the takeMVar line in updateClients is never finishing.
Why would this freeze?
You start with an empty MVar, so takeMVar blocks forever. Try using newMVar [] instead of newEmptyMVar, possibly like this:
startServer port = withSocketsDo $ do
socket <- listenOn $ PortNumber $ fromIntegral port
clients <- newMVar []
let server = Server socket port clients
forkIO $ forever $ accept socket >>= forkIO . (handleClientRequest server)
forever $ updateClients server 1000000
Now, the MVar is always full, except when it's actually being modified by a client.
When you use an MVar to protect a critical section, it's helpful to think of what the normal state is; in this case it's a list of clients. The only time the MVar should be empty is when a client is actually modifying the state, so if you can use modifyMVar and set up the initial state, your code should be deadlock-free.
Also, if you can use withMVar instead of takeMVar/putMVar you should do so, because it leaves the MVar in a consistent state if an async exception arises.
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)
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