200 lines
15 KiB
Common Lisp
200 lines
15 KiB
Common Lisp
;;;; Owned Xvfb only: disk restoration, surviving hidden clients, identity safety,
|
|
;;;; autosave, unavailable leases, topology changes, and corrupt/I/O-failing files.
|
|
(require :asdf)
|
|
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
|
(asdf:load-system "lime/dev")
|
|
|
|
(handler-case
|
|
(let* ((directory (uiop:ensure-directory-pathname
|
|
(string-trim '(#\Newline) (uiop:run-program '("mktemp" "-d" "/tmp/lime-persistence-XXXXXX") :output :string))))
|
|
(path (merge-pathnames "session.sexp" directory))
|
|
(server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x600x24" "-nolisten" "tcp")
|
|
:output :stream :error-output :interactive))
|
|
(backend nil) (clients nil) (checks 0))
|
|
(unwind-protect
|
|
(let* ((number (parse-integer (read-line (uiop:process-info-output server))))
|
|
(display-name (format nil ":~D" number))
|
|
(heads (list (lime.x11:make-x11-head :head-id "left" :x 0 :y 0 :width 500 :height 600)
|
|
(lime.x11:make-x11-head :head-id "right" :x 500 :y 0 :width 500 :height 600))))
|
|
(setf clients (xlib:open-default-display display-name))
|
|
(let* ((root (xlib:screen-root (xlib:display-default-screen clients)))
|
|
(windows (loop repeat 4 collect (xlib:create-window :parent root :x 10 :y 10 :width 100 :height 80 :border-width 7)))
|
|
(ids nil) (saved nil))
|
|
(labels ((check (truth label) (assert truth () "Persistence: ~A" label) (incf checks))
|
|
(world () (lime.x11:x11-backend-world backend))
|
|
(current (head) (lime.core:current-presentation (world) head))
|
|
(sync () (xlib:display-finish-output (lime.x11::x11-backend-display backend)))
|
|
(start (&optional (screens heads))
|
|
(setf backend (lime.x11:start-lime :display-name display-name :heads screens :head-bar-height 0
|
|
:install-default-keybindings-p nil :session-file path))
|
|
(sync))
|
|
(stop () (lime.x11:stop-backend backend) (setf backend nil))
|
|
(status () (lime.x11:backend-session-status backend))
|
|
(snapshot () (let ((data (lime.persistence:snapshot-world (world))))
|
|
(remf data :revision) data))
|
|
(crash ()
|
|
;; Deliberately do not remap hidden clients or save a new
|
|
;; snapshot, like losing only the WM process, not X.
|
|
(lime.x11::%stop-session-persistence backend nil)
|
|
(xlib:close-display (lime.x11::x11-backend-display backend) :abort t)
|
|
(setf (lime.x11::x11-backend-display backend) nil backend nil))
|
|
(pump-for (seconds)
|
|
(let ((end (+ (get-internal-real-time) (* seconds internal-time-units-per-second))))
|
|
(lime.x11:run-event-loop backend :timeout 0.01
|
|
:before-event (lambda (b) (when (>= (get-internal-real-time) end)
|
|
(setf (lime.x11::x11-backend-running-p b) nil)))))))
|
|
(start)
|
|
(check (not (getf (status) :blocked-p)) "fresh store enabled")
|
|
(lime.x11:backend-start-activity backend "work" "Work 日本語")
|
|
(dolist (window windows)
|
|
(xlib:display-finish-output clients)
|
|
(push (lime.x11:manage-window backend (xlib::lookup-window (lime.x11::x11-backend-display backend)
|
|
(xlib:window-id window))) ids))
|
|
(setf ids (nreverse ids))
|
|
(lime.x11:backend-hide-client backend (third ids))
|
|
(lime.x11:backend-hide-client backend (fourth ids))
|
|
(lime.core:toggle-client-floating (world) (lime.core:presentation-id (current "left")) (second ids))
|
|
(lime.core:set-client-tile-weight (world) (lime.core:presentation-id (current "left")) (first ids) 3/2)
|
|
(lime.x11:backend-save-view backend "code" "Code")
|
|
(lime.x11:backend-activate-view backend "code")
|
|
(lime.core:create-view (world) "docs" "work" "Docs"
|
|
(mapcar (lambda (id) (lime.core:make-placement :client-id id))
|
|
(list (third ids) (first ids)))
|
|
:layout-mode :monocle :focus-client-id (third ids))
|
|
(lime.x11:backend-extend-activity-to-head backend "work" "right")
|
|
(lime.x11:backend-activate-view-partially backend "docs" :head-id "right")
|
|
(lime.x11:backend-save-viewset backend "desk" "Desk")
|
|
(lime.x11:backend-set-client-floating-geometry backend (second ids) :head-id "left"
|
|
:x 1/4 :y 1/3 :width 1/2 :height 1/2)
|
|
(lime.x11:backend-focus-client backend (third ids) :head-id "right")
|
|
(sync)
|
|
(setf saved (snapshot))
|
|
(lime.x11:backend-save-session backend)
|
|
(check (probe-file path) "explicit save creates file")
|
|
(check (= 1 (getf (status) :completed)) "explicit save waits for durable write")
|
|
(check (eq :unmapped (xlib:window-map-state (fourth windows))) "hidden client really unmapped")
|
|
(stop)
|
|
(check (every (lambda (w) (eq :viewable (xlib:window-map-state w))) windows) "graceful stop remaps clients")
|
|
(start)
|
|
(check (= 4 (getf (getf (status) :restore) :matched)) "all surviving clients reconnected")
|
|
(check (equalp saved (snapshot)) "whole desk roundtrips exactly except revision")
|
|
(check (equal "right" (lime.x11:x11-backend-focused-head-id backend)) "focused Head restored")
|
|
(check (equal (list (first ids)) (lime.core:presentation-unavailable-client-ids (current "right")))
|
|
"partial view stays partial, no stolen lease")
|
|
(check (eq :unmapped (xlib:window-map-state (fourth windows))) "hidden client re-hidden after graceful restart")
|
|
(check (lime.core:validate-world (world)) "restored world valid")
|
|
;; Save-on-exit is not the only persistence path.
|
|
(lime.x11:backend-start-activity backend "game" "Game" :head-id "right")
|
|
(pump-for 1.0)
|
|
(check (>= (getf (status) :completed) 1) "autosave runs without explicit save")
|
|
(let ((last (getf (status) :submitted)))
|
|
(pump-for 0.2)
|
|
(check (= last (getf (status) :submitted)) "unchanged state does not rewrite disk"))
|
|
(setf saved (snapshot))
|
|
(crash)
|
|
(start)
|
|
(check (equalp saved (snapshot)) "autosaved drafts survive abrupt connection loss")
|
|
(check (= 4 (getf (getf (status) :restore) :matched)) "unmapped clients found after abrupt loss")
|
|
(check (null (gethash (xlib:window-id (fourth windows)) (lime.x11::x11-backend-pending-unmaps backend)))
|
|
"already-hidden restored client has no ghost unmap token")
|
|
(check (equal "game" (lime.core:presentation-activity-id (current "right"))) "unsaved Activity draft persisted")
|
|
;; Missing output suspends rather than losing/moving that draft.
|
|
(stop)
|
|
(start (list (first heads)))
|
|
(check (equal '("left") (lime.x11:backend-head-ids backend)) "new topology respected")
|
|
(check (find-if (lambda (p) (and (equal "game" (lime.core:presentation-activity-id p))
|
|
(null (lime.core:presentation-head-id p))))
|
|
(loop for p being the hash-values of (lime.core::world-presentations (world)) collect p))
|
|
"missing Head draft suspended")
|
|
(check (lime.core:find-viewset (world) "desk") "Viewset survives missing output")
|
|
(check (lime.core:validate-world (world)) "topology-restored world valid")
|
|
;; A write error cannot replace the good file or kill the WM.
|
|
(let ((bytes (uiop:read-file-string path)) (original (symbol-function 'lime.persistence::%sync-path)))
|
|
(unwind-protect
|
|
(progn
|
|
(setf (symbol-function 'lime.persistence::%sync-path)
|
|
(lambda (p) (declare (ignore p)) (error "Injected disk failure")))
|
|
(check (handler-case (progn (lime.x11:backend-save-session backend) nil) (error () t))
|
|
"explicit save reports disk failure"))
|
|
(setf (symbol-function 'lime.persistence::%sync-path) original))
|
|
(check (string= bytes (uiop:read-file-string path)) "failed write leaves previous file intact")
|
|
(check (getf (status) :write-error) "write failure inspectable")
|
|
(setf (lime.x11::session-persistence-last-attempt (lime.x11::x11-backend-session-persistence backend))
|
|
(- (/ (get-internal-real-time) internal-time-units-per-second) 6))
|
|
(pump-for 0.1)
|
|
(check (null (getf (status) :write-error)) "autosave retries after disk-error backoff")
|
|
(lime.x11:backend-save-session backend)
|
|
(check (null (getf (status) :write-error)) "explicit retry recovers"))
|
|
(stop)
|
|
;; Matching XID alone is not enough, even on the same server.
|
|
(xlib:change-property (first windows) :_LIME_SESSION_CLIENT '(98 97 100) :STRING 8)
|
|
(xlib:display-finish-output clients)
|
|
(start (list (first heads)))
|
|
(check (member (first ids) (getf (getf (status) :restore) :missing) :test #'equal)
|
|
"reused/mismatched identity not reconnected")
|
|
(check (not (find (first ids) (lime.core:view-placements (lime.core:find-view (world) "code"))
|
|
:key #'lime.core:placement-client-id :test #'equal))
|
|
"unverified client not smuggled into old checkpoint")
|
|
(stop)
|
|
(xlib:destroy-window (second windows))
|
|
(xlib:display-finish-output clients)
|
|
(start (list (first heads)))
|
|
(check (member (second ids) (getf (getf (status) :restore) :missing) :test #'equal) "dead client retired safely")
|
|
(check (lime.core:find-view (world) "code") "empty named checkpoint retained")
|
|
(stop)
|
|
;; Equivalent identity boundary to a fresh X server after logout.
|
|
(xlib:delete-property root :_LIME_SESSION_SERVER)
|
|
(xlib:display-finish-output clients)
|
|
(start (list (first heads)))
|
|
(check (not (getf (getf (status) :restore) :same-server-p)) "server epoch change detected")
|
|
(check (zerop (getf (getf (status) :restore) :matched)) "no stale-window reconnection across servers")
|
|
(check (lime.core:find-activity (world) "game") "named Activities survive different X session")
|
|
(check (lime.core:find-view (world) "docs") "named Views survive different X session")
|
|
(stop)
|
|
(let ((bad "(:format :lime-session :version 999)"))
|
|
(with-open-file (out path :direction :output :if-exists :supersede) (write-string bad out))
|
|
(start)
|
|
(check (getf (status) :blocked-p) "bad file blocks autosave, not WM startup")
|
|
(check (getf (status) :restore-error) "restore error inspectable")
|
|
(check (handler-case (progn (lime.x11:backend-save-session backend) nil) (error () t))
|
|
"explicit save needs authorization to replace rejected file")
|
|
(pump-for 1.0)
|
|
(stop)
|
|
(check (string= bad (uiop:read-file-string path)) "bad file not overwritten on autosave/exit")
|
|
(start)
|
|
(lime.x11:backend-save-session backend :replace-invalid-p t)
|
|
(check (not (getf (status) :blocked-p)) "explicit replacement re-enables persistence")
|
|
(stop))
|
|
;; Exercise the actual developer restart path, not just adapter calls.
|
|
(let ((session (lime.dev:start-development-session :display-name display-name :heads heads
|
|
:session-file path :start-repl-p nil :diagnostic-file nil)))
|
|
(unwind-protect
|
|
(progn
|
|
(lime.dev:with-development-backend (b session)
|
|
(lime.x11:backend-start-activity b "developer" "Developer")
|
|
(check (eq :success (xlib:grab-keyboard (lime.x11::x11-backend-root b)))
|
|
"install input grab before failed restart"))
|
|
(let ((original (symbol-function 'lime.persistence::%sync-path)))
|
|
(unwind-protect
|
|
(progn
|
|
(setf (symbol-function 'lime.persistence::%sync-path)
|
|
(lambda (p) (declare (ignore p)) (error "Injected pre-restart disk failure")))
|
|
(check (handler-case (progn (lime.dev:restart-development-session session) nil)
|
|
(error () t)) "restart refuses to discard an unsaved desk")
|
|
(check (lime.x11::x11-backend-display (lime.dev:development-session-backend session))
|
|
"failed pre-restart save keeps original X connection")
|
|
(check (eq :success (xlib:grab-keyboard root)) "failed restart releases old input grabs")
|
|
(xlib:ungrab-keyboard clients)
|
|
(xlib:display-finish-output clients))
|
|
(setf (symbol-function 'lime.persistence::%sync-path) original)))
|
|
(lime.dev:restart-development-session session)
|
|
(lime.dev:with-development-backend (b session)
|
|
(check (lime.core:find-activity (lime.x11:x11-backend-world b) "developer")
|
|
"developer restart persists world")))
|
|
(lime.dev:stop-development-session session)))
|
|
(format t "~&Live X11 persistence: ~D checks passed. Files: ~A~%" checks directory))))
|
|
(when backend (lime.x11:stop-backend backend :save-session-p nil))
|
|
(when clients (xlib:close-display clients))
|
|
(uiop:terminate-process server) (uiop:wait-process server)))
|
|
(error (c) (format *error-output* "~&Persistence smoke failed: ~A~%" c) (uiop:quit 1)))
|