luv

Workshop wiki

pty.lisp

terminal/pty.lisp

system luv/terminal · 41 definitions · on GitHub

A PTY process which drives one libghostty-vt terminal from one IO owner.

in-package#:luv.terminal
cffi:define-foreign-librarypty-library
:darwin
:or"libutil.dylib""/usr/lib/libutil.dylib"
:unix
:or"libutil.so.1""libutil.so"
cffi:use-foreign-librarypty-library
cffi:defcstructpty-window-size
rows:uint16
columns:uint16
width-pixels:uint16
height-pixels:uint16
cffi:defcfun
"forkpty"%forkpty
:int
master:pointer
name:pointer
terminal-attributes:pointer
window-size:pointer
cffi:defcfun
"chdir"%chdir
:int
path:pointer
cffi:defcfun
"close"%close
:int
descriptor:int
cffi:defcfun
"getdtablesize"%descriptor-table-size
:int
cffi:defcfun
"execve"%execve
:int
path:pointer
arguments:pointer
environment:pointer
cffi:defcfun
"_exit"%exit
:void
status:int
defconstant+pty-set-window-size-request+#+darwin#x80087467#+linux#x5414#-
ordarwinlinux
0
defclasspty-child
pid:initarg:pid:readerpty-child-pid
status:initform:running:accessorpty-child-status
exit-code:initformnil:accessorpty-child-exit-code
defclasspty-device
terminal:initarg:terminal:readerpty-device-terminal
process:initarg:process:readerpty-device-process
stream:initarg:stream:readerpty-device-stream
mailbox:initarg:mailbox:readerpty-device-mailbox
lock:initarg:lock:readerpty-device-lock
on-output:initarg:on-output:initformnil:readerpty-device-on-output
key-encoder:initformnil:accessorpty-device-key-encoder
state:initform:starting:accessor%pty-device-state
exit-code:initformnil:accessor%pty-device-exit-code
condition:initformnil:accessor%pty-device-condition
thread:initformnil:accessorpty-device-thread
:documentation

A child PTY and the serialized IO path which drives one Ghostty terminal.

The worker, mailbox, and terminal lock realize the single-owner flow in #K3KFGZ; the device deliberately does not own the semantic terminal.

defunpty-device-state
device
sb-thread:with-mutex
pty-device-lockdevice
%pty-device-statedevice
defunpty-device-exit-code
device
sb-thread:with-mutex
pty-device-lockdevice
%pty-device-exit-codedevice
defunpty-device-condition
device
sb-thread:with-mutex
pty-device-lockdevice
%pty-device-conditiondevice
defuncopy-octets
bytes&key
start0
end
check-typebytes
array
unsigned-byte8
let
end
orend
lengthbytes
unless
<=0startend
lengthbytes
error"Invalid PTY byte range [~D,~D) for ~D octets."startend
lengthbytes
let
copy
make-array
-endstart
:element-type'
unsigned-byte8
replacecopybytes:start2start:end2end
copy
defunsend-pty-device-bytes
devicebytes&key
start0
end

Enqueue owned input octets for device's child process.

check-typedevicepty-device
let
copy
copy-octetsbytes:startstart:endend
unless
member'
:starting:running
error"PTY device ~S is not accepting input."device
sb-concurrency:send-message
pty-device-mailboxdevice
list:writecopy
device
defunsend-pty-device-text
devicetext

UTF-8 encode text and enqueue it for device's child process.

send-pty-device-bytesdevice
sb-ext:string-to-octetstext:external-format:utf-8
defunsend-pty-device-key
deviceactionkey&keymodifiersconsumed-modifierstextunshifted-codepointcomposing-p

Enqueue one semantic Ghostty key event for device's child process.

Encoding happens on the PTY owner against the terminal's then-current modes.

check-typedevicepty-device
check-typetext
ornullstring
unless
member'
:starting:running
error"PTY device ~S is not accepting input."device
sb-concurrency:send-message
pty-device-mailboxdevice
list:keyactionkey
copy-listmodifiers
copy-listconsumed-modifiers
andtext
copy-seqtext
unshifted-codepointcomposing-p
device
defunresize-pty-device
devicecolumnsrows&key
cell-width-pixels0
cell-height-pixels0

