diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 94cab96432c..51462aac6c5 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -27,7 +27,6 @@ import Data.Maybe import Data.Monoid import Data.String import Data.String.Conversions (cs) -import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Traversable @@ -289,67 +288,40 @@ ensureFederatorPortIsFree resource = do check :: Word16 -> App () check federatorExternalPort = do env <- ask - let process = (proc "ss" ["-HOntpl", "sport", "=", show federatorExternalPort]) {std_out = CreatePipe, std_err = CreatePipe} + let process = (proc "lsof" ["-Q", "-Fpc", "-i", ":" <> show federatorExternalPort, "-s", "TCP:LISTEN"]) {std_out = CreatePipe, std_err = CreatePipe} (_, Just stdoutHdl, Just stderrHdl, ph) <- liftIO $ createProcess process - let prefix = "[" <> "ss" <> "@" <> resource.berDomain <> maybe "" (":" <>) env.currentTestName <> "] " + let prefix = "[" <> "lsof" <> "@" <> resource.berDomain <> maybe "" (":" <>) env.currentTestName <> "] " liftIO $ void $ forkIO $ logToConsole id prefix stderrHdl exitCode <- liftIO $ waitForProcess ph case exitCode of - ExitFailure _ -> assertFailure $ "ss failed to figure out if federator port is free" + ExitFailure _ -> assertFailure $ prefix <> "lsof failed to figure out if federator port is free" ExitSuccess -> do ssOutput <- liftIO $ hGetContents stdoutHdl - case parseSS (fromString ssOutput) of - Right (Just (processName, processId)) -> do - liftIO $ putStrLn $ "Found a process listening on port: " <> show federatorExternalPort <> ", killing the process: " <> show processName <> ", pid: " <> show processId + case parseLsof (fromString ssOutput) of + Right ((processId, processName) : _) -> do + liftIO $ putStrLn $ prefix <> "Found a process listening on port: " <> show federatorExternalPort <> ", killing the process: " <> show processName <> ", pid: " <> show processId liftIO $ signalProcess killProcess processId liftIO $ threadDelay 100_000 check federatorExternalPort - Right Nothing -> pure () + Right [] -> pure () Left e -> assertFailure $ prefix <> "Failed while parsing ss output with error: " <> e <> "\n" <> "ss output:\n" <> ssOutput -parseSS :: Text -> Either String (Maybe (String, ProcessID)) -parseSS input = - if Text.null input - then pure Nothing - else Just <$> Parser.parseOnly (ssParser <* Parser.endOfInput) input - --- Example input: --- LISTEN 0 4096 127.0.0.1:8082 0.0.0.0:* users:(("brig",pid=51468,fd=79)) -ssParser :: Parser.Parser (String, ProcessID) -ssParser = do - ignoreStrToken "LISTEN" - ignoreToken -- 0 - ignoreToken -- 4096 - ignoreToken -- 127... - ignoreToken -- 0.0.... - ignoreStrToken "users:((" - name <- quoted - _ <- Parser.char ',' - p <- pid - _ <- Parser.many1 noNewLine - pure (name, p) +-- | Example lsof output: +-- +-- @ +-- p61317 +-- cfederator +-- @ +parseLsof :: String -> Either String [(ProcessID, String)] +parseLsof output = + Parser.parseOnly ((Parser.sepBy lsofParser (Parser.char '\n')) <* Parser.endOfInput) (fromString output) where - spaces = void $ Parser.many' Parser.space - noSpace = Parser.satisfy (/= ' ') - noSpaces = Parser.many1 noSpace - token p = do - spaces - res <- p - spaces - pure res - ignoreToken = void $ token noSpaces - stringToken str = token (Parser.string $ fromString str) - ignoreStrToken = void . stringToken - quoted = do - token $ do - _ <- Parser.char '"' - tok <- noSpaces - _ <- Parser.char '"' - pure tok - pid = do - ignoreStrToken "pid=" - Parser.decimal - noNewLine = Parser.satisfy (/= '\n') + lsofParser :: Parser.Parser (ProcessID, String) + lsofParser = + (,) <$> processIdParser <* Parser.char '\n' <*> processNameParser + + processIdParser = Parser.char 'p' *> Parser.decimal + processNameParser = Parser.char 'c' *> Parser.many1 (Parser.satisfy (/= '\n')) ensureBackendReachable :: (HasCallStack) => String -> App () ensureBackendReachable domain = do diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 12c2982d0a4..a08077d779a 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -297,6 +297,7 @@ let pkgs.awscli2 pkgs.vacuum-go pkgs.iproute2 + pkgs.lsof integration-dynamic-backends-db-schemas integration-dynamic-backends-brig-index integration-dynamic-backends-ses @@ -547,6 +548,7 @@ in pkgs.cabal-install pkgs.nix-prefetch-git pkgs.haskellPackages.cabal-plan + pkgs.lsof profileEnv ] ++ ghcWithPackages