luv

Workshop wiki

portal-server.lisp

luvcraft/portal-server.lisp

system luvcraft/core · 14 definitions · on GitHub

The portal server: a Unix socket where child luvcrafts come knocking.

A playing game listens on a socket and tells every shell it opens on a terminal wall where that socket is (luvcraft_PARENT_SOCKET) and which wall the shell is on (luvcraft_PARENT_SCREEN). Any luvcraft started in such a shell notices the variables, connects instead of opening a window, says hello naming its wall, and the game here answers with a ring of surfaces and puts the child's picture on that very wall. Since the child is a whole game with walls of its own, it serves a socket too, and the shells on its walls can start grandchildren.

in-package#:luvcraft
defclassluvcraft-portal-server
session:initarg:session:readerportal-server-session
path:initarg:path:readerportal-server-path
socket:initarg:socket:accessorportal-server-socket
acceptor:initformnil:accessorportal-server-acceptor
running-p:initformt:accessorportal-server-running-p

Screen name -> function of a ready mirror which places it.

screens:initform
make-hash-table:test#'equal
:readerportal-server-screens
portals:initformnil:accessorportal-server-portals
:documentation

A listening Unix socket and the walls children may ask for.

defvar*portal-servers*
make-hash-table:test#'eq
"Session -> its portal server, for the game that is playing here."
defunluvcraft-portal-server
session
gethashsession*portal-servers*
defunluvcraft-portal-socket-path
namestring
merge-pathnames
formatnil"luvcraft-~D.sock"
sb-posix:getpid
uiop:temporary-directory
defunensure-luvcraft-portal-server
session

session's portal server, started on first request.

or
let*
socket
make-instance'sb-bsd-sockets:local-socket:type:stream
when
probe-filepath
delete-filepath
sb-bsd-sockets:socket-bindsocketpath
sb-bsd-sockets:socket-listensocket8
let
server
make-instance'luvcraft-portal-server:sessionsession:pathpath:socketsocket
setf
portal-server-acceptorserver
sb-thread:make-thread:name"luvcraft portal server"
setf
gethashsession*portal-servers*
server
defunstop-luvcraft-portal-server
session
alexandria:when-let
setf
portal-server-running-pserver
nil
ignore-errors
sb-bsd-sockets:socket-close
portal-server-socketserver
ignore-errors
delete-file
portal-server-pathserver
dolist
portal
portal-server-portalsserver
ignore-errors
setf
portal-server-portalsserver
nil
remhashsession*portal-servers*
values
defunluvcraft-portal-environment
sessionscreenenvironment

environment with the variables that make a luvcraft started under it a child of session appearing on screen.

let
list*
formatnil"LUVCRAFT_PARENT_SOCKET=~A"
portal-server-pathserver
formatnil"LUVCRAFT_PARENT_SCREEN=~A"screen
remove-if
lambda
entry
or
uiop:string-prefix-p"LUVCRAFT_PARENT_SOCKET="entry
uiop:string-prefix-p"LUVCRAFT_PARENT_SCREEN="entry
environment
defunregister-luvcraft-portal-screen
sessionscreenplacer

When a child asks for screen, call placer with its ready mirror. placer returns the portal it opened, or NIL to decline.

setf
gethashscreen
portal-server-screens
placer
defununregister-luvcraft-portal-screen
sessionscreen
alexandria:when-let
remhashscreen
portal-server-screensserver
defunaccept-luvcraft-portal-children
server
loopwhile
portal-server-running-pserver
do
let
client
handler-case
sb-bsd-sockets:socket-accept
portal-server-socketserver
error
nil
cond
not
portal-server-running-pserver
whenclient
ignore-errors
sb-bsd-sockets:socket-closeclient
client
sb-thread:make-thread:name"luvcraft portal child"
defunwelcome-luvcraft-portal-child
serverclient

Negotiate with one connected child and put it where it asked to be.

let*
stream
sb-bsd-sockets:socket-make-streamclient:inputt:outputt:element-type'character:buffering:line:external-format:utf-8
mirror
make-instance'luvcraft-mirror:streamstream
handler-case
progn
let*
screen
luvcraft-mirror-screenmirror
placer
or
gethashscreen
portal-server-screensserver
gethash"-"
portal-server-screensserver
portal
andplacer
funcallplacermirror
ifportal
pushportal
portal-server-portalsserver
progn
warn"No wall named ~S for a child luvcraft; sending it away."screen
error
condition
warn"A child luvcraft did not make it onto a wall: ~A"condition
ignore-errors
defunforget-luvcraft-portal
sessionportal
alexandria:when-let
setf
portal-server-portalsserver
deleteportal
portal-server-portalsserver

The child end: luvcraft_PARENT_SOCKET in the environment.

defunluvcraft-parent-socket-path
let
path
uiop:getenv"LUVCRAFT_PARENT_SOCKET"
andpath
plusp
lengthpath
path
defunserve-luvcraft-parent
&key
screen
or
uiop:getenv"LUVCRAFT_PARENT_SCREEN"
"-"

Connect to the parent game at path and be a mirror child on screen.

let
socket
make-instance'sb-bsd-sockets:local-socket:type:stream
sb-bsd-sockets:socket-connectsocketpath
let
stream
sb-bsd-sockets:socket-make-streamsocket:inputt:outputt:element-type'character:buffering:line:external-format:utf-8
unwind-protect
serve-luvcraft-mirror:inputstream:outputstream:screenscreen
ignore-errors
closestream
ignore-errors
sb-bsd-sockets:socket-closesocket