allow --listen to have a port specified as well as the address

This commit is contained in:
Joey Hess 2013-04-09 15:18:05 -04:00
parent d6f962fc3d
commit d1c182f9e2
2 changed files with 20 additions and 9 deletions

View file

@ -20,7 +20,6 @@ import Network.Wai.Logger
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Network.HTTP.Types import Network.HTTP.Types
import System.Log.Logger import System.Log.Logger
import Data.ByteString.Lazy.UTF8
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Network.Socket import Network.Socket
import Control.Exception import Control.Exception
@ -28,6 +27,7 @@ import Crypto.Random
import Data.Digest.Pure.SHA import Data.Digest.Pure.SHA
import qualified Web.ClientSession as CS import qualified Web.ClientSession as CS
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.UTF8 as L8
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
@ -67,22 +67,21 @@ webAppSettings = defaultSettings
} }
{- Binds to a local socket, or if specified, to a socket on the specified {- Binds to a local socket, or if specified, to a socket on the specified
- hostname or address. Selets any free port. - hostname or address. Selets any free port, unless the hostname ends with
- ":port"
- -
- Prefers to bind to the ipv4 address rather than the ipv6 address - Prefers to bind to the ipv4 address rather than the ipv6 address
- of localhost, if it's available. - of localhost, if it's available.
-} -}
getSocket :: Maybe HostName -> IO Socket getSocket :: Maybe HostName -> IO Socket
getSocket h = do getSocket h = do
addrs <- getAddrInfo (Just hints) hostname Nothing addrs <- getAddrInfo (Just hints) (Just hostname) port
case (partition (\a -> addrFamily a == AF_INET) addrs) of case (partition (\a -> addrFamily a == AF_INET) addrs) of
(v4addr:_, _) -> go v4addr (v4addr:_, _) -> go v4addr
(_, v6addr:_) -> go v6addr (_, v6addr:_) -> go v6addr
_ -> error "unable to bind to a local socket" _ -> error "unable to bind to a local socket"
where where
hostname (hostname, port) = maybe (localhost, Nothing) splitHostPort h
| isJust h = h
| otherwise = Just localhost
hints = defaultHints hints = defaultHints
{ addrFlags = [AI_ADDRCONFIG] { addrFlags = [AI_ADDRCONFIG]
, addrSocketType = Stream , addrSocketType = Stream
@ -102,6 +101,18 @@ getSocket h = do
listen sock maxListenQueue listen sock maxListenQueue
return sock return sock
{- Splits address:port. For IPv6, use [address]:port. The port is optional. -}
splitHostPort :: String -> (HostName, Maybe ServiceName)
splitHostPort s
| "[" `isPrefixOf` s = let (h, p) = break (== ']') (drop 1 s)
in if "]:" `isPrefixOf` p
then (h, Just $ drop 2 p)
else (h, Nothing)
| otherwise = let (h, p) = separate (== ':') s
in if null p
then (h, Nothing)
else (h, Just p)
{- Checks if debugging is actually enabled. -} {- Checks if debugging is actually enabled. -}
debugEnabled :: IO Bool debugEnabled :: IO Bool
debugEnabled = do debugEnabled = do
@ -129,7 +140,7 @@ logRequest req = do
, frombs $ lookupRequestField "user-agent" req , frombs $ lookupRequestField "user-agent" req
] ]
where where
frombs v = toString $ L.fromChunks [v] frombs v = L8.toString $ L.fromChunks [v]
lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req

View file

@ -204,8 +204,8 @@ subdirectories).
By default, the webapp can only be accessed from localhost, and running By default, the webapp can only be accessed from localhost, and running
it opens a browser window. it opens a browser window.
With the --listen= option, the webapp can be made to listen for With the --listen=address[:port] option, the webapp can be made to listen
connections on the specified address. This disables running a for connections on the specified address. This disables running a
local web browser, and outputs the url you can use to open the webapp local web browser, and outputs the url you can use to open the webapp
from a remote computer. from a remote computer.
Note that this does not yet use HTTPS for security, so use with caution! Note that this does not yet use HTTPS for security, so use with caution!