Ticket #3937: ListenOn.hs

File ListenOn.hs, 990 bytes (added by guest, 4 years ago)
Line 
1
2module Main where
3
4import Network
5import Network.Socket
6import System.IO
7import Control.Concurrent
8import Control.Exception
9import Network.BSD
10
11listenOn2 :: Int -> IO Socket
12listenOn2 port = do
13    proto <- getProtocolNumber "tcp"
14    bracketOnError
15        (socket AF_INET Stream proto)
16        (sClose)
17        (\sock -> do
18            setSocketOption sock ReuseAddr 1
19            bindSocket sock (SockAddrInet (fromIntegral port) iNADDR_ANY)
20            listen sock maxListenQueue
21            return sock
22        )
23
24httpServer = do
25    socket <- listenOn2 (8999)
26    putStrLn "Accepting connections..."
27    (handle,_,_) <- Network.accept socket
28    putStrLn "Got a connection"
29    hClose handle
30    sClose socket
31
32main = withSocketsDo $ do
33    putStrLn "Started"
34    httpTid <- forkIO $ httpServer
35    -- let it start
36    threadDelay 1000000
37    putStrLn "About to kill server thread..."
38    killThread httpTid
39    putStrLn "Server thread killed"