Merge pull request #234 from chrisdotcode/master

Add flag to bind on selected host, instead of default "0.0.0.0"

.gitignore

@@ -8,6 +8,8 @@
 TAGS
 dist
 tags
+cabal.sandbox.config
+.cabal-sandbox/
 
 # Ignore test builds.
 tests/Main

src/Hakyll/Commands.hs

@@ -15,9 +15,7 @@ module Hakyll.Commands
 
 --------------------------------------------------------------------------------
 import           System.Exit                (exitWith, ExitCode)
-import           System.IO.Error            (catchIOError)
 import           Control.Applicative
-import           Control.Monad              (void)
 import           Control.Concurrent
 
 --------------------------------------------------------------------------------
@@ -69,7 +67,7 @@ preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
 #ifdef PREVIEW_SERVER
 preview conf verbosity rules port  = do
     deprecatedMessage
-    watch conf verbosity port True rules
+    watch conf verbosity "0.0.0.0" port True rules
   where
     deprecatedMessage = mapM_ putStrLn [ "The preview command has been deprecated."
                                        , "Use the watch command for recompilation and serving."
@@ -82,9 +80,9 @@ preview _ _ _ _ = previewServerDisabled
 --------------------------------------------------------------------------------
 -- | Watch and recompile for changes
 
-watch :: Configuration -> Verbosity -> Int -> Bool -> Rules a -> IO ()
+watch :: Configuration -> Verbosity -> String -> Int -> Bool -> Rules a -> IO ()
 #ifdef WATCH_SERVER
-watch conf verbosity port runServer rules = do
+watch conf verbosity host port runServer rules = do
 #ifndef mingw32_HOST_OS
     _ <- forkIO $ watchUpdates conf update
 #else
@@ -100,9 +98,9 @@ watch conf verbosity port runServer rules = do
         (_, ruleSet) <- run conf verbosity rules
         return $ rulesPattern ruleSet
     loop = threadDelay 100000 >> loop
-    server' = if runServer then server conf port else loop
+    server' = if runServer then server conf host port else loop
 #else
-watch _ _ _ _ _ = watchServerDisabled
+watch _ _ _ _ = watchServerDisabled
 #endif
 
 --------------------------------------------------------------------------------
@@ -113,15 +111,15 @@ rebuild conf verbosity rules =
 
 --------------------------------------------------------------------------------
 -- | Start a server
-server :: Configuration -> Int -> IO ()
+server :: Configuration -> String -> Int -> IO ()
 #ifdef PREVIEW_SERVER
-server conf port = do
+server conf host port = do
     let destination = destinationDirectory conf
-    staticServer destination preServeHook port
+    staticServer destination preServeHook host port
   where
     preServeHook _ = return ()
 #else
-server _ _ = previewServerDisabled
+server _ _ _ = previewServerDisabled
 #endif
 
 

src/Hakyll/Core/Configuration.hs

@@ -69,6 +69,11 @@ data Configuration = Configuration
     , -- | Use an in-memory cache for items. This is faster but uses more
       -- memory.
       inMemoryCache        :: Bool
+    , -- | Override default host for preview server. Default is "127.0.0.1",
+      -- which binds only on the loopback address.
+      -- One can also override the host as a command line argument:
+      -- ./site preview -h "0.0.0.0"
+      previewHost          :: String
     , -- | Override default port for preview server. Default is 8000.
       -- One can also override the port as a command line argument:
       -- ./site preview -p 1234
@@ -91,6 +96,7 @@ defaultConfiguration = Configuration
     , deployCommand        = "echo 'No deploy command specified' && exit 1"
     , deploySite           = system . deployCommand
     , inMemoryCache        = True
+    , previewHost          = "127.0.0.1"
     , previewPort          = 8000
     }
   where

src/Hakyll/Main.hs

@@ -48,8 +48,8 @@ hakyllWith conf rules = do
         Help    _     -> showHelp
         Preview _ p   -> Commands.preview conf verbosity' rules p
         Rebuild _     -> Commands.rebuild conf verbosity' rules >>= exitWith
-        Server  _ _   -> Commands.server conf (port args')
-        Watch   _ p s -> Commands.watch conf verbosity' p (not s) rules
+        Server  _ _ _   -> Commands.server conf (host args') (port args')
+        Watch   _ _ p s -> Commands.watch conf verbosity' (host args') p (not s) rules
 
 
 --------------------------------------------------------------------------------
@@ -67,8 +67,8 @@ data HakyllArgs
     | Help    {verbose :: Bool}
     | Preview {verbose :: Bool, port :: Int}
     | Rebuild {verbose :: Bool}
-    | Server  {verbose :: Bool, port :: Int}
-    | Watch   {verbose :: Bool, port :: Int, no_server :: Bool }
+    | Server  {verbose :: Bool, host :: String, port :: Int}
+    | Watch   {verbose :: Bool, host :: String, port :: Int, no_server :: Bool }
     deriving (Data, Typeable, Show)
 
 
@@ -84,13 +84,14 @@ hakyllArgs conf = modes
     , (Preview (verboseFlag def) (portFlag defaultPort)) &=
         help "[Deprecated] Please use the watch command"
     , (Rebuild $ verboseFlag def) &= help "Clean and build again"
-    , (Server (verboseFlag def) (portFlag defaultPort)) &=
+    , (Server (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort)) &=
         help "Start a preview server"
-    , (Watch (verboseFlag def) (portFlag defaultPort) (noServerFlag False) &=
+    , (Watch (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort) (noServerFlag False) &=
        help "Autocompile on changes and start a preview server.  You can watch and recompile without running a server with --no-server.")
     ] &= help "Hakyll static site compiler" &= program progName
-    where defaultPort = Config.previewPort conf
-
+    where
+        defaultHost = Config.previewHost conf
+        defaultPort = Config.previewPort conf
 
 --------------------------------------------------------------------------------
 verboseFlag :: Data a => a -> a
@@ -103,6 +104,11 @@ noServerFlag :: Data a => a -> a
 noServerFlag x = x &= help "Disable the built-in web server"
 {-# INLINE noServerFlag #-}
 
+--------------------------------------------------------------------------------
+hostFlag :: Data a => a -> a
+hostFlag x = x &= help "Host to bind on"
+{-# INLINE hostFlag #-}
+
 --------------------------------------------------------------------------------
 portFlag :: Data a => a -> a
 portFlag x = x &= help "Port to listen on"

src/Hakyll/Preview/Server.hs

@@ -8,6 +8,7 @@ module Hakyll.Preview.Server
 
 --------------------------------------------------------------------------------
 import           Control.Monad.Trans (liftIO)
+import qualified Data.ByteString.Char8 as B
 import qualified Snap.Core           as Snap
 import qualified Snap.Http.Server    as Snap
 import qualified Snap.Util.FileServe as Snap
@@ -31,13 +32,15 @@ static directory preServe =
 -- | Main method, runs a static server in the given directory
 staticServer :: FilePath             -- ^ Directory to serve
              -> (FilePath -> IO ())  -- ^ Pre-serve hook
+             -> String               -- ^ Host to bind on
              -> Int                  -- ^ Port to listen on
              -> IO ()                -- ^ Blocks forever
-staticServer directory preServe port =
+staticServer directory preServe host port =
     Snap.httpServe config $ static directory preServe
   where
     -- Snap server config
-    config = Snap.setPort      port
+    config = Snap.setBind  (B.pack host)
+           $ Snap.setPort      port
            $ Snap.setAccessLog Snap.ConfigNoLog
            $ Snap.setErrorLog  Snap.ConfigNoLog
            $ Snap.emptyConfig