mirror of
https://github.com/snoyberg/keter.git
synced 2024-12-15 01:23:09 +03:00
Removed host list on Keter welcome page
This commit is contained in:
parent
b0c173a8c1
commit
52971e4b6f
@ -87,14 +87,12 @@ keter input' = do
|
|||||||
_ <- forkIO $ Proxy.reverseProxy
|
_ <- forkIO $ Proxy.reverseProxy
|
||||||
(serverSettings configPort configHost)
|
(serverSettings configPort configHost)
|
||||||
(runKIOPrint . PortMan.lookupPort portman)
|
(runKIOPrint . PortMan.lookupPort portman)
|
||||||
(runKIOPrint $ PortMan.hostList portman)
|
|
||||||
case configSsl of
|
case configSsl of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just ssl -> do
|
Just ssl -> do
|
||||||
_ <- forkIO $ Proxy.reverseProxySsl
|
_ <- forkIO $ Proxy.reverseProxySsl
|
||||||
(Proxy.setDir dir ssl)
|
(Proxy.setDir dir ssl)
|
||||||
(runKIOPrint . PortMan.lookupPort portman)
|
(runKIOPrint . PortMan.lookupPort portman)
|
||||||
(runKIOPrint $ PortMan.hostList portman)
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
mappMap <- M.newMVar Map.empty
|
mappMap <- M.newMVar Map.empty
|
||||||
|
@ -18,7 +18,6 @@ module Keter.PortManager
|
|||||||
, addEntry
|
, addEntry
|
||||||
, removeEntry
|
, removeEntry
|
||||||
, lookupPort
|
, lookupPort
|
||||||
, hostList
|
|
||||||
-- * Initialize
|
-- * Initialize
|
||||||
, start
|
, start
|
||||||
) where
|
) where
|
||||||
@ -46,7 +45,6 @@ data Command = GetPort (Either SomeException Port -> KIO ())
|
|||||||
| AddEntry Host PortEntry
|
| AddEntry Host PortEntry
|
||||||
| RemoveEntry Host
|
| RemoveEntry Host
|
||||||
| LookupPort S.ByteString (Maybe PortEntry -> KIO ())
|
| LookupPort S.ByteString (Maybe PortEntry -> KIO ())
|
||||||
| HostList ([S.ByteString] -> KIO ())
|
|
||||||
|
|
||||||
-- | An abstract type which can accept commands and sends them to a background
|
-- | An abstract type which can accept commands and sends them to a background
|
||||||
-- nginx thread.
|
-- nginx thread.
|
||||||
@ -110,9 +108,6 @@ start Settings{..} = do
|
|||||||
LookupPort h f -> do
|
LookupPort h f -> do
|
||||||
NState {..} <- S.get
|
NState {..} <- S.get
|
||||||
lift $ f $ Map.lookup h nsEntries
|
lift $ f $ Map.lookup h nsEntries
|
||||||
HostList f -> do
|
|
||||||
NState {..} <- S.get
|
|
||||||
lift $ f $ Map.keys nsEntries
|
|
||||||
return $ Right $ PortManager $ writeChan chan
|
return $ Right $ PortManager $ writeChan chan
|
||||||
where
|
where
|
||||||
change f = do
|
change f = do
|
||||||
@ -158,9 +153,3 @@ lookupPort (PortManager f) h = do
|
|||||||
x <- newEmptyMVar
|
x <- newEmptyMVar
|
||||||
f $ LookupPort h $ \p -> putMVar x p
|
f $ LookupPort h $ \p -> putMVar x p
|
||||||
takeMVar x
|
takeMVar x
|
||||||
|
|
||||||
hostList :: PortManager -> KIO [S.ByteString]
|
|
||||||
hostList (PortManager f) = do
|
|
||||||
x <- newEmptyMVar
|
|
||||||
f $ HostList $ \p -> putMVar x p
|
|
||||||
takeMVar x
|
|
||||||
|
@ -3,14 +3,12 @@
|
|||||||
module Keter.Proxy
|
module Keter.Proxy
|
||||||
( reverseProxy
|
( reverseProxy
|
||||||
, PortLookup
|
, PortLookup
|
||||||
, HostList
|
|
||||||
, reverseProxySsl
|
, reverseProxySsl
|
||||||
, setDir
|
, setDir
|
||||||
, TLSConfig
|
, TLSConfig
|
||||||
, TLSConfigNoDir
|
, TLSConfigNoDir
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Keter.Prelude ((++))
|
|
||||||
import Prelude hiding ((++), FilePath)
|
import Prelude hiding ((++), FilePath)
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
import Data.Conduit.Network
|
import Data.Conduit.Network
|
||||||
@ -18,11 +16,8 @@ import Data.ByteString (ByteString)
|
|||||||
import Keter.PortManager (PortEntry (..))
|
import Keter.PortManager (PortEntry (..))
|
||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import Blaze.ByteString.Builder (fromByteString, toLazyByteString)
|
|
||||||
import Data.Monoid (mconcat)
|
|
||||||
import Keter.SSL
|
import Keter.SSL
|
||||||
import Network.HTTP.ReverseProxy (rawProxyTo, ProxyDest (ProxyDest), waiToRaw)
|
import Network.HTTP.ReverseProxy (rawProxyTo, ProxyDest (ProxyDest), waiToRaw)
|
||||||
import Control.Applicative ((<$>))
|
|
||||||
import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
|
import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
|
||||||
import qualified Network.Wai as Wai
|
import qualified Network.Wai as Wai
|
||||||
import Network.HTTP.Types (status301)
|
import Network.HTTP.Types (status301)
|
||||||
@ -30,24 +25,21 @@ import Network.HTTP.Types (status301)
|
|||||||
-- | Mapping from virtual hostname to port number.
|
-- | Mapping from virtual hostname to port number.
|
||||||
type PortLookup = ByteString -> IO (Maybe PortEntry)
|
type PortLookup = ByteString -> IO (Maybe PortEntry)
|
||||||
|
|
||||||
type HostList = IO [ByteString]
|
reverseProxy :: ServerSettings IO -> PortLookup -> IO ()
|
||||||
|
reverseProxy settings = runTCPServer settings . withClient
|
||||||
|
|
||||||
reverseProxy :: ServerSettings IO -> PortLookup -> HostList -> IO ()
|
reverseProxySsl :: TLSConfig -> PortLookup -> IO ()
|
||||||
reverseProxy settings x = runTCPServer settings . withClient x
|
reverseProxySsl settings = runTCPServerTLS settings . withClient
|
||||||
|
|
||||||
reverseProxySsl :: TLSConfig -> PortLookup -> HostList -> IO ()
|
|
||||||
reverseProxySsl settings x = runTCPServerTLS settings . withClient x
|
|
||||||
|
|
||||||
withClient :: PortLookup
|
withClient :: PortLookup
|
||||||
-> HostList
|
|
||||||
-> Application IO
|
-> Application IO
|
||||||
withClient portLookup hostList =
|
withClient portLookup =
|
||||||
rawProxyTo getDest
|
rawProxyTo getDest
|
||||||
where
|
where
|
||||||
getDest headers = do
|
getDest headers = do
|
||||||
mport <- maybe (return Nothing) portLookup $ lookup "host" headers
|
mport <- maybe (return Nothing) portLookup $ lookup "host" headers
|
||||||
case mport of
|
case mport of
|
||||||
Nothing -> Left . srcToApp . toResponse <$> hostList
|
Nothing -> return $ Left $ srcToApp $ toResponse []
|
||||||
Just (PEPort port) -> return $ Right $ ProxyDest "127.0.0.1" port
|
Just (PEPort port) -> return $ Right $ ProxyDest "127.0.0.1" port
|
||||||
Just (PEStatic root) -> return $ Left $ waiToRaw $ staticApp $ defaultFileServerSettings root
|
Just (PEStatic root) -> return $ Left $ waiToRaw $ staticApp $ defaultFileServerSettings root
|
||||||
Just (PERedirect host) -> return $ Left $ waiToRaw $ redirectApp host
|
Just (PERedirect host) -> return $ Left $ waiToRaw $ redirectApp host
|
||||||
@ -70,9 +62,4 @@ srcToApp src appdata = src $$ appSink appdata
|
|||||||
|
|
||||||
toResponse :: Monad m => [ByteString] -> Source m ByteString
|
toResponse :: Monad m => [ByteString] -> Source m ByteString
|
||||||
toResponse hosts =
|
toResponse hosts =
|
||||||
mapM_ yield $ L.toChunks $ toLazyByteString $ front ++ mconcat (map go hosts) ++ end
|
yield "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\n\r\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>The hostname you have provided is not recognized.</p></body></html>"
|
||||||
where
|
|
||||||
front = fromByteString "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\n\r\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>You may access the following sites:</p><ul>"
|
|
||||||
end = fromByteString "</ul></body></html>"
|
|
||||||
go host = fromByteString "<li><a href=\"http://" ++ fromByteString host ++ fromByteString "/\">" ++
|
|
||||||
fromByteString host ++ fromByteString "</a></li>"
|
|
||||||
|
Loading…
Reference in New Issue
Block a user