Serialize a matching Ghostty and PTY window resize on device's IO owner.

check-typedevicepty-device
check-typecolumns
integer165535
check-typerows
integer165535
check-typecell-width-pixels
unsigned-byte16
check-typecell-height-pixels
unsigned-byte16
unless
member'
:starting:running
error"PTY device ~S cannot be resized in state ~S."device
sb-concurrency:send-message
pty-device-mailboxdevice
list:resizecolumnsrowscell-width-pixelscell-height-pixels
device
defuncall-with-pty-device-terminal
devicefunction

Call function with device's terminal while excluding PTY mutation.

check-typedevicepty-device
sb-thread:with-mutex
pty-device-lockdevice
funcallfunction
pty-device-terminaldevice
defunwrite-pty-stream-bytes
streambytes
loopforbyteacrossbytesdo
write-bytebytestream
force-outputstream
defunread-pty-stream-bytes
stream&optional
capacity4096

Return readable PTY octets, EOF status, and stream-error status.

let
bytes
make-arraycapacity:element-type'
unsigned-byte8
count0
eof-pnil
stream-error-pnil
loopwhile
<countcapacity
forbyte=
handler-case
and
listenstream
read-bytestreamnil:eof

A closed PTY master reports EIO on Linux instead of an ordinary zero-length read. Preserve any bytes collected earlier in this drain before publishing EOF.

stream-error
setfstream-error-pt
:stream-error
do
cond
nullbyte
eqbyte:eof
setfeof-pt
eqbyte:stream-error
t
setf
arefbytescount
byte
incfcount
values
if
=countcapacity
bytes
subseqbytes0count
eof-pstream-error-p
defunenable-native-pty-echo
stream

Restore the ordinary terminal-driver echo disabled by RUN-PROGRAM :PTY.

Interactive terminal children expect to inherit ECHO initially. They remain free to disable it themselves for password entry, full-screen programs, or other private input modes.

let*
file-descriptor
sb-sys:fd-stream-fdstream
attributes
sb-posix:tcgetattrfile-descriptor
setf
sb-posix:termios-lflagattributes
logior
sb-posix:termios-lflagattributes
sb-posix:echo
sb-posix:tcsetattrfile-descriptorsb-posix:tcsanowattributes
stream
defunset-native-pty-size
streamcolumnsrowscell-width-pixelscell-height-pixels
#-
ordarwinlinux
(error "PTY resizing is unsupported on this platform.")
#+
ordarwinlinux
cffi:with-foreign-object
size'
setf
cffi:foreign-slot-valuesize''rows
rows
cffi:foreign-slot-valuesize''columns
columns
cffi:foreign-slot-valuesize''width-pixels
min65535
*columnscell-width-pixels
cffi:foreign-slot-valuesize''height-pixels
min65535
*rowscell-height-pixels

SB-POSIX declares ioctl's third argument with the native variadic ABI.

Passing the CFFI pointer through its alien view matters on arm64 Darwin.

sb-posix:ioctl
sb-sys:fd-stream-fdstream
+pty-set-window-size-request+
sb-alien:sap-aliensize
*t
defunperform-pty-device-message
devicemessage
ecase
firstmessage
:write
write-pty-stream-bytes
pty-device-streamdevice
secondmessage
:continue
:key
destructuring-bind
operationactionkeymodifiersconsumed-modifierstextunshifted-codepointcomposing-p
message
declare
ignoreoperation
let
bytes
sb-thread:with-mutex
pty-device-lockdevice
let
encoder
or
pty-device-key-encoderdevice
setf
pty-device-key-encoderdevice
ghostty:encode-key-eventencoder
pty-device-terminaldevice
actionkey:modifiersmodifiers:consumed-modifiersconsumed-modifiers:texttext:unshifted-codepointunshifted-codepoint:composing-pcomposing-p
when
plusp
lengthbytes
write-pty-stream-bytes
pty-device-streamdevice
bytes
:continue
:resize
destructuring-bind
operationcolumnsrowscell-width-pixelscell-height-pixels
message
declare
ignoreoperation

