Linux Console Graphics with, DRM, GBM, EGL, GLES, logind, libinput, etc. in CL
I want glop2 to support running directly on Linux console without X or Wayland or whatever, and happened to want to run some code on an arm board with flaky X drivers, so spent some time trying to figure out how to get that running. This post is my notes on what I've figure out so far, for when I get around to actually implementing glop2.
Device permissions
The image I had on the arm board is Ubuntu, using systemd, so I use
logind to manage devices instead of opening them directly. This
simplifies some aspects of permissions, since if you are running on a
particular seat, you can automatically access any devices associated
with that seat. In other ways, it is more complicated, since if you
connect over ssh you don't have a seat and can't access anything.
On other systems, would probably want to add the user to whatever
groups have access to the /dev/dri/card*/ and /dev/input/event*
devices, and open them manually.
Since I was too lazy to go find a keyboard to plug into the device to
control a seat, and also because I wanted to boot directly into the
program when it was done, I ended up configuring the getty@tt1 service
to login automatically (and tell systemd not to start X as well).
$ sudo systemctl disable lightdm
$ sudo systemctl edit getty@tty1then add
[Service]
ExecStart=
ExecStart=-/sbin/agetty --autologin username --noclear %Iand tell ~/.profile to automatically run a lisp image running a
swank swank server when run on tty1. Also send all output to a file
since we can't see console while running graphics, and can't scroll up
in console output without a keyboard.
tty=`ps -p $$ -o tty=`
if [ "$tty" = tty1 ]; then
~/bin/foo > ~/debug-log 2>&1
fi
Then it boots I can just restart the getty to restart the image when
I get things in a bad state, or want to see if my program works
correctly when started directly.
$ sudo systemctl restart getty@tty1Getting access to the seat
Once the system is set up, the next step is talking to logind to get
access to the seat, activate it, etc. For that, we need to use DBUS. I
used the dbus library. We'll also
need a few other libraries, so load all of those as well (or add them
to dependencies in an .asd file and load that).
(ql:quickload '(:alexandria :cffi :osicat :dbus :cl-drm :cl-gbm :cl-egl :cl-libinput :cl-opengl/es2))
;; Might need to manually download cl-libinput from
;; https://github.com/malcolmstill/cl-libinput if it isn't in QL yet.
;; Parts of this might also need my forks from https://github.com/3b/
;; if I haven't gotten them cleaned up enuogh to submit upstream yet, or
;; from upstream sources if I have but they haven't hit QL yet.
;; Substitute normal :cl-opengl if desired if it is available on your
;; system.For real use, would want to store a single dbus connection, and
reuse the objects, but for interactive examples, lets define some
helper macros.
(defvar *bus*)
(defmacro with-dbus (() &body body)
`(dbus:with-open-bus (*bus* (dbus:system-server-addresses))
,@body))
(defmacro with-object ((object call path destination)
&body forms)
`(let ((,object (dbus:make-object-from-introspection
(dbus:bus-connection *bus*) ,path ,destination)))
(flet ((,call (interface-name method-name &rest args)
(apply #'dbus:object-invoke ,object
interface-name method-name args)))
,@forms)))
Now we can make some calls and see if things are working:
(with-dbus ()
(with-object (o call "/org/freedesktop/login1"
"org.freedesktop.login1")
(call "org.freedesktop.login1.Manager"
"ListSessions")))
;; Here I have 2 SSH sessions open, with seat = "", and one console
;; session, "seat0"
;; session id, uid, username, seat name, session name
(("4" 1001 "3b" "" "/org/freedesktop/login1/session/_34")
("14" 1001 "3b" "seat0" "/org/freedesktop/login1/session/_314")
("3" 1001 "3b" "" "/org/freedesktop/login1/session/_33"))
(with-dbus ()
(with-object (o call "/org/freedesktop/login1"
"org.freedesktop.login1")
(call "org.freedesktop.login1.Manager"
"ListSeats")))
;; There is one seat
(("seat0" "/org/freedesktop/login1/seat/seat0"))
;; but what we really want to know is which one we are currently using:
(with-dbus ()
(with-introspected-object (o call "/org/freedesktop/login1"
"org.freedesktop.login1")
(call "org.freedesktop.login1.Manager"
"GetSessionByPID" (nix:getpid))))
;; ->
"/org/freedesktop/login1/session/_314"
See https://www.freedesktop.org/software/systemd/man/org.freedesktop.login1.html for the full list of APIs available from logind.
Most of the rest will be using the Manager or Session interfaces, so lets wrap that up into another macro.
(defmacro with-dbus* ((login lcall lprop session scall sprop)
&body body)
(alexandria:with-gensyms (session-name)
`(dbus:with-open-bus (*bus* (dbus:system-server-addresses))
(let ((,login (dbus:make-object-from-introspection
(dbus:bus-connection *bus*)
"/org/freedesktop/login1"
"org.freedesktop.login1")))
(flet ((,lcall (interface-name method-name &rest args)
(apply #'dbus:object-invoke ,login
interface-name method-name args))
(,lprop (property)
(dbus:get-property *bus*
"org.freedesktop.login1"
"/org/freedesktop/login1"
"org.freedesktop.login1.Manager"
property)))
(declare (ignorable #',lcall #',lprop))
(let* ((,session-name (,lcall "org.freedesktop.login1.Manager"
"GetSessionByPID" (nix:getpid)))
(,session (dbus:make-object-from-introspection
(dbus:bus-connection *bus*)
,session-name
"org.freedesktop.login1")))
(flet ((,scall (method-name &rest args)
(apply #'dbus:object-invoke ,session
"org.freedesktop.login1.Session"
method-name args))
(,sprop (property)
(dbus:get-property *bus*
"org.freedesktop.login1"
,session-name
"org.freedesktop.login1.Session"
property)))
(declare (ignorable #',scall #',sprop))
,@body)))))))
Add one more helper to translate paths to the major + minor device numbers logind wants, and we are ready to start doing graphics.
(defun path-device (path)
;; return device major/minor for a given path
(let ((rdev (nix:stat-rdev (nix:stat path))))
(assert (not (zerop rdev)))
(list (ldb (byte 8 8) rdev) (ldb (byte 8 0) rdev))))
(defmacro with-card ((fd) &body body)
;; not bothering with gensyms here since we might want access to the
;; various bindings created here, and real code would probably be
;; factored out differently instead of using a macro like this
`(with-dbus* (l lc lp s sc sp)
;; first we need to take control of the session
(sc "TakeControl" nil)
;; then open the DRI device. Currently I just hard-code
;; "/dev/dri/card0", not sure what the "correct" way to find it is
;; yet. Possibly looking for "/run/udev/tags/<seat>/+drm*" and
;; parsing the name? (where <seat> is "seat" for seat0, otherwise
;; name of seat?) Maybe something with libudev?
(unwind-protect
(multiple-value-bind (,fd paused)
(apply #'sc "TakeDevice"
(path-device "/dev/dri/card0"))
(when ,fd
(unwind-protect
(progn
;; if the session is paused, we can try activating it
(when paused
(sc "Activate"))
,@body))
;; Releasing the session below implicitly releases
;; devices, but we can do it manually too
(apply #'sc "ReleaseDevice"
(path-device "/dev/dri/card0"))
;; but apparently we still need to close the FD
;; ourselves (don't see it mentioned in logind docs,
;; aside from needing to close old fd after Resume
;; events, but FDs stay open without it)
(nix:close fd)))
;; when we are done, we need to release the session
(sc "ReleaseControl"))))
(with-card (fd)
(format t "got FD ~s for DRM device~%" fd))
For real code we should also watch for DBUS events indicating devices have been Paused/Resumed, screen has been Locked/Unlocked, changes in session Active or Idle state, or if the system is shutting down or sleeping.
Adding graphics
Once we have a DRM fd open, we can use it to switch to graphics mode and set up OpenGL ES (or normal GL if you have it).
We can query some capabilities with drm:get-cap:
(cffi:defcenum (drm-caps :uint64)
(:dumb-buffer #x1)
(:vblank-high-crtc #x2)
(:dumb-preferred-depth #x3)
(:dumb-prefer-shadow #x4)
(:prime #x5)
(:timestamp-monotonic #x6)
(:async-page-flip #x7)
;;;; on my machine:
;;caps:
;; :DUMB-BUFFER = 1
;; :VBLANK-HIGH-CRTC = 1
;; :DUMB-PREFERRED-DEPTH = 0
;; :DUMB-PREFER-SHADOW = 0
;; :PRIME = 3
;; :TIMESTAMP-MONOTONIC = 1
;; :ASYNC-PAGE-FLIP = 0
;; :CURSOR-WIDTH = 64
;; :CURSOR-HEIGHT = 64
;; :ADDFB2-MODIFIERS = 0
;; :PAGE-FLIP-TARGET = 0
;;In particular the :async-page-flip = 0 here means we need to use
event-based page flipping rather than asynchronous.
Now we set up the various graphics libraries (drm, gbm, egl), handle page flipping, and then we can do some simple drawing.
;;; for double-buffered display wwith vsync, we need to set up some
;;; handlers for drm events
(cffi:defcallback vblank-handler :void ((fd :int)
(seq :unsigned-int)
(sec :unsigned-int)
(usec :unsigned-int)
(user-data (:pointer :void)))
(declare (ignorable fd seq sec usec user-data))
;; vblank event seems not be sent by default, not sure how to enable
;; them
)
(defparameter *flipping* nil)
(cffi:defcallback page-flip-handler :void ((fd :int)
(seq :unsigned-int)
(sec :unsigned-int)
(usec :unsigned-int)
(user-data (:pointer :void)))
(declare (ignorable fd seq sec usec user-data))
(setf *flipping* nil))
(defun make-drm-event-context ()
(let ((p (cffi:foreign-alloc '(:struct drm:event-context))))
(cffi:with-foreign-slots ((drm:version
drm:vblank-handler
drm:page-flip-handler)
p (:struct drm:event-context))
(setf drm:version 2)
(setf drm:vblank-handler (cffi:callback vblank-handler))
(setf drm:page-flip-handler (cffi:callback page-flip-handler)))
p))
(with-card (fd)
;; drm:find-display-configuration picks a connector and mode for us,
;; which is good enough for my current needs. If you want to support
;; multiple monitors or change modes you might need to do it
;; yourself.
(let* ((display-config (drm:find-display-configuration fd))
;; some slots from the display-config we will need later
(mode-info (drm:mode-info display-config))
(crtc (drm:crtc display-config))
;; To do any output, we need buffers in which to store it,
;; and from which the card can display them. libgbm (Generic
;; Buffer Management) is responsible for managing those
;; buffers, so we need to initialize it as well.
(gbm (gbm:create-device fd))
;; get an EGL display from the GBM device
;; (get-platform-display is in egl 1.5, but my board only has
;; 1.4. Should query versions and check extensions before
;; doing this...)
(display (egl:get-platform-display-ext :platform-gbm-khr
gbm
(cffi:null-pointer))))
;; initialize EGL on the display (returns major / minor version
;; numbers as 2 values)
(format t "egl init ~s~%" (multiple-value-list (egl:initialize display)))
;; tell EGL which API we want to use, :opengl-api for desktop GL
(egl:bind-api :opengl-es-api)
;; and verify we got it
(format t "egl api ~s~%" (egl:query-api))
;; print out some information on available APIs, driver being
;; used, and available extensions
(loop for i in '(:client-apis :vendor :version :extensions)
do (format t "~s: ~s~%"
i (egl:query-string display i)))
;; set up a gles context
(let* ((configs (egl::choose-config* display
:buffer-size 32
:depth-size :dont-care
:stencil-size :dont-care
:surface-type :window-bit
:renderable-type :opengl-es2-bit
:none))
;; we'll just use the first one here
(config (car configs))
;; create a context, ask for GLES2
(context (egl:create-context display
config
(cffi:null-pointer)
:context-major-version 2
:none))
;; get dimensions of the mode
(width (drm:mode-width mode-info))
(height (drm:mode-height mode-info))
;; create a GBM surface we can draw into
(gbm-surface (gbm:surface-create gbm
width height
875713112 ;; xrgb8888
5)) ;; scanout | rendering
;; create an egl surface from the gbm surface
(egl-surface (egl:create-window-surface display config
gbm-surface :none))
;; configuration for drm event handler
(event-context (make-drm-event-context))
;; page flipping code is a bit verbose, so we'll store some
;; state in a list to pass to it. Should all be in proper
;; classes or whatever for real code
(flip-state (list nil nil ;; some state variables
event-context
fd display egl-surface gbm-surface
crtc width height)))
;; see what configs are available
(loop for i from 0
for c in configs
do (format t "~%egl config ~s:~% ~s~%" i
(egl:get-config-attribs display c)))
;; print some info about the EGL surface we created
(format t "~%~%EGL surface properties:~%")
(loop for i in '(:width :height
:horizontal-resolution :vertical-resolution
:render-buffer :swap-behavior)
do (format t " ~s = ~s~%" i
(egl:query-surface display egl-surface i)))
;; make the egl context current
(unless (zerop (egl:make-current display
;; we will read from and draw
;; to same surface
egl-surface egl-surface
context)))
;; reset the page flip flag
(setf *flipping* nil)
;; now we should be able to start drawing. Since gles2 requires
;; VBOs and shaders, we'll just clear the screen to random
;; colors for a few second...
(loop repeat 3000
do (gl:clear-color (random 1.0) (random 1.0) (random 1.0) 1)
(gl:clear :color-buffer)
(swap-buffers flip-state))
;; when we are done, clean everything up (should probably use a
;; few unwind-protects here)
(when crtc
;; restore the original crtc settings
(cffi:with-foreign-object (connector-id :uint32)
(setf (cffi:mem-ref connector-id :uint32)
(drm::connector-id display-config))
(cffi:with-foreign-slots ((drm:crtc-id drm:buffer-id drm:x drm:y)
crtc
(:struct drm:mode-crtc))
(drm:mode-set-crtc fd
drm:crtc-id drm:buffer-id drm:x drm:y
connector-id 1
(cffi:foreign-slot-pointer
crtc '(:struct drm:mode-crtc) 'drm:mode))
(drm:mode-free-crtc crtc))))
;; clean up buffers used for page flipping
(when (car flip-state)
(drm:mode-remove-framebuffer fd (first flip-state))
(gbm:surface-release-buffer gbm-surface (second flip-state)))
;; destroy surfaces
(egl:destroy-surface display egl-surface)
(gbm:surface-destroy gbm-surface)
;; destroy context
(egl:destroy-context display context)
;; close display
(egl:terminate display)
;; close gbm device
(gbm:device-destroy gbm)
;; free event-context
(cffi:foreign-free event-context))))
(defun swap-buffers (flip-state)
(destructuring-bind (old-fb old-bo
event-context
fd display egl-surface gbm-surface
crtc width height) flip-state
;; if we have scheduled a page flip, wait for the completion
;; event. Real code should use select/poll/epoll/etc to wait for
;; the FD to be readable instead of busy-waiting like this.
(loop do (drm:handle-event fd event-context)
while *flipping*
do (sleep 0.001))
;; first swap the EGL buffers
(egl:swap-buffers display egl-surface)
;; call surface-lock-front-buffer once per egl:swap-buffers to get
;; a gbm `bo` (buffer object) for the front buffer
(let* ((bo (gbm:surface-lock-front-buffer gbm-surface))
;; get some slots from the BO we will be using later
(handle (gbm:bo-get-handle bo))
(stride (gbm:bo-get-stride bo)))
(cffi:with-foreign-objects ((fb :uint32))
;; create a framebuffer using the bo associated with HANDLE for
;; storage
(drm:mode-add-framebuffer fd width height
24 32 stride handle fb)
;; set flag indicating we scheduled a page flip
(setf *flipping* t)
;; schedule a page flip for next vblank to display the new
;; framebuffer, and request and event when the flip completes
;; if we wanted double-buffer without vsync, we could use
;; drm:mode-set-crtc instead to swap immediately. Probably can
;; also configure it to draw directly to a single framebuffer
;; for single-buffered display.
(drm:mode-page-flip fd (drm:crtc-crtc-id crtc)
(cffi:mem-aref fb :uint32)
1 ;; 1 = event, 2 = async
(cffi:null-pointer))
;; after the first frame, we need to clean up the previous
;; frame
(when old-bo
(drm:mode-remove-framebuffer fd old-fb)
(gbm:surface-release-buffer gbm-surface old-bo))
;; write state back into input list for next call
(setf (first flip-state) (cffi:mem-ref fb :uint32)
(second flip-state) bo)))))
Similar to the logind events, we should also be watching for lost
contexts, etc in the graphics code.