never executed always true always false
1 module PureClaw.Harness.Tmux
2 ( -- * tmux availability
3 requireTmux
4 , findTmux
5 -- * Session lifecycle
6 , startTmuxSession
7 , stopTmuxSession
8 -- * Window management
9 , addHarnessWindow
10 , stopHarnessWindow
11 , renameWindow
12 , listSessionWindows
13 -- * I/O
14 , sendToWindow
15 , captureWindow
16 , tmuxDisplay
17 -- * Stealth mode
18 , stealthShellCommand
19 ) where
20
21 import Data.ByteString (ByteString)
22 import Data.ByteString.Char8 qualified as BC
23 import Data.ByteString.Lazy qualified as LBS
24 import Data.Text (Text)
25 import Data.Text qualified as T
26 import Data.Text.Encoding qualified as TE
27 import System.Directory qualified as Dir
28 import System.Exit
29 import System.IO qualified as IO
30 import System.Info qualified as Info
31 import System.IO.Temp qualified as Temp
32 import System.Process.Typed qualified as P
33
34 import PureClaw.Handles.Harness
35
36 -- | Resolve the absolute path to the tmux binary.
37 -- First checks PATH via 'findExecutable', then tries common system locations.
38 findTmux :: IO (Maybe FilePath)
39 findTmux = do
40 mPath <- Dir.findExecutable "tmux"
41 case mPath of
42 Just p -> pure (Just p)
43 Nothing -> findFirstExisting fallbackPaths
44 where
45 fallbackPaths =
46 [ "/opt/homebrew/bin/tmux"
47 , "/usr/local/bin/tmux"
48 , "/usr/bin/tmux"
49 ]
50 findFirstExisting [] = pure Nothing
51 findFirstExisting (p : ps) = do
52 exists <- Dir.doesFileExist p
53 if exists then pure (Just p) else findFirstExisting ps
54
55 -- | Check if tmux is available on PATH.
56 requireTmux :: IO (Either HarnessError ())
57 requireTmux = do
58 mPath <- findTmux
59 pure $ case mPath of
60 Nothing -> Left (HarnessTmuxNotAvailable "tmux not found on PATH or fallback locations")
61 Just _ -> Right ()
62
63 -- | Run a tmux command, capturing stderr for diagnostics.
64 -- Returns the exit code and stderr output.
65 runTmux :: [String] -> IO (ExitCode, ByteString)
66 runTmux args = do
67 mPath <- findTmux
68 case mPath of
69 Nothing -> pure (ExitFailure 127, "tmux not found")
70 Just tmuxBin -> do
71 let config = P.setStdin P.closed
72 $ P.setStdout P.nullStream
73 $ P.setStderr P.byteStringOutput
74 $ P.proc tmuxBin args
75 (exitCode, _stdout, stderr) <- P.readProcess config
76 pure (exitCode, LBS.toStrict stderr)
77
78 -- | Run a tmux command silently. Returns just the exit code.
79 runTmuxSilent :: [String] -> IO ExitCode
80 runTmuxSilent args = fst <$> runTmux args
81
82 -- | Build a stealth shell command string for launching a binary in tmux.
83 -- Strips TMUX env vars and wraps with script(1) for a fresh PTY.
84 --
85 -- macOS: @script -q \/dev\/null command args...@
86 -- Linux: @script -qc \"command args...\" \/dev\/null@
87 stealthShellCommand :: FilePath -> [Text] -> String
88 stealthShellCommand binary args =
89 let argStr = unwords (map (T.unpack . shellEscape) args)
90 fullCmd = binary <> if null args then "" else " " <> argStr
91 scriptWrapped
92 | Info.os == "darwin" =
93 "script -q /dev/null " <> fullCmd
94 | otherwise =
95 "script -qc \"" <> escapeForShell fullCmd <> "\" /dev/null"
96 in "env -u TMUX -u TMUX_PANE TERM=xterm-256color " <> scriptWrapped
97
98 -- | Escape a string for embedding inside double quotes in a shell command.
99 escapeForShell :: String -> String
100 escapeForShell = concatMap go
101 where
102 go '"' = "\\\""
103 go '\\' = "\\\\"
104 go '$' = "\\$"
105 go '`' = "\\`"
106 go c = [c]
107
108 -- | Shell-escape a 'String' argument. Convenience wrapper around 'shellEscape'.
109 shellEscapeStr :: String -> String
110 shellEscapeStr = T.unpack . shellEscape . T.pack
111
112 -- | Simple shell escaping for individual arguments.
113 -- Wraps in single quotes and escapes embedded single quotes.
114 shellEscape :: Text -> Text
115 shellEscape t
116 | T.null t = "''"
117 | T.all isSafe t = t
118 | otherwise = "'" <> T.replace "'" "'\\''" t <> "'"
119 where
120 isSafe c = c `elem` (['a'..'z'] <> ['A'..'Z'] <> ['0'..'9'] <> "-_./=:@")
121
122 -- | Start a tmux session with the given name if not already running.
123 -- Creates a detached session with 300x100 dimensions.
124 startTmuxSession :: Text -> IO (Either HarnessError ())
125 startTmuxSession sessionName = do
126 tmuxCheck <- requireTmux
127 case tmuxCheck of
128 Left err -> pure (Left err)
129 Right () -> do
130 exists <- sessionExists sessionName
131 if exists
132 then pure (Right ())
133 else do
134 (exitCode, stderr) <- runTmux
135 [ "new-session", "-d"
136 , "-s", T.unpack sessionName
137 , "-x", "300"
138 , "-y", "100"
139 ]
140 case exitCode of
141 ExitSuccess -> pure (Right ())
142 ExitFailure c -> pure (Left (HarnessTmuxNotAvailable
143 ("tmux new-session failed (exit " <> T.pack (show c) <> "): "
144 <> TE.decodeUtf8Lenient stderr)))
145
146 -- | Check if a tmux session with the given name exists.
147 sessionExists :: Text -> IO Bool
148 sessionExists sessionName = do
149 exitCode <- runTmuxSilent ["has-session", "-t", T.unpack sessionName]
150 pure (exitCode == ExitSuccess)
151
152 -- | Add a window to a tmux session for a harness at a specific window index.
153 -- Window 0 reuses the session's default window; higher indices create new windows.
154 -- Uses stealth mode: env -u TMUX, script -c for fresh PTY.
155 -- An optional working directory can be specified; for window 0 this sends a @cd@
156 -- before the command, for higher indices it uses @tmux new-window -c@.
157 addHarnessWindow :: Text -> Int -> FilePath -> [Text] -> Maybe FilePath -> IO (Either HarnessError ())
158 addHarnessWindow sessionName windowIdx binary args mWorkDir = do
159 tmuxCheck <- requireTmux
160 case tmuxCheck of
161 Left err -> pure (Left err)
162 Right () -> do
163 let stealthCmd = stealthShellCommand binary args
164 session = T.unpack sessionName
165 target = session <> ":" <> show windowIdx
166 if windowIdx == 0
167 then do
168 -- Window 0 already exists from session creation — cd then send command
169 case mWorkDir of
170 Just dir -> do
171 _ <- runTmuxSilent ["send-keys", "-t", target, "cd " <> shellEscapeStr dir, "Enter"]
172 pure ()
173 Nothing -> pure ()
174 _ <- runTmuxSilent ["send-keys", "-t", target, stealthCmd, "Enter"]
175 pure (Right ())
176 else do
177 let baseArgs = [ "new-window", "-t", target ]
178 dirArgs = case mWorkDir of
179 Just dir -> ["-c", dir]
180 Nothing -> []
181 (exitCode, _stderr) <- runTmux (baseArgs <> dirArgs <> [stealthCmd])
182 case exitCode of
183 ExitSuccess -> pure (Right ())
184 ExitFailure _ -> pure (Right ())
185
186 -- | Send input to a harness window by index.
187 -- Small input (<= 256 bytes) uses send-keys.
188 -- Large input (> 256 bytes) uses load-buffer + paste-buffer.
189 sendToWindow :: Text -> Int -> ByteString -> IO ()
190 sendToWindow sessionName windowIdx input
191 | BC.length input <= 256 = sendKeysSmall sessionName windowIdx input
192 | otherwise = sendKeysLarge sessionName windowIdx input
193
194 -- | Send small input via tmux send-keys.
195 sendKeysSmall :: Text -> Int -> ByteString -> IO ()
196 sendKeysSmall sessionName windowIdx input = do
197 let target = T.unpack sessionName <> ":" <> show windowIdx
198 _ <- runTmuxSilent ["send-keys", "-t", target, BC.unpack input, "Enter"]
199 pure ()
200
201 -- | Send large input via tmux load-buffer + paste-buffer.
202 sendKeysLarge :: Text -> Int -> ByteString -> IO ()
203 sendKeysLarge sessionName windowIdx input = do
204 let target = T.unpack sessionName <> ":" <> show windowIdx
205 Temp.withSystemTempFile "pureclaw-tmux-input" $ \tmpPath tmpHandle -> do
206 BC.hPut tmpHandle input
207 IO.hClose tmpHandle
208 _ <- runTmuxSilent ["load-buffer", tmpPath]
209 _ <- runTmuxSilent ["paste-buffer", "-t", target]
210 _ <- runTmuxSilent ["send-keys", "-t", target, "Enter"]
211 pure ()
212
213 -- | Capture output from a harness window (scrollback, last N lines).
214 -- Strips ANSI escape sequences from the captured output.
215 captureWindow :: Text -> Int -> IO ByteString
216 captureWindow sessionName lineCount = do
217 mPath <- findTmux
218 case mPath of
219 Nothing -> pure ""
220 Just tmuxBin -> do
221 let target = T.unpack sessionName
222 config = P.setStdin P.closed
223 $ P.setStdout P.byteStringOutput
224 $ P.setStderr P.nullStream
225 $ P.proc tmuxBin
226 [ "capture-pane", "-t", target
227 , "-p"
228 , "-S", "-" <> show lineCount
229 ]
230 (exitCode, stdout, _stderr) <- P.readProcess config
231 case exitCode of
232 ExitSuccess -> pure (stripAnsi (LBS.toStrict stdout))
233 ExitFailure _ -> pure ""
234
235 -- | Strip ANSI escape sequences from a ByteString.
236 -- Matches ESC [ ... (letter or @) sequences.
237 stripAnsi :: ByteString -> ByteString
238 stripAnsi = go
239 where
240 go input
241 | BC.null input = BC.empty
242 | otherwise =
243 let (before, rest) = BC.break (== '\ESC') input
244 in if BC.null rest
245 then before
246 else before <> skipEsc (BC.drop 1 rest)
247 skipEsc input
248 | BC.null input = BC.empty
249 | BC.head input == '[' = skipCsi (BC.drop 1 input)
250 | otherwise = go (BC.drop 1 input)
251 skipCsi input
252 | BC.null input = BC.empty
253 | let c = BC.head input
254 , c >= '@' && c <= '~' = go (BC.drop 1 input)
255 | otherwise = skipCsi (BC.drop 1 input)
256
257 -- | Display text in a harness window (for tee-style mirroring).
258 -- Uses send-keys to echo the text.
259 tmuxDisplay :: Text -> ByteString -> IO ()
260 tmuxDisplay sessionName content = do
261 let target = T.unpack sessionName
262 _ <- runTmuxSilent ["send-keys", "-t", target, BC.unpack content, ""]
263 pure ()
264
265 -- | Kill the entire tmux session. Idempotent -- does not fail if session
266 -- does not exist.
267 stopTmuxSession :: Text -> IO ()
268 stopTmuxSession sessionName = do
269 _ <- runTmuxSilent ["kill-session", "-t", T.unpack sessionName]
270 pure ()
271
272 -- | Kill a specific harness window within a session by index.
273 stopHarnessWindow :: Text -> Int -> IO ()
274 stopHarnessWindow sessionName windowIdx = do
275 let target = T.unpack sessionName <> ":" <> show windowIdx
276 _ <- runTmuxSilent ["kill-window", "-t", target]
277 pure ()
278
279 -- | Rename a window within a session.
280 renameWindow :: Text -> Int -> Text -> IO ()
281 renameWindow sessionName windowIdx label = do
282 let target = T.unpack sessionName <> ":" <> show windowIdx
283 _ <- runTmuxSilent ["rename-window", "-t", target, T.unpack label]
284 pure ()
285
286 -- | List all windows in a tmux session, returning @(windowIndex, windowName)@ pairs.
287 -- Returns an empty list if the session does not exist or tmux is unavailable.
288 listSessionWindows :: Text -> IO [(Int, Text)]
289 listSessionWindows sessionName = do
290 mPath <- findTmux
291 case mPath of
292 Nothing -> pure []
293 Just tmuxBin -> do
294 let config = P.setStdin P.closed
295 $ P.setStdout P.byteStringOutput
296 $ P.setStderr P.nullStream
297 $ P.proc tmuxBin
298 [ "list-windows", "-t", T.unpack sessionName
299 , "-F", "#{window_index}\t#{window_name}"
300 ]
301 (exitCode, stdout, _stderr) <- P.readProcess config
302 case exitCode of
303 ExitFailure _ -> pure []
304 ExitSuccess -> pure (parseListing (LBS.toStrict stdout))
305 where
306 parseListing bs =
307 [ (idx, name)
308 | line <- BC.lines bs
309 , let txt = TE.decodeUtf8Lenient line
310 , (idxStr, rest) <- [T.break (== '\t') txt]
311 , not (T.null rest)
312 , let name = T.drop 1 rest -- drop the tab
313 , Just idx <- [readIndex idxStr]
314 ]
315
316 readIndex t = case reads (T.unpack t) of
317 [(n, "")] -> Just n
318 _ -> Nothing