Neither operation can interleave with a read or another command. The child sees the kernel size before Ghostty publishes the matching grid.

set-native-pty-size
pty-device-streamdevice
columnsrowscell-width-pixelscell-height-pixels
sb-thread:with-mutex
pty-device-lockdevice
ghostty:resize-terminal
pty-device-terminaldevice
columnsrows:cell-width-pixelscell-width-pixels:cell-height-pixelscell-height-pixels
:continue
:stop:stop
defundrain-pty-device-messages
device
loop
multiple-value-bind
messagepresent-p
sb-concurrency:receive-message-no-hang
pty-device-mailboxdevice
unlesspresent-p
return:continue
when
eq:stop
return:stop
defunupdate-pty-child-status
child&optionalno-hang-p
when
eq:running
pty-child-statuschild
multiple-value-bind
pidstatus
sb-posix:waitpid
pty-child-pidchild
ifno-hang-psb-posix:wnohang0
when
plusppid
cond
sb-posix:wifexitedstatus
setf
pty-child-statuschild
:exited
pty-child-exit-codechild
sb-posix:wexitstatusstatus
sb-posix:wifsignaledstatus
setf
pty-child-statuschild
:signaled
pty-child-exit-codechild
sb-posix:wtermsigstatus
pty-child-statuschild
defunprocess-finished-p
process
not
eq:running
defunwait-for-process-exit
processtimeout
let
deadline
+
get-internal-real-time
round
*timeoutinternal-time-units-per-second
loopuntilwhen
>=
get-internal-real-time
deadline
dodo
sleep0.01
finally
defunrelease-pty-device-process
deviceclose-requested-p
let
process
pty-device-processdevice
stream
pty-device-streamdevice
ignore-errors
sb-thread:with-mutex
pty-device-lockdevice
ghostty:set-terminal-response-function
pty-device-terminaldevice
nil
when
pty-device-key-encoderdevice
ignore-errors
ghostty:close-key-encoder
pty-device-key-encoderdevice
setf
pty-device-key-encoderdevice
nil
ignore-errors
closestream
when
eq:running
ignore-errors
sb-posix:kill
pty-child-pidprocess
sb-posix:sighup
unless
ignore-errors
sb-posix:kill
pty-child-pidprocess
sb-posix:sigterm
unless
ignore-errors
sb-posix:kill
pty-child-pidprocess
sb-posix:sigkill
let
sb-thread:with-mutex
pty-device-lockdevice
setf
%pty-device-exit-codedevice
and
memberstatus'
:exited:signaled
pty-child-exit-codeprocess
unless
eq
%pty-device-statedevice
:failed
setf
%pty-device-statedevice
ifclose-requested-p:closed:exited
process
defunrun-pty-device
device
let
close-requested-pnil
unwind-protect
handler-case
progn
sb-thread:with-mutex
pty-device-lockdevice
setf
%pty-device-statedevice
:running
loop
when
setfclose-requested-pt
multiple-value-bind
byteseof-pstream-error-p
handler-case
read-pty-stream-bytes
pty-device-streamdevice
stream-error
values
nilt
declare
ignorestream-error-p
when
plusp
lengthbytes
sb-thread:with-mutex
pty-device-lockdevice
ghostty:write-terminal-bytes
pty-device-terminaldevice
bytes
let
function
pty-device-on-outputdevice
whenfunction
funcallfunctiondevicebytes

Child exit and master EOF are not ordered: a fast child can be reaped just before its final output becomes readable. Drain any bytes first, then accept either process exit or the PTY's EOF.

