Display an actual TCP port app is bound to (#3034)

CHANGELOG.md

@@ -33,6 +33,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
  - #3019, Transaction-Scoped Settings are now shown clearly in the Postgres logs - @laurenceisla
    + Shows `set_config('pgrst.setting_name', $1)` instead of `setconfig($1, $2)`
    + Does not apply to role settings and `app.settings.*`
+ - #2420, Fix bogus message when listening on port 0 - @develop7
 
 ### Changed
 

main/Main.hs

@@ -1,37 +1,16 @@
-{-# LANGUAGE CPP #-}
-
 module Main (main) where
 
 import System.IO (BufferMode (..), hSetBuffering)
 
-import qualified PostgREST.App as App
 import qualified PostgREST.CLI as CLI
 
 import Protolude
 
-#ifndef mingw32_HOST_OS
-import qualified PostgREST.Unix as Unix
-#endif
-
 main :: IO ()
 main = do
   setBuffering
   opts <- CLI.readCLIShowHelp
-  CLI.main installSignalHandlers runAppInSocket opts
+  CLI.main opts
-
-installSignalHandlers :: App.SignalHandlerInstaller
-#ifndef mingw32_HOST_OS
-installSignalHandlers = Unix.installSignalHandlers
-#else
-installSignalHandlers _ = pass
-#endif
-
-runAppInSocket :: Maybe App.SocketRunner
-#ifndef mingw32_HOST_OS
-runAppInSocket = Just Unix.runAppWithSocket
-#else
-runAppInSocket = Nothing
-#endif
 
 setBuffering :: IO ()
 setBuffering = do

postgrest.cabal

@@ -64,6 +64,7 @@ library
                       PostgREST.Plan.ReadPlan
                       PostgREST.Plan.Types
                       PostgREST.RangeQuery
+                      PostgREST.Unix
                       PostgREST.ApiRequest
                       PostgREST.ApiRequest.Preferences
                       PostgREST.ApiRequest.QueryParams
@@ -89,6 +90,7 @@ library
                     , containers                >= 0.5.7 && < 0.7
                     , contravariant-extras      >= 0.3.3 && < 0.4
                     , cookie                    >= 0.4.2 && < 0.5
+                    , directory                 >= 1.2.6 && < 1.4
                     , either                    >= 4.4.1 && < 5.1
                     , extra                     >= 1.7.0 && < 2.0
                     , fuzzyset                  >= 0.2.3
@@ -114,11 +116,13 @@ library
                     , regex-tdfa                >= 1.2.2 && < 1.4
                     , retry                     >= 0.7.4 && < 0.10
                     , scientific                >= 0.3.4 && < 0.4
+                    , streaming-commons         >= 0.1.1 && < 0.3
                     , swagger2                  >= 2.4 && < 2.9
                     , text                      >= 1.2.2 && < 1.3
                     , time                      >= 1.6 && < 1.12
                     , timeit                    >= 2.0 && < 2.1
                     , unordered-containers      >= 0.2.8 && < 0.3
+                    , unix-compat               >= 0.5.4 && < 0.6
                     , vault                     >= 0.3.1.5 && < 0.4
                     , vector                    >= 0.11 && < 0.14
                     , wai                       >= 3.2.1 && < 3.3
@@ -148,9 +152,6 @@ library
   if !os(windows)
     build-depends:
       unix
-      , directory >= 1.2.6 && < 1.4
-    exposed-modules:
-      PostgREST.Unix
 
 executable postgrest
   default-language:   Haskell2010

src/PostgREST/Admin.hs

@@ -1,11 +1,9 @@
-{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module PostgREST.Admin
   ( runAdmin
   ) where
 
-import qualified Data.Text                 as T
 import qualified Hasql.Session             as SQL
 import qualified Network.HTTP.Types.Status as HTTP
 import qualified Network.Wai               as Wai
@@ -22,19 +20,20 @@ import PostgREST.Config   (AppConfig (..))
 import qualified PostgREST.AppState as AppState
 
 import Protolude
+import Protolude.Partial (fromJust)
 
 runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO ()
 runAdmin conf@AppConfig{configAdminServerPort} appState settings =
-  whenJust configAdminServerPort $ \adminPort -> do
+  whenJust (AppState.getSocketAdmin appState) $ \adminSocket -> do
-    AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
+    AppState.logWithZTime appState $ "Admin server listening on port " <> show (fromIntegral (fromJust configAdminServerPort) :: Integer)
-    void . forkIO $ Warp.runSettings (settings & Warp.setPort adminPort) adminApp
+    void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp
   where
     adminApp = admin appState conf
 
 -- | PostgREST admin application
 admin :: AppState.AppState -> AppConfig -> Wai.Application
 admin appState appConfig req respond  = do
-  isMainAppReachable  <- any isRight <$> reachMainApp appConfig
+  isMainAppReachable  <- isRight <$> reachMainApp (AppState.getSocketREST appState)
   isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
   isConnectionUp      <-
     if configDbChannelEnabled appConfig
@@ -51,37 +50,16 @@ admin appState appConfig req respond  = do
 
 -- Try to connect to the main app socket
 -- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
--- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
+reachMainApp :: Socket -> IO (Either IOException ())
--- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
+reachMainApp appSock = do
-reachMainApp :: AppConfig -> IO [Either IOException ()]
+  sockAddr <- getSocketName appSock
-reachMainApp AppConfig{..} =
+  sock <- socket (addrFamily sockAddr) Stream defaultProtocol
-  case configServerUnixSocket of
+  try $ do
-    Just path ->  do
+    connect sock sockAddr
-      sock <- socket AF_UNIX Stream 0
+    withSocketsDo $ bracket (pure sock) close sendEmpty
-      (:[]) <$> try (do
-        connect sock $ SockAddrUnix path
-        withSocketsDo $ bracket (pure sock) close sendEmpty)
-    Nothing -> do
-      let
-        host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
-             | otherwise                                             = Just configServerHost
-        filterAddrs xs =
-          case configServerHost of
-              "*4" -> ipv4Addrs xs ++ ipv6Addrs xs
-              "!4" -> ipv4Addrs xs
-              "*6" -> ipv6Addrs xs ++ ipv4Addrs xs
-              "!6" -> ipv6Addrs xs
-              _    -> xs
-        ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
-        ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
-
-      addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
-      tryAddr `traverse` filterAddrs addrs
   where
     sendEmpty sock = void $ send sock mempty
-    tryAddr :: AddrInfo -> IO (Either IOException ())
+    addrFamily (SockAddrInet _ _) = AF_INET
-    tryAddr addr = do
+    addrFamily (SockAddrInet6 {}) = AF_INET6
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+    addrFamily (SockAddrUnix _)   = AF_UNIX
-      try $ do
+
-        connect sock $ addrAddress addr
-        withSocketsDo $ bracket (pure sock) close sendEmpty

src/PostgREST/App.hs

@@ -12,9 +12,7 @@ Some of its functionality includes:
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.App
-  ( SignalHandlerInstaller
+  ( postgrest
-  , SocketRunner
-  , postgrest
   , run
   ) where
 
@@ -25,7 +23,6 @@ import Data.Maybe               (fromJust)
 import Data.String              (IsString (..))
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
-import System.Posix.Types       (FileMode)
 
 import qualified Data.HashMap.Strict        as HM
 import qualified Data.Text.Encoding         as T
@@ -44,6 +41,7 @@ import qualified PostgREST.Logger           as Logger
 import qualified PostgREST.Plan             as Plan
 import qualified PostgREST.Query            as Query
 import qualified PostgREST.Response         as Response
+import qualified PostgREST.Unix             as Unix (installSignalHandlers)
 
 import PostgREST.ApiRequest           (Action (..), ApiRequest (..),
                                        Mutation (..), Target (..))
@@ -64,20 +62,17 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Data.List             as L
 import qualified Data.Map              as Map (fromList)
 import qualified Network.HTTP.Types    as HTTP
+import qualified Network.Socket        as NS
 import           Protolude             hiding (Handler)
 import           System.TimeIt         (timeItT)
 
 type Handler = ExceptT Error
 
-type SignalHandlerInstaller = AppState -> IO()
+run :: AppState -> IO ()
-
+run appState = do
-type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath -> IO()
-
-run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
-run installHandlers maybeRunWithSocket appState = do
   conf@AppConfig{..} <- AppState.getConfig appState
   AppState.connectionWorker appState -- Loads the initial SchemaCache
-  installHandlers appState
+  Unix.installSignalHandlers (AppState.getMainThreadId appState) (AppState.connectionWorker appState) (AppState.reReadConfig False appState)
   -- reload schema cache + config on NOTIFY
   AppState.runListener conf appState
 
@@ -85,19 +80,14 @@ run installHandlers maybeRunWithSocket appState = do
 
   let app = postgrest conf appState (AppState.connectionWorker appState)
 
-  case configServerUnixSocket of
+  what <- case configServerUnixSocket of
-    Just socket ->
+    Just path -> pure $ "unix socket " <> show path
-      -- run the postgrest application with user defined socket. Only for UNIX systems
+    Nothing   -> do
-      case maybeRunWithSocket of
+      port <- NS.socketPort $ AppState.getSocketREST appState
-        Just runWithSocket -> do
+      pure $ "port " <> show port
-          AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
+  AppState.logWithZTime appState $ "Listening on " <> what
-          runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
+
-        Nothing ->
+  Warp.runSettingsSocket (serverSettings conf) (AppState.getSocketREST appState) app
-          panic "Cannot run with unix socket on non-unix platforms."
-    Nothing ->
-      do
-        AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
-        Warp.runSettings (serverSettings conf) app
 
 serverSettings :: AppConfig -> Warp.Settings
 serverSettings AppConfig{..} =

src/PostgREST/AppState.hs

@@ -14,7 +14,10 @@ module PostgREST.AppState
   , getRetryNextIn
   , getTime
   , getJwtCache
+  , getSocketREST
+  , getSocketAdmin
   , init
+  , initSockets
   , initWithPool
   , logWithZTime
   , putSchemaCache
@@ -32,12 +35,14 @@ import qualified Data.ByteString.Char8      as BS
 import qualified Data.ByteString.Lazy       as LBS
 import qualified Data.Cache                 as C
 import           Data.Either.Combinators    (whenLeft)
+import qualified Data.Text                  as T (unpack)
 import qualified Data.Text.Encoding         as T
 import           Hasql.Connection           (acquire)
 import qualified Hasql.Notifications        as SQL
 import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Session              as SQL
 import qualified Hasql.Transaction.Sessions as SQL
+import qualified Network.Socket             as NS
 import qualified PostgREST.Error            as Error
 import           PostgREST.Version          (prettyVersion)
 
@@ -63,10 +68,12 @@ import PostgREST.Config.PgVersion        (PgVersion (..),
 import PostgREST.SchemaCache             (SchemaCache,
                                           querySchemaCache)
 import PostgREST.SchemaCache.Identifiers (dumpQi)
+import PostgREST.Unix                    (createAndBindDomainSocket)
 
+import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP)
+import Data.String            (IsString (..))
 import Protolude
 
-
 data AuthResult = AuthResult
   { authClaims :: KM.KeyMap JSON.Value
   , authRole   :: BS.ByteString
@@ -99,15 +106,23 @@ data AppState = AppState
   , debounceLogAcquisitionTimeout :: IO ()
   -- | JWT Cache
   , jwtCache                      :: C.Cache ByteString AuthResult
+  -- | Network socket for REST API
+  , stateSocketREST               :: NS.Socket
+  -- | Network socket for the admin UI
+  , stateSocketAdmin              :: Maybe NS.Socket
   }
 
+type AppSockets = (NS.Socket, Maybe NS.Socket)
+
 init :: AppConfig -> IO AppState
 init conf = do
   pool <- initPool conf
-  initWithPool pool conf
+  (sock, adminSock) <- initSockets conf
+  state' <- initWithPool (sock, adminSock) pool conf
+  pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock }
 
-initWithPool :: SQL.Pool -> AppConfig -> IO AppState
+initWithPool :: AppSockets -> SQL.Pool -> AppConfig -> IO AppState
-initWithPool pool conf = do
+initWithPool (sock, adminSock) pool conf = do
   appState <- AppState pool
     <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
     <*> newIORef Nothing
@@ -121,6 +136,8 @@ initWithPool pool conf = do
     <*> newIORef 0
     <*> pure (pure ())
     <*> C.newCache Nothing
+    <*> pure sock
+    <*> pure adminSock
 
 
   debLogTimeout <-
@@ -144,6 +161,39 @@ initWithPool pool conf = do
 destroy :: AppState -> IO ()
 destroy = destroyPool
 
+initSockets :: AppConfig -> IO AppSockets
+initSockets AppConfig{..} = do
+  let
+    cfg'usp = configServerUnixSocket
+    cfg'uspm = configServerUnixSocketMode
+    cfg'host = configServerHost
+    cfg'port = configServerPort
+    cfg'adminport = configAdminServerPort
+
+  sock <- case cfg'usp of
+    -- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
+    -- but we need to have runtime error if we try to use it in Windows, not compile time error
+    Just path -> createAndBindDomainSocket path cfg'uspm
+    Nothing -> do
+      (_, sock) <-
+        if cfg'port /= 0
+          then do
+            sock <- bindPortTCP cfg'port (fromString $ T.unpack cfg'host)
+            pure (cfg'port, sock)
+          else do
+            -- explicitly bind to a random port, returning bound port number
+            (num, sock) <- bindRandomPortTCP (fromString $ T.unpack cfg'host)
+            pure (num, sock)
+      pure sock
+
+  adminSock <- case cfg'adminport of
+    Just adminPort -> do
+      adminSock <- bindPortTCP adminPort (fromString $ T.unpack cfg'host)
+      pure $ Just adminSock
+    Nothing -> pure Nothing
+
+  pure (sock, adminSock)
+
 initPool :: AppConfig -> IO SQL.Pool
 initPool AppConfig{..} =
   SQL.acquire
@@ -204,6 +254,12 @@ getTime = stateGetTime
 getJwtCache :: AppState -> C.Cache ByteString AuthResult
 getJwtCache = jwtCache
 
+getSocketREST :: AppState -> NS.Socket
+getSocketREST = stateSocketREST
+
+getSocketAdmin :: AppState -> Maybe NS.Socket
+getSocketAdmin = stateSocketAdmin
+
 -- | Log to stderr with local time
 logWithZTime :: AppState -> Text -> IO ()
 logWithZTime appState txt = do

src/PostgREST/CLI.hs

@@ -29,8 +29,8 @@ import qualified PostgREST.Config   as Config
 import Protolude hiding (hPutStrLn)
 
 
-main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
+main :: CLI -> IO ()
-main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
+main CLI{cliCommand, cliPath} = do
   conf@AppConfig{..} <-
     either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty
 
@@ -45,7 +45,7 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
         when configDbConfig $ AppState.reReadConfig True appState
         putStr . Config.toText =<< AppState.getConfig appState
       CmdDumpSchema -> putStrLn =<< dumpSchema appState
-      CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
+      CmdRun -> App.run appState)
 
 -- | Dump SchemaCache schema to JSON
 dumpSchema :: AppState -> IO LBS.ByteString

src/PostgREST/Unix.hs

@@ -1,57 +1,53 @@
+{-# LANGUAGE CPP #-}
+
 module PostgREST.Unix
-  ( runAppWithSocket
+  ( installSignalHandlers
-  , installSignalHandlers
+  , createAndBindDomainSocket
   ) where
 
-import qualified Network.Socket           as Socket
+#ifndef mingw32_HOST_OS
-import qualified Network.Wai.Handler.Warp as Warp
+import qualified System.Posix.Signals as Signals
-import qualified System.Posix.Signals     as Signals
+#endif
+import System.Posix.Types       (FileMode)
+import System.PosixCompat.Files (setFileMode)
 
-import Network.Wai        (Application)
+import           Data.String      (String)
-import System.Directory   (removeFile)
+import qualified Network.Socket   as NS
-import System.IO.Error    (isDoesNotExistError)
+import           Protolude
-import System.Posix.Files (setFileMode)
+import           System.Directory (removeFile)
-import System.Posix.Types (FileMode)
+import           System.IO.Error  (isDoesNotExistError)
-
-import qualified PostgREST.AppState as AppState
-
-import Protolude
-
-
--- | Run the PostgREST application with user defined socket.
-runAppWithSocket :: Warp.Settings -> Application -> FileMode -> FilePath -> IO ()
-runAppWithSocket settings app socketFileMode socketFilePath =
-  bracket createAndBindSocket Socket.close $ \socket -> do
-    Socket.listen socket Socket.maxListenQueue
-    Warp.runSettingsSocket settings socket app
-  where
-    createAndBindSocket = do
-      deleteSocketFileIfExist socketFilePath
-      sock <- Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol
-      Socket.bind sock $ Socket.SockAddrUnix socketFilePath
-      setFileMode socketFilePath socketFileMode
-      return sock
-
-    deleteSocketFileIfExist path =
-      removeFile path `catch` handleDoesNotExist
-
-    handleDoesNotExist e
-      | isDoesNotExistError e = return ()
-      | otherwise = throwIO e
 
 -- | Set signal handlers, only for systems with signals
-installSignalHandlers :: AppState.AppState -> IO ()
+installSignalHandlers :: ThreadId -> IO () -> IO () -> IO ()
-installSignalHandlers appState = do
+#ifndef mingw32_HOST_OS
-  let interrupt = throwTo (AppState.getMainThreadId appState) UserInterrupt
+installSignalHandlers tid usr1 usr2 = do
+  let interrupt = throwTo tid UserInterrupt
   install Signals.sigINT interrupt
   install Signals.sigTERM interrupt
-
+  install Signals.sigUSR1 usr1
-  -- The SIGUSR1 signal updates the internal 'SchemaCache' by running
+  install Signals.sigUSR2 usr2
-  -- 'connectionWorker' exactly as before.
-  install Signals.sigUSR1 $ AppState.connectionWorker appState
-
-  -- Re-read the config on SIGUSR2
-  install Signals.sigUSR2 $ AppState.reReadConfig False appState
   where
     install signal handler =
       void $ Signals.installHandler signal (Signals.Catch handler) Nothing
+#else
+installSignalHandlers _ _ _ = pass
+#endif
+
+-- | Create a unix domain socket and bind it to the given path.
+-- | The socket file will be deleted if it already exists.
+createAndBindDomainSocket :: String -> FileMode -> IO NS.Socket
+createAndBindDomainSocket path mode = do
+  unless NS.isUnixDomainSocketAvailable $
+    panic "Cannot run with unix socket on non-unix platforms. Consider deleting the `server-unix-socket` config entry in order to continue."
+  deleteSocketFileIfExist path
+  sock <- NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol
+  NS.bind sock $ NS.SockAddrUnix path
+  NS.listen sock (max 2048 NS.maxListenQueue)
+  setFileMode path mode
+  return sock
+  where
+    deleteSocketFileIfExist path' =
+      removeFile path' `catch` handleDoesNotExist
+    handleDoesNotExist e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e

test/io/test_io.py

@@ -197,6 +197,13 @@ def test_flush_pool_no_interrupt(defaultenv):
         t.join()
 
 
+def test_random_port_bound(defaultenv):
+    "PostgREST should bind to a random port when PGRST_SERVER_PORT is 0."
+
+    with run(env=defaultenv, port="0") as postgrest:
+        assert True  # liveness check is done by run(), so we just need to check that it doesn't fail
+
+
 def test_app_settings_reload(tmp_path, defaultenv):
     "App settings should be reloaded from file when PostgREST is sent SIGUSR2."
     config = (CONFIGSDIR / "sigusr2-settings.config").read_text()

test/spec/Main.hs

@@ -74,11 +74,12 @@ main = do
 
   -- cached schema cache so most tests run fast
   baseSchemaCache <- loadSchemaCache pool testCfg
+  sockets <- AppState.initSockets testCfg
 
   let
     -- For tests that run with the same refSchemaCache
     app config = do
-      appState <- AppState.initWithPool pool config
+      appState <- AppState.initWithPool sockets pool config
       AppState.putPgVersion appState actualPgVersion
       AppState.putSchemaCache appState (Just baseSchemaCache)
       return ((), postgrest config appState $ pure ())
@@ -86,7 +87,7 @@ main = do
     -- For tests that run with a different SchemaCache(depends on configSchemas)
     appDbs config = do
       customSchemaCache <- loadSchemaCache pool config
-      appState <- AppState.initWithPool pool config
+      appState <- AppState.initWithPool sockets pool config
       AppState.putPgVersion appState actualPgVersion
       AppState.putSchemaCache appState (Just customSchemaCache)
       return ((), postgrest config appState $ pure ())