1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Internal.Http.Server.Socket.Tests (tests) where
------------------------------------------------------------------------------
import Control.Applicative ((<$>))
import qualified Network.Socket as N
------------------------------------------------------------------------------
import Control.Concurrent (forkIO, killThread, newEmptyMVar, putMVar, readMVar, takeMVar)
import qualified Control.Exception as E
import Data.IORef (newIORef, readIORef, writeIORef)
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertEqual)
------------------------------------------------------------------------------
import qualified Snap.Internal.Http.Server.Socket as Sock
import Snap.Test.Common (eatException, expectException, withSock)
------------------------------------------------------------------------------
#ifdef HAS_UNIX_SOCKETS
import System.Directory (getTemporaryDirectory)
import System.FilePath ((</>))
import qualified System.Posix as Posix
# if !MIN_VERSION_unix(2,6,0)
import Control.Monad.State (replicateM)
import Control.Monad.Trans.State.Strict as State
import qualified Data.Vector.Unboxed as V
import System.Directory (createDirectoryIfMissing)
import System.Random (StdGen, newStdGen, randomR)
# endif
#else
import Snap.Internal.Http.Server.Address (AddressNotSupportedException)
#endif
------------------------------------------------------------------------------
#ifdef HAS_UNIX_SOCKETS
mkdtemp :: String -> IO FilePath
# if MIN_VERSION_unix(2,6,0)
mkdtemp = Posix.mkdtemp
# else
tMPCHARS :: V.Vector Char
tMPCHARS = V.fromList $! ['a'..'z'] ++ ['0'..'9']
mkdtemp template = do
suffix <- newStdGen >>= return . State.evalState (chooseN 8 tMPCHARS)
let dir = template ++ suffix
createDirectoryIfMissing False dir
return dir
where
choose :: V.Vector Char -> State.State StdGen Char
choose v = do let sz = V.length v
idx <- State.state $ randomR (0, sz - 1)
return $! (V.!) v idx
chooseN :: Int -> V.Vector Char -> State.State StdGen String
chooseN n v = replicateM n $ choose v
#endif
#endif
------------------------------------------------------------------------------
tests :: [Test]
tests = [
testUnixSocketBind
#if !MIN_VERSION_network(3,0,0)
, testAcceptFailure
, testSockClosedOnListenException
#endif
]
------------------------------------------------------------------------------
-- TODO: fix these tests which rely on deprecated socket apis
#if !MIN_VERSION_network(3,0,0)
testSockClosedOnListenException :: Test
testSockClosedOnListenException = testCase "socket/closedOnListenException" $ do
ref <- newIORef Nothing
expectException $ Sock.bindSocketImpl (sso ref) bs ls "127.0.0.1" 4444
(Just sock) <- readIORef ref
let (N.MkSocket _ _ _ _ mvar) = sock
readMVar mvar >>= assertEqual "socket closed" N.Closed
where
sso ref sock _ _ = do
let (N.MkSocket _ _ _ _ mvar) = sock
readMVar mvar >>= assertEqual "socket not connected" N.NotConnected
writeIORef ref (Just sock) >> fail "set socket option"
bs _ _ = fail "bindsocket"
ls _ _ = fail "listen"
------------------------------------------------------------------------------
testAcceptFailure :: Test
testAcceptFailure = testCase "socket/acceptAndInitialize" $ do
sockmvar <- newEmptyMVar
donemvar <- newEmptyMVar
E.bracket (Sock.bindSocket "127.0.0.1" $ fromIntegral N.aNY_PORT)
(N.close)
(\s -> do
p <- fromIntegral <$> N.socketPort s
forkIO $ server s sockmvar donemvar
E.bracket (forkIO $ client p)
(killThread)
(\_ -> do
csock <- takeMVar sockmvar
takeMVar donemvar
N.isConnected csock >>=
assertEqual "closed" False
)
)
where
server sock sockmvar donemvar = serve `E.finally` putMVar donemvar ()
where
serve = eatException $ E.mask $ \restore ->
Sock.acceptAndInitialize sock restore $ \(csock, _) -> do
putMVar sockmvar csock
fail "error"
client port = withSock port (const $ return ())
#endif
testUnixSocketBind :: Test
#ifdef HAS_UNIX_SOCKETS
testUnixSocketBind = testCase "socket/unixSocketBind" $
withSocketPath $ \path -> do
#if !MIN_VERSION_network(3,0,0)
E.bracket (Sock.bindUnixSocket Nothing path) N.close $ \sock -> do
N.isListening sock >>= assertEqual "listening" True
#endif
expectException $ E.bracket (Sock.bindUnixSocket Nothing "a/relative/path")
N.close doNothing
expectException $ E.bracket (Sock.bindUnixSocket Nothing "/relative/../path")
N.close doNothing
expectException $ E.bracket (Sock.bindUnixSocket Nothing "/hopefully/not/existing/path")
N.close doNothing
#ifdef LINUX
-- Most (all?) BSD systems ignore access mode on unix sockets.
-- Should we still check it?
-- This is pretty much for 100% coverage
expectException $ E.bracket (Sock.bindUnixSocket Nothing "/")
N.close doNothing
let mode = 0o766
E.bracket (Sock.bindUnixSocket (Just mode) path) N.close $ \_ -> do
-- Should check sockFd instead of path?
sockMode <- fmap Posix.fileMode $ Posix.getFileStatus path
assertEqual "access mode" (fromIntegral mode) $
Posix.intersectFileModes Posix.accessModes sockMode
#endif
where
doNothing _ = return ()
withSocketPath act = do
tmpRoot <- getTemporaryDirectory
tmpDir <- mkdtemp $ tmpRoot </> "snap-server-test-"
let path = tmpDir </> "unixSocketBind.sock"
E.finally (act path) $ do
eatException $ Posix.removeLink path
eatException $ Posix.removeDirectory tmpDir
#else
testUnixSocketBind = testCase "socket/unixSocketBind" $ do
caught <- E.catch (Sock.bindUnixSocket Nothing "/tmp/snap-sock.sock" >> return False)
$ \(e :: AddressNotSupportedException) -> length (show e) `seq` return True
assertEqual "not supported" True caught
#endif
|
