haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Option to disable reverse proxy

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
yesod-bin/Devel.hs
View File

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

5
yesod-bin/main.hs
View File

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