webapp: New --listen= option allows running the webapp on one computer and connecting to it from another.
Does not yet use HTTPS. I'd need to generate a certificate, and I'm not sure what's the best way to do that.
This commit is contained in:
parent
c80968c3dd
commit
5e2e4347a3
10 changed files with 92 additions and 45 deletions
|
@ -37,7 +37,7 @@ import Data.Monoid
|
|||
import Control.Arrow ((***))
|
||||
import Control.Concurrent
|
||||
|
||||
localhost :: String
|
||||
localhost :: HostName
|
||||
localhost = "localhost"
|
||||
|
||||
{- Command to use to run a web browser. -}
|
||||
|
@ -48,14 +48,15 @@ browserCommand = "open"
|
|||
browserCommand = "xdg-open"
|
||||
#endif
|
||||
|
||||
{- Binds to a socket on localhost, and runs a webapp on it.
|
||||
{- Binds to a socket on localhost, or possibly a different specified
|
||||
- hostname or address, and runs a webapp on it.
|
||||
-
|
||||
- An IO action can also be run, to do something with the address,
|
||||
- such as start a web browser to view the webapp.
|
||||
-}
|
||||
runWebApp :: Wai.Application -> (SockAddr -> IO ()) -> IO ()
|
||||
runWebApp app observer = do
|
||||
sock <- localSocket
|
||||
runWebApp :: Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()
|
||||
runWebApp h app observer = do
|
||||
sock <- getSocket h
|
||||
void $ forkIO $ runSettingsSocket webAppSettings sock app
|
||||
observer =<< getSocketName sock
|
||||
|
||||
|
@ -65,21 +66,23 @@ webAppSettings = defaultSettings
|
|||
{ settingsTimeout = 30 * 60
|
||||
}
|
||||
|
||||
{- Binds to a local socket, selecting any free port.
|
||||
{- Binds to a local socket, or if specified, to a socket on the specified
|
||||
- hostname or address. Selets any free port.
|
||||
-
|
||||
- Prefers to bind to the ipv4 address rather than the ipv6 address
|
||||
- of localhost, if it's available.
|
||||
-
|
||||
- As a (very weak) form of security, only connections from
|
||||
- localhost are accepted. -}
|
||||
localSocket :: IO Socket
|
||||
localSocket = do
|
||||
addrs <- getAddrInfo (Just hints) (Just localhost) Nothing
|
||||
-}
|
||||
getSocket :: Maybe HostName -> IO Socket
|
||||
getSocket h = do
|
||||
addrs <- getAddrInfo (Just hints) hostname Nothing
|
||||
case (partition (\a -> addrFamily a == AF_INET) addrs) of
|
||||
(v4addr:_, _) -> go v4addr
|
||||
(_, v6addr:_) -> go v6addr
|
||||
_ -> error "unable to bind to a local socket"
|
||||
where
|
||||
hostname
|
||||
| isJust h = h
|
||||
| otherwise = Just localhost
|
||||
hints = defaultHints
|
||||
{ addrFlags = [AI_ADDRCONFIG]
|
||||
, addrSocketType = Stream
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue