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)
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 had a weird problem with ByteString socket programming. I have minimized the issue to the following short scripts:
-- ByteString.hs
{-# LANGUAGE OverloadedStrings #-}
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
import Network.BSD
import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
connectMud :: HostName
-> String
-> IO Handle
connectMud hostname port = do
addrinfos <- getAddrInfo Nothing (Just hostname) (Just port)
let serveraddr = head addrinfos
sock <- socket (addrFamily serveraddr) Stream defaultProtocol
setSocketOption sock KeepAlive 1
connect sock (addrAddress serveraddr)
h <- socketToHandle sock ReadWriteMode
hSetBuffering h (BlockBuffering Nothing)
return h
main:: IO ()
main =
C8.putStrLn "connecting, please wait" >> connectMud "aardwolf.org" "4000"
>>= BS.hGetContents >>= C8.putStrLn
and
--ByteString_Lazy.hs
{-# LANGUAGE OverloadedStrings #-}
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
import Network.BSD
import System.IO
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as C8
connectMud :: HostName
-> String
-> IO Handle
connectMud hostname port = do
addrinfos <- getAddrInfo Nothing (Just hostname) (Just port)
let serveraddr = head addrinfos
sock <- socket (addrFamily serveraddr) Stream defaultProtocol
setSocketOption sock KeepAlive 1
connect sock (addrAddress serveraddr)
h <- socketToHandle sock ReadWriteMode
hSetBuffering h (BlockBuffering Nothing)
return h
main:: IO ()
main =
C8.putStrLn "connecting, please wait" >> connectMud "aardwolf.org" "4000"
>>= BS.hGetContents >>= C8.putStrLn
The only difference between these two short scripts is that one is using Data.ByteString and the other one Data.ByteString.Lazy. The lazy version works fine but the strict version does not seem to receive any output at all. Any thoughts?
I would guess that it has to do with the differing behavior of the two hGetContents functions in question (the lazy version vs the strict version).
The strict version "reads a handle's entire contents strictly into a ByteString." But you're trying to read from a stream, so the EOF is never encountered.
Compare with the behavior of the lazy version:
Read entire handle contents lazily into a ByteString. Chunks are read on demand, using the default chunk size.
Once EOF is encountered, the Handle is closed.
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 curious to know what the best way to send 10 GB once over the network in Haskell? I don't want to send it as binary without having to write a decode/encoder. Is it best to keep it strict or lazy?
You can also use Pipes. A zlib compressed network example can be:
module Main where
--------------------------------------------------------------------------------
import Pipes
import qualified Pipes.Prelude as P
import Pipes.Network.TCP
import Data.ByteString
import Pipes.ByteString as PB
import System.Environment
import Pipes.Zlib
--------------------------------------------------------------------------------
myReceive :: (MonadIO m) => m ()
myReceive = serve (Host "127.0.0.1") "8000" $ \(sock, remote) -> do
Prelude.putStrLn $ "TCP connection established from " ++ show remote
runEffect $ decompress defaultWindowBits (fromSocket sock 4096) >-> PB.stdout
mySend :: IO ()
mySend = connect "127.0.0.1" "8000" $ \(sock, remote) -> do
Prelude.putStrLn $ "Connection established to " ++ show remote
runEffect $ compress bestCompression defaultWindowBits (PB.stdin) >-> toSocket sock
main = do
a:[] <- getArgs
case a of
"send" -> mySend
"receive" -> myReceive
_ -> Prelude.putStrLn "Usage: netsend <send|receive>"
I am trying to write a little script to send an email via gmail.
I can connect to gmail but when I try to hanshake it fails.
Any pointers to get the handshake a go?
Here is the code:
import Network.Socket
import Network
import Network.TLS
import Network.TLS.Extra
import Crypto.Random
import Data.CertificateStore -- to remove
import System.Certificate.X509 --to use I think
import System.IO
import Text.Printf
import Control.Monad (forever)
import qualified Data.ByteString.Char8 as B
main :: IO ()
main = emailGmail2
tListen :: Context -> IO ()
tListen ctx =
forever $ recvData ctx >>= B.putStrLn
cWrite :: Handle -> String -> IO ()
cWrite h s = do
hPrintf h "%s\r\n" s
printf "> %s\n" s
cListen :: Handle -> IO ()
cListen h =
forever $ hGetLine h >>= putStrLn
emailGmail2 = do
let
host = "smtp.gmail.com"
port = 587
params = defaultParamsClient
g <- newGenIO :: IO SystemRandom
h <- connectTo host (PortNumber (fromIntegral port))
hSetBuffering h LineBuffering
cWrite h "EHLO"
cWrite h "STARTTLS"
--cListen h
con <- contextNewOnHandle h params g
handshake con
tListen con
And here's the error:
HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header
type: 50\nFrom:\theader\n\n")
This error is partially to do with handling the SMTP protocol. Looking at the RFC for Secure SMTP over TLS RFC 2487 there is an example client-server dialogue.
S: <waits for connection on TCP port 25>
C: <opens connection>
S: 220 mail.imc.org SMTP service ready
C: EHLO mail.ietf.org
S: 250-mail.imc.org offers a warm hug of welcome
S: 250 STARTTLS
C: STARTTLS
S: 220 Go ahead
C: <starts TLS negotiation>
C & S: <negotiate a TLS session>
C & S: <check result of negotiation>
C: <continues by sending an SMTP command>
. . .
In your code you are sending EHLO and STARTTLS, and then immediately beginning the handshake negotiation. I believe what is happening is that the server is still sending some of the 250 and 220 codes above and the TLS library is trying to interpret these as TLS messages which is causing the problem.
Indeed if I open another terminal and listen to port 587 with netcat and change the program to connect to localhost I get the same error if I reply with "250 STARTTLS"
Changing this got the program to work for me:
import Network.Socket
import Network
import Network.TLS
import Network.TLS.Extra
import Crypto.Random
import qualified Crypto.Random.AESCtr as RNG
import System.IO
import Text.Printf
import Control.Monad (when)
import Data.List (isPrefixOf)
ciphers :: [Cipher]
ciphers =
[ cipher_AES128_SHA1
, cipher_AES256_SHA1
, cipher_RC4_128_MD5
, cipher_RC4_128_SHA1
]
main :: IO ()
main = emailGmail2
cWrite :: Handle -> String -> IO ()
cWrite h s = do
hPrintf h "%s\r\n" s
printf "> %s\n" s
cWaitFor :: Handle -> String -> IO ()
cWaitFor h str = do
ln <- hGetLine h
putStrLn ln
when (not $ str `isPrefixOf` ln) (cWaitFor h str)
emailGmail2 = do
let
host = "smtp.gmail.com"
port = 587
params = defaultParamsClient{pCiphers = ciphers}
g <- RNG.makeSystem
h <- connectTo host (PortNumber (fromIntegral port))
hSetBuffering h LineBuffering
cWrite h "EHLO"
cWaitFor h "250-STARTTLS"
cWrite h "STARTTLS"
cWaitFor h "220"
con <- contextNewOnHandle h params g
handshake con
bye con
Also note that I needed to add some ciphers from Network.TLS.Extras as otherwise I got an Illegal Parameter error. I found the code for this and to add logging from Vincent's tests on the Github page.
Another note: In case you run into more issues I should point out that I used the command line programs gnutls-cli and ssldump to debug the issue with ciphers mentioned above.