Option to disable reverse proxy

This commit is contained in:
Michael Snoyman 2013-06-10 11:16:52 +03:00
parent d377b48510
commit f9be0a83bd
2 changed files with 17 additions and 9 deletions

View File

@ -102,13 +102,14 @@ data DevelOpts = DevelOpts
, buildDir :: Maybe String
, develPort :: Int
, proxyTimeout :: Int
, useReverseProxy :: Bool
} deriving (Show, Eq)
getBuildDir :: DevelOpts -> String
getBuildDir opts = fromMaybe "dist" (buildDir opts)
defaultDevelOpts :: DevelOpts
defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10
defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True
cabalProgram :: DevelOpts -> FilePath
cabalProgram opts | isCabalDev opts = "cabal-dev"
@ -159,17 +160,21 @@ checkPort p = do
sClose s
return True
getPort :: Int -> IO Int
getPort p = do
avail <- checkPort p
if avail then return p else getPort (succ p)
getPort :: DevelOpts -> Int -> IO Int
getPort opts _ | not (useReverseProxy opts) = return $ develPort opts
getPort _ p0 =
loop p0
where
loop p = do
avail <- checkPort p
if avail then return p else loop (succ p)
devel :: DevelOpts -> [String] -> IO ()
devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
avail <- checkPort $ develPort opts
unless avail $ error "devel port unavailable"
iappPort <- getPort 17834 >>= I.newIORef
_ <- forkIO $ reverseProxy opts iappPort
iappPort <- getPort opts 17834 >>= I.newIORef
when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort
checkDevelFile
writeLock opts
@ -233,7 +238,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
env0 <- liftIO getEnvironment
-- get a new port for the new process to listen on
appPort <- liftIO $ I.readIORef iappPort >>= getPort . (+ 1)
appPort <- liftIO $ I.readIORef iappPort >>= getPort opts . (+ 1)
liftIO $ I.writeIORef iappPort appPort
(_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs)

View File

@ -55,6 +55,7 @@ data Command = Init
, develExtraArgs :: [String]
, _develPort :: Int
, _proxyTimeout :: Int
, _noReverseProxy :: Bool
}
| Test
| AddHandler
@ -92,7 +93,7 @@ main = do
Configure -> cabal ["configure"]
Build es -> touch' >> cabal ("build":es)
Touch -> touch'
Devel da s f r b _ig es p t -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t) es
Devel da s f r b _ig es p t nrp -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t (not nrp)) es
Keter noRebuild -> keter (cabalCommand o) noRebuild
Version -> do putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
AddHandler -> addHandler
@ -150,6 +151,8 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
<> help "Devel server listening port" )
<*> option ( long "proxy-timeout" <> short 'x' <> value 0 <> metavar "N"
<> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" )
<*> switch ( long "disable-reverse-proxy" <> short 'n'
<> help "Disable reverse proxy" )
extraCabalArgs :: Parser [String]
extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"