when
and
oreof-p
process-finished-p
pty-device-processdevice
zerop
lengthbytes
when
zerop
lengthbytes
sleep0.005
error
condition
sb-thread:with-mutex
pty-device-lockdevice
setf
%pty-device-conditiondevice
condition
%pty-device-statedevice
:failed
release-pty-device-processdeviceclose-requested-p
device
defunenvironment-with-terminal-capabilities
environmentterm
let
result
copy-list
orenvironment
sb-ext:posix-environ
labels
set-variable
namevalue
setfresult
delete-if
lambda
entry
and
>
lengthentry
lengthname
string=nameentry:end2
lengthname
char=#\=
charentry
lengthname
result
whenvalue
push
formatnil"~A=~A"namevalue
result
whenterm
set-variable"TERM"term
set-variable"COLORTERM""truecolor"
result
defunenvironment-variable
nameenvironment
loopwithprefix=
concatenate'stringname"="
forentryinenvironmentwhen
and
>=
lengthentry
lengthprefix
string=prefixentry:end2
lengthprefix
do
return
subseqentry
lengthprefix
defunexecutable-file-p
path
handler-case
zerop
sb-posix:accesspathsb-posix:x-ok
sb-posix:syscall-error
nil
defunresolve-pty-program
programenvironmentdirectory
let*
program
namestringprogram
working-directory
merge-pathnames
uiop:ensure-directory-pathname
ordirectory"."
uiop:getcwd
labels
under-working-directory
path
namestring
if
uiop:absolute-pathname-ppath
path
merge-pathnamespathworking-directory
if
find#\/program
under-working-directoryprogram
or
loopforpathin
uiop:split-string
or
environment-variable"PATH"environment
"/usr/local/bin:/usr/bin:/bin"
:separator'
#\:
fordirectory=
if
zerop
lengthpath
"."path
forcandidate=
under-working-directory
merge-pathnamesprogram
uiop:ensure-directory-pathnamedirectory
whenreturncandidate
error"Executable ~S was not found in PATH."program
defunallocate-foreign-string-vector
strings
let
vector
cffi:foreign-alloc:pointer:count
1+
lengthstrings
pointersnil
handler-case
progn
loopforstringinstringsforindexfrom0forpointer=
cffi:foreign-string-allocstring:encoding:utf-8
do
pushpointerpointers
setf
cffi:mem-arefvector:pointerindex
pointer
setf
cffi:mem-arefvector:pointer
lengthstrings
cffi:null-pointer
valuesvectorpointers
error
condition
mapc#'cffi:foreign-string-freepointers
cffi:foreign-freevector
errorcondition
defunfree-foreign-string-vector
vectorpointers
mapc#'cffi:foreign-string-freepointers
cffi:foreign-freevector
defunlaunch-pty-child
programargumentsdirectoryenvironmentcolumnsrows

Fork program under a fresh controlling PTY and return its child and stream.

let*
program-path
resolve-pty-programprogramenvironmentdirectory
directory-path
anddirectory
namestringdirectory
program-pointer
cffi:foreign-string-allocprogram-path:encoding:utf-8
directory-pointer
anddirectory-path
cffi:foreign-string-allocdirectory-path:encoding:utf-8
argument-vectornil
argument-pointersnil
environment-vectornil
environment-pointersnil
unwind-protect
progn
multiple-value-setq
argument-vectorargument-pointers
allocate-foreign-string-vector
cons
namestringprogram
arguments
multiple-value-setq
environment-vectorenvironment-pointers
cffi:with-foreign-objects
master:int
size'
setf
cffi:foreign-slot-valuesize''rows
rows
cffi:foreign-slot-valuesize''columns
columns
cffi:foreign-slot-valuesize''width-pixels
0
cffi:foreign-slot-valuesize''height-pixels
0
let
pid
%forkptymaster
cffi:null-pointer
cffi:null-pointer
size
cond
minusppid
error"forkpty failed."
zeroppid

Everything the child needs was allocated before FORKPTY; cross the post-fork window with only libc calls.

Close everything above the terminal FORKPTY just gave us. A shell in the wall would otherwise inherit every descriptor the image holds, and the one that hurts is the Slynk listening socket: an orphaned shell keeps the port bound long after its image is gone, so ./sly finds a port that accepts connections, answers no handshake, and refuses to start a replacement. A terminal has no business holding its parent's sockets open.

