Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix a segfault on OS X

There's an OS X bug where passing AI_NUMERICSERV without a port number
causes the getaddrinfo syscall to segfault (which it shouldn't).

This commit was recreated from the 2.4.1.2 release, which commits were
somehow lost (i.e. not pushed to GitHub).
  • Loading branch information...
commit b5d4396220b0423b30403b95083f97b7889d5212 1 parent cde0eee
@tibbe tibbe authored
Showing with 59 additions and 5 deletions.
  1. +13 −5 Network/Socket.hsc
  2. +15 −0 network.cabal
  3. +31 −0 tests/Regression.hs
View
18 Network/Socket.hsc
@@ -173,7 +173,7 @@ module Network.Socket
) where
import Data.Bits
-import Data.List (foldl')
+import Data.List (delete, foldl')
import Data.Maybe (fromMaybe, isJust)
import Data.Word (Word8, Word16, Word32)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
@@ -1301,9 +1301,6 @@ instance Storable AddrInfo where
})
poke p (AddrInfo flags family socketType protocol _ _) = do
-#if defined(darwin_HOST_OS)
- zeroMemory p (#const sizeof(struct addrinfo))
-#endif
c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType
(#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)
@@ -1440,7 +1437,7 @@ getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol
getAddrInfo hints node service =
maybeWith withCString node $ \c_node ->
maybeWith withCString service $ \c_service ->
- maybeWith with hints $ \c_hints ->
+ maybeWith with filteredHints $ \c_hints ->
alloca $ \ptr_ptr_addrs -> do
ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs
case ret of
@@ -1452,6 +1449,17 @@ getAddrInfo hints node service =
ioError (ioeSetErrorString
(mkIOError NoSuchThing "getAddrInfo" Nothing
Nothing) err)
+ -- Leaving out the service and using AI_NUMERICSERV causes a
+ -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV
+ -- (which has no effect) in that case.
+ where
+#if defined(darwin_HOST_OS)
+ filteredHints = case service of
+ Nothing -> fmap (\ h -> h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }) hints
+ _ -> hints
+#else
+ filteredHints = hints
+#endif
followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]
View
15 network.cabal
@@ -70,6 +70,21 @@ test-suite simple
test-framework,
test-framework-hunit
+test-suite regression
+ hs-source-dirs: tests
+ main-is: Regression.hs
+ type: exitcode-stdio-1.0
+
+ build-depends:
+ base < 5,
+ bytestring,
+ HUnit,
+ network,
+ test-framework,
+ test-framework-hunit
+
+ ghc-options: -Wall
+
test-suite uri
hs-source-dirs: tests
main-is: uri001.hs
View
31 tests/Regression.hs
@@ -0,0 +1,31 @@
+-- | Tests for things that didn't work in the past.
+module Main where
+
+import Network.Socket
+import Test.Framework (Test, defaultMain)
+import Test.Framework.Providers.HUnit (testCase)
+
+------------------------------------------------------------------------
+-- Tests
+
+-- Used to segfault on OS X 10.8.2 due to AI_NUMERICSERV being set
+-- without a service being set. This is a OS X bug.
+testGetAddrInfo :: IO ()
+testGetAddrInfo = do
+ let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }
+ _ <- getAddrInfo (Just hints) (Just "localhost") Nothing
+ return ()
+
+------------------------------------------------------------------------
+-- List of all tests
+
+tests :: [Test]
+tests =
+ [ testCase "testGetAddrInfo" testGetAddrInfo
+ ]
+
+------------------------------------------------------------------------
+-- Test harness
+
+main :: IO ()
+main = withSocketsDo $ defaultMain tests
Please sign in to comment.
Something went wrong with that request. Please try again.