@@ -4,6 +4,7 @@
44{-# LANGUAGE CPP #-}
55{-# LANGUAGE BangPatterns #-}
66{-# LANGUAGE MagicHash #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
78---------------------------------------------------------
89--
910-- Module : Network.Wai.Handler.Warp
@@ -82,6 +83,7 @@ import Control.Exception
8283 ( bracket, finally, Exception, SomeException, catch
8384 , fromException, AsyncException (ThreadKilled)
8485 , bracketOnError
86+ , IOException
8587 )
8688import Control.Concurrent (forkIO)
8789import Data.Maybe (fromMaybe, isJust)
@@ -174,17 +176,25 @@ bindPort p s = do
174176 addrs <- getAddrInfo (Just hints) host port
175177 -- Choose an IPv6 socket if exists. This ensures the socket can
176178 -- handle both IPv4 and IPv6 if v6only is false.
177− let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs
178− addr = if null addrs' then head addrs else head addrs'
179− bracketOnError
180− (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
181− sClose
182− (\sock -> do
183− setSocketOption sock ReuseAddr 1
184− bindSocket sock (addrAddress addr)
185− listen sock maxListenQueue
186− return sock
187− )
179+ let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs ++ filter (\x -> addrFamily x /= AF_INET6) addrs
180+
181+ tryAddrs (addr1:rest@(_:_)) =
182+ catch
183+ (theBody addr1)
184+ (\(_ :: IOException) -> tryAddrs rest)
185+ tryAddrs (addr1:[]) = theBody addr1
186+ tryAddrs _ = error "bindPort: addrs is empty"
187+ theBody addr =
188+ bracketOnError
189+ (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
190+ (sClose)
191+ (\sock -> do
192+ setSocketOption sock ReuseAddr 1
193+ bindSocket sock (addrAddress addr)
194+ listen sock maxListenQueue
195+ return sock
196+ )
197+ tryAddrs addrs'
188198
189199-- | Run an 'Application' on the given port. This calls 'runSettings' with
190200-- 'defaultSettings'.