The table size is a soft limit, not a census: a shell whose ulimit is a million must not pay a million syscalls to start. The image's own descriptors are small numbers, so a few thousand closes cover them.

let*
limit
%descriptor-table-size
bound
if
plusplimit
minlimit4096
4096
loopfordescriptorfrom3belowbounddo
%closedescriptor
when
anddirectory-pointer
minusp
%chdirdirectory-pointer
%exit126
%execveprogram-pointerargument-vectorenvironment-vector
%exit127
t
let
master-fd
cffi:mem-refmaster:int
handler-case
values
make-instance'pty-child:pidpid
sb-sys:make-fd-streammaster-fd:inputt:outputt:dual-channel-pt:element-type'
unsigned-byte8
:buffering:none:auto-closet:name
formatnil"PTY for ~A"program
error
condition
ignore-errors
sb-posix:closemaster-fd
ignore-errors
sb-posix:killpidsb-posix:sigterm
ignore-errors
sb-posix:waitpidpid0
errorcondition
whenenvironment-vector
free-foreign-string-vectorenvironment-vectorenvironment-pointers
whenargument-vector
free-foreign-string-vectorargument-vectorargument-pointers
whendirectory-pointer
cffi:foreign-string-freedirectory-pointer
cffi:foreign-string-freeprogram-pointer
defunopen-pty-device
terminal&key
program
or
uiop:getenv"SHELL"
"/bin/sh"
argumentsdirectoryenvironment
term"xterm-256color"
on-output

Start program under a PTY whose output drives terminal.

The device owns its child, PTY stream, IO thread, and Ghostty response route; it does not own terminal. All terminal mutation and PTY traffic are serialized by the device's worker. Use call-with-pty-device-terminal for renderer-side snapshot work which must not race mutation.

unless
error"Cannot attach a PTY to closed terminal ~S."terminal
let*
child-environment
processnil
streamnil
device
multiple-value-bind
columnsrows
multiple-value-bind
childpty-stream
launch-pty-childprogramargumentsdirectorychild-environmentcolumnsrows
setfprocesschildstreampty-stream
make-instance'pty-device:terminalterminal:processprocess:streamstream:mailbox
sb-concurrency:make-mailbox:name"luv PTY commands"
:lock
sb-thread:make-mutex:name"luv PTY terminal"
:on-outputon-output
completed-pnil
unwind-protect
progn
ghostty:set-terminal-response-functionterminal
lambda
bytes

Ghostty has already copied its borrowed callback data. The mailbox transfer keeps the callback quick and non-reentrant.

sb-concurrency:send-message
pty-device-mailboxdevice
list:writebytes
setf
pty-device-threaddevice
sb-thread:make-thread
lambda
:name"luv PTY owner"
setfcompleted-pt
device
unlesscompleted-p
whenstream
ignore-errors
closestream
when
andprocess
eq:running
ignore-errors
sb-posix:kill
pty-child-pidprocess
sb-posix:sigterm
ignore-errors
defunwait-for-pty-device
device&key
timeout5.0

Wait for device's owner to finish; return its state or :timeout.

check-typedevicepty-device
multiple-value-bind
valuestate
sb-thread:join-thread
pty-device-threaddevice
:timeouttimeout:default:timeout
declare
ignorevalue
if
eqstate:timeout
:timeout
defunclose-pty-device
device&key
timeout2.0

Stop device cooperatively, release its child and descriptor, and join it.

check-typedevicepty-device
let
state
when
memberstate'
:starting:running
sb-concurrency:send-message
pty-device-mailboxdevice
list:stop
when
sb-thread:thread-alive-p
pty-device-threaddevice
when
eq:timeout
wait-for-pty-devicedevice:timeouttimeout
error"PTY owner did not stop within ~,2F seconds."timeout
sb-thread:with-mutex
pty-device-lockdevice
unless
eq
%pty-device-statedevice
:failed
setf
%pty-device-statedevice
:closed
device