allow --listen to have a port specified as well as the address
This commit is contained in:
parent
d6f962fc3d
commit
d1c182f9e2
2 changed files with 20 additions and 9 deletions
|
@ -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
|
||||||
|
|
|
@ -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!
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue