feat(session): add the 'process (pipes) session kind

Message

session-open now accepts kind: 'process alongside 'pty. A process session drives a child over stdin/stdout PIPES (via (sigil process)'s new process-spawn-pipe + process-pipe-* natives) instead of a pty — for a control-protocol child like tmux -C that hard-fails on a tty.

The reader-pump/writer-drain/reap are parameterized over five kind-dispatch helpers (session-read-fd/write-fd/read/raw-write/close-io!); everything above them (credit window, data/exit events, teardown ordering) is kind-agnostic. Differences for 'process: exec gates it WITHOUT a pty grant (a pipe session allocates no pty, matching Resource-plane spawning); session-resize is a no-op (no window); a pipe child is not a session leader so signals target the pid, not the process group.

Adds a process-session test group: stream+reap on exec-only grant, denial without exec, bidirectional cat round-trip, resize no-op, and session-close teardown of a long-running child.

Changed

 src/sigil/system/session.sgl | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------------
 test/test-system.sgl         |  83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 177 insertions(+), 30 deletions(-)

Diff

src/sigil/system/session.sglmodified

@@ -116,7 +116,8 @@

116

;;; The session's id (a monotonically increasing integer).

117

(define (session-id s) (: any? -> integer?) (vector-ref s 1))

118

−119

;;; The session's kind (currently always `pty`).

+119

;;; The session's kind: `'pty` (a pseudo-terminal) or `'process` (a

+120

;;; pipe-based session).

121

(define (session-kind s) (: any? -> symbol?) (vector-ref s 2))

122

123

(define (session-proc s) (vector-ref s 3))

@@ -151,27 +152,33 @@

152

;;;

153

;;; `spec` is a dict:

154

;;;

−154

;;; - `kind:` — `'pty` (a pseudo-terminal session; the only kind in

−155

;;; this release. A pipe-based `'process` kind follows.)

+155

;;; - `kind:` — `'pty` (a pseudo-terminal session) or `'process` (a

+156

;;; pipe-based session: stdin/stdout wired to non-blocking pipes, no

+157

;;; tty). Use `'process` for a child that speaks a line/byte protocol

+158

;;; and hard-fails on a pty, e.g. `tmux -C`.

159

;;; - `argv:` — non-empty command list, e.g. `'("bash" "-l")`

160

;;; - `cwd:` — child working directory (optional)

−158

;;; - `cols:` / `rows:` — initial terminal size (default 80x24)

−159

;;; - `term:` — TERM value (default "xterm-256color")

+161

;;; - `cols:` / `rows:` — initial terminal size (default 80x24;

+162

;;; ignored by the `'process` kind, which has no window)

+163

;;; - `term:` — TERM value (default "xterm-256color"; `'pty` only)

164

;;; - `credit:` — initial flow-control window in bytes

165

;;;

−162

;;; Grant checks: `pty` must be granted, and `exec` must allow

−163

;;; `(car argv)`. Must be called inside `with-async`.

+166

;;; Grant checks: `exec` must allow `(car argv)`; the `'pty` kind also

+167

;;; requires the `pty` grant (a pipe session allocates no pty, so it

+168

;;; needs only `exec`, matching Resource-plane process spawning). Must

+169

;;; be called inside `with-async`.

170

(define (session-open g spec)

171

(: any? dict? -> any?)

172

(unless (in-async-context?)

173

(error "session-open: requires an async context (with-async)"))

174

(let ((kind (dict-ref spec kind:))

175

(argv (dict-ref spec argv:)))

−170

(unless (eq? kind 'pty)

+176

(unless (or (eq? kind 'pty) (eq? kind 'process))

177

(error "session-open: unsupported session kind" kind))

178

(unless (and (pair? argv) (string? (car argv)))

179

(error "session-open: argv must be a non-empty list of strings" argv))

−174

(grant-assert! g 'pty #t)

+180

(when (eq? kind 'pty)

+181

(grant-assert! g 'pty #t))

182

(grant-assert! g 'exec (car argv))

183

(when (dict-contains? spec cwd:)

184

(grant-assert! g 'fs-read (dict-ref spec cwd:)))

@@ -184,11 +191,17 @@

191

(credit (if (dict-contains? spec credit:)

192

(dict-ref spec credit:)

193

*default-credit-window*))

−187

(proc (apply process-spawn-pty

−188

(car argv)

−189

cols: cols rows: rows cwd: cwd term: term

−190

die-with-parent: #t

−191

(cdr argv))))

+194

(proc (if (eq? kind 'process)

+195

(apply process-spawn-pipe

+196

(car argv)

+197

cwd: cwd

+198

die-with-parent: #t

+199

(cdr argv))

+200

(apply process-spawn-pty

+201

(car argv)

+202

cols: cols rows: rows cwd: cwd term: term

+203

die-with-parent: #t

+204

(cdr argv)))))

205

(unless (process? proc)

206

(error "session-open: failed to spawn" argv))

207

(set! *next-session-id* (+ *next-session-id* 1))

@@ -201,16 +214,63 @@

214

(go (writer-drain s))

215

s))))

216

+217

;; ============================================================

+218

;; Kind-dispatched I/O

+219

;; ============================================================

+220

+221

;; The pty and process kinds bottom out in different primitives: a pty

+222

;; multiplexes read AND write on one non-blocking master fd, while a

+223

;; process (pipes) session has SEPARATE non-blocking stdout (read) and

+224

;; stdin (write) fds. Everything above these five helpers is kind-

+225

;; agnostic.

+226

+227

(define (session-process? s) (eq? (session-kind s) 'process))

+228

+229

;; The fd to await for READABILITY before reading child output.

+230

(define (session-read-fd s)

+231

(if (session-process? s)

+232

(process-stdout-fd (session-proc s))

+233

(process-pty-fd (session-proc s))))

+234

+235

;; The fd to await for WRITABILITY before writing child input.

+236

(define (session-write-fd s)

+237

(if (session-process? s)

+238

(process-stdin-fd (session-proc s))

+239

(process-pty-fd (session-proc s))))

+240

+241

;; Non-blocking read of up to n bytes of child output (empty bv on

+242

;; EAGAIN, eof-object at end of stream).

+243

(define (session-read s n)

+244

(if (session-process? s)

+245

(process-pipe-read (session-proc s) n)

+246

(process-pty-read (session-proc s) n)))

+247

+248

;; Non-blocking write of child input; returns bytes written (may be 0

+249

;; or partial).

+250

(define (session-raw-write s data)

+251

(if (session-process? s)

+252

(process-pipe-write (session-proc s) data)

+253

(process-pty-write (session-proc s) data)))

+254

+255

;; Release the write-side fd on teardown: for a pty this closes the

+256

;; master (both directions); for a process it closes the child's stdin,

+257

;; delivering EOF. (The process stdout read fd is released when the

+258

;; process object is finalized.)

+259

(define (session-close-io! s)

+260

(if (session-process? s)

+261

(process-pipe-close-stdin! (session-proc s))

+262

(process-pty-close! (session-proc s))))

+263

264

;; ============================================================

265

;; The reader pump

266

;; ============================================================

267

−208

;; Read child output from the pty master and deliver data events,

−209

;; respecting the credit window; on EOF, reap and deliver exit.

+268

;; Read child output and deliver data events, respecting the credit

+269

;; window; on EOF, reap and deliver exit.

270

(define (reader-pump s)

271

(let ((proc (session-proc s))

272

(events (session-events s)))

−213

(let ((fd (process-pty-fd proc)))

+273

(let ((fd (session-read-fd s)))

274

(let loop ()

275

(cond

276

;; Window exhausted: park until session-credit wakes us.

@@ -221,8 +281,8 @@

281

(loop))

282

(else

283

(await-readable-fd fd)

−224

(let ((chunk (process-pty-read

−225

proc

+284

(let ((chunk (session-read

+285

s

286

(min *read-chunk-size* (session-window s)))))

287

(cond

288

((eof-object? chunk)

@@ -243,21 +303,24 @@

303

bytes: chunk))

304

(loop))))))))))

305

−246

;; EOF on the master: reap the child, deliver the exit event, close

+306

;; EOF on the read side: reap the child, deliver the exit event, close

307

;; the channels. Ordering is load-bearing for teardown safety:

308

;; reap-child! sets exit-status (and only returns once the child is

−249

;; dead, so the master is writable) BEFORE we close the out-queue and

−250

;; the master. That guarantees we never close the pty master out from

−251

;; under a writer-drain that is still about to await it (a select on a

−252

;; just-closed fd never reports ready and would wedge the goroutine).

+309

;; dead, so the write fd is writable/error-ready) BEFORE we close the

+310

;; out-queue and the write fd. That guarantees we never close the fd out

+311

;; from under a writer-drain that is still about to await it (a select

+312

;; on a just-closed fd never reports ready and would wedge the

+313

;; goroutine). The same invariant holds for both kinds: a pty master

+314

;; with a dead child is writable, and a pipe stdin with a dead child is

+315

;; error-writable (EPIPE), so a parked writer wakes in either case.

316

(define (reap-session s)

317

(let ((proc (session-proc s)))

318

(reap-child! s proc)

319

;; Release the writer: closing the out-queue wakes a writer parked

320

;; on the queue receive; exit-status (already set) stops one

−258

;; parked mid-write. Only then close the master.

+321

;; parked mid-write. Only then close the write side.

322

(channel-close! (session-out-queue s))

−260

(process-pty-close! proc)

+323

(session-close-io! s)

324

(channel-send (session-events s)

325

(dict type: 'exit

326

session: (session-id s)

@@ -304,7 +367,7 @@

367

;; only reached when the session has NOT exited (checked with no yield

368

;; point in between), so we never park on a closed fd.

369

(define (writer-drain s)

−307

(let ((fd (process-pty-fd (session-proc s))))

+370

(let ((fd (session-write-fd s)))

371

(for-channel (data (session-out-queue s))

372

(let wloop ((data data))

373

(unless (session-exit-status s)

@@ -327,7 +390,7 @@

390

391

(define (guarded-pty-write s data)

392

(guard (e (#t 'failed))

−330

(process-pty-write (session-proc s) data)))

+393

(session-raw-write s data)))

394

395

;; ============================================================

396

;; Driving

@@ -350,10 +413,11 @@

413

(channel-send (session-out-queue s) data)))

414

415

;;; Resize the session's terminal. The kernel delivers SIGWINCH to

−353

;;; the child's foreground process group.

+416

;;; the child's foreground process group. A no-op for the `'process`

+417

;;; kind, which has no pty window.

418

(define (session-resize s cols rows)

419

(: any? integer? integer? -> void?)

−356

(unless (session-exit-status s)

+420

(unless (or (session-exit-status s) (session-process? s))

421

(process-pty-resize! (session-proc s) cols rows)))

422

423

;;; Send a signal to the session's process group. Accepts the

test/test-system.sglmodified

@@ -330,3 +330,86 @@

330

(let ((status (session-close s)))

331

(assert-true (not (eq? status #f)))

332

(assert-false (session-alive? s))))))))

+333

+334

;; ============================================================

+335

;; Process (pipes) session plane — the P0b `'process` kind, the same

+336

;; Session-plane contract carried over stdin/stdout pipes instead of a

+337

;; pty (for `tmux -C` and other control-protocol children that hard-fail

+338

;; on a tty). No `pty` grant: a pipe session allocates no pty, so `exec`

+339

;; alone gates it, matching Resource-plane process spawning.

+340

;; ============================================================

+341

+342

(test-group "process session"

+343

+344

(test "open, stream stdout, reap — no pty grant needed"

+345

(let ((g (make-grants)))

+346

(grant-add! g "exec:allowlist:sh") ; deliberately NO pty:on

+347

(with-async

+348

(let ((s (session-open g (dict kind: 'process

+349

argv: '("sh" "-c" "echo process-out"))))

+350

(acc '())

+351

(exit-code #f))

+352

(assert-true (session? s))

+353

(assert-equal (session-kind s) 'process)

+354

(for-channel (ev (session-events s))

+355

(case (dict-ref ev type:)

+356

((data)

+357

(set! acc (cons (utf8->string (dict-ref ev bytes:)) acc))

+358

(session-credit s (bytevector-length (dict-ref ev bytes:))))

+359

((exit)

+360

(set! exit-code (dict-ref ev code:)))))

+361

(assert-equal exit-code 0)

+362

(let ((text (apply string-append (reverse acc))))

+363

(assert-true (string-contains? text "process-out")))))))

+364

+365

(test "the process kind is denied without an exec grant"

+366

(let ((g (make-grants)))

+367

;; No exec grant at all: even with pty:on, exec gates the spawn.

+368

(grant-add! g "pty:on")

+369

(with-async

+370

(assert-error

+371

(session-open g (dict kind: 'process argv: '("sh" "-c" "true")))))))

+372

+373

(test "write to stdin round-trips through cat (bidirectional pipes)"

+374

(let ((g (make-grants)))

+375

(grant-add! g "exec:allowlist:cat")

+376

(with-async

+377

(let ((s (session-open g (dict kind: 'process argv: '("cat"))))

+378

(acc '()))

+379

;; cat echoes stdin -> stdout; close stdin to end the stream.

+380

(go (begin

+381

(sleep 0.2)

+382

(session-write s "round-trip-ok\n")

+383

(sleep 0.3)

+384

(session-close s)))

+385

(for-channel (ev (session-events s))

+386

(when (eq? (dict-ref ev type:) 'data)

+387

(set! acc (cons (utf8->string (dict-ref ev bytes:)) acc))

+388

(session-credit s (bytevector-length (dict-ref ev bytes:)))))

+389

(let ((text (apply string-append (reverse acc))))

+390

(assert-true (string-contains? text "round-trip-ok")))))))

+391

+392

(test "resize is a harmless no-op for a pipe session"

+393

(let ((g (make-grants)))

+394

(grant-add! g "exec:allowlist:cat")

+395

(with-async

+396

(let ((s (session-open g (dict kind: 'process argv: '("cat")))))

+397

;; No pty window exists; resize must neither error nor affect I/O.

+398

(session-resize s 132 50)

+399

(go (for-channel (ev (session-events s)) #t))

+400

(sleep 0.1)

+401

(let ((status (session-close s)))

+402

(assert-true (not (eq? status #f)))

+403

(assert-false (session-alive? s)))))))

+404

+405

(test "session-close terminates a long-running pipe child"

+406

(let ((g (make-grants)))

+407

(grant-add! g "exec:allowlist:sh")

+408

(with-async

+409

(let ((s (session-open g (dict kind: 'process

+410

argv: '("sh" "-c" "sleep 30")))))

+411

(go (for-channel (ev (session-events s)) #t))

+412

(sleep 0.2)

+413

(let ((status (session-close s)))

+414

(assert-true (not (eq? status #f)))

+415

(assert-false (session-alive? s))))))))