;;;; 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)))