@@ -3,6 +3,7 @@
33{-# LANGUAGE OverloadedStrings #-}
44{-# LANGUAGE CPP #-}
55{-# LANGUAGE BangPatterns #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
67---------------------------------------------------------
78--
89-- Module : Network.Wai.Handler.Warp
@@ -79,6 +80,7 @@ import Control.Exception
7980 ( bracket, finally, Exception, SomeException, catch
8081 , fromException, AsyncException (ThreadKilled)
8182 , bracketOnError
83+ , IOException
8284 )
8385import Control.Concurrent (forkIO)
8486import qualified Data.Char as C
@@ -137,17 +139,26 @@ bindPort p s = do
137139 addrs <- getAddrInfo (Just hints) host port
138140 -- Choose an IPv6 socket if exists. This ensures the socket can
139141 -- handle both IPv4 and IPv6 if v6only is false.
140− let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs
141− addr = if null addrs' then head addrs else head addrs'
142− bracketOnError
143− (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
144− (sClose)
145− (\sock -> do
146− setSocketOption sock ReuseAddr 1
147− bindSocket sock (addrAddress addr)
148− listen sock maxListenQueue
149− return sock
150− )
142+ let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs ++ filter (\x -> addrFamily x /= AF_INET6) addrs
143+
144+ tryAddrs (addr1:rest@(_:_)) = putStrLn ("trying: " ++ show addr1) >>
145+ catch
146+ (theBody addr1)
147+ (\(_ :: IOException) -> putStrLn "retrying ... " >> tryAddrs rest)
148+ tryAddrs (addr1:[]) = theBody addr1
149+ tryAddrs _ = error "bindPort: addrs is empty"
150+ theBody addr =
151+ bracketOnError
152+ (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
153+ (sClose)
154+ (\sock -> do
155+ putStrLn $ show addr ++ " out of " ++ show addrs
156+ setSocketOption sock ReuseAddr 1
157+ bindSocket sock (addrAddress addr)
158+ listen sock maxListenQueue
159+ return sock
160+ )
161+ tryAddrs addrs'
151162
152163-- | Run an 'Application' on the given port. This calls 'runSettings' with
153164-- 'defaultSettings'.