Use lsof instead of ss

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

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