;;;; Fault injection against an owned Xvfb and a real supervised developer loop. ;;;; Does not connect to the user's DISPLAY, REPL, or application processes. (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-resilience-XXXXXX") :output :string)))) (log-path (merge-pathnames "fault.log" directory)) (server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp") :output :stream :error-output :interactive)) (session nil) (supervisor nil) (client-display nil) (checks 0) (supervisor-error nil) (original-configure (symbol-function 'lime.x11::%handle-configure-request)) (original-adopt (symbol-function 'lime.x11::icccm-adopt-client)) (original-shutdown-bars (symbol-function 'lime.x11::shutdown-head-bars)) (cleanup-count 0) (original-start (symbol-function 'lime.x11:start-lime))) (unwind-protect (let* ((number (parse-integer (read-line (uiop:process-info-output server)))) (display-name (format nil ":~D" number)) (port-socket (usocket:socket-listen "127.0.0.1" 0 :reuse-address t)) (port (usocket:get-local-port port-socket))) (usocket:socket-close port-socket) (setf client-display (xlib:open-default-display display-name)) (let* ((root (xlib:screen-root (xlib:display-default-screen client-display))) (windows (loop repeat 2 collect (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100))) (original-world nil) (view-id "keep-this")) (labels ((check (truth label) (assert truth () "Resilience: ~A" label) (incf checks)) (await (predicate label) (loop repeat 500 when (funcall predicate) return t do (sleep 0.01) finally (error "Timed out: ~A (supervisor: ~A; running: ~S; paused: ~S; event: ~S; fault: ~S)" label supervisor-error (and session (lime.dev::development-session-running-p session)) (and session (paused)) (and session (lime.x11::x11-backend-event-context (lime.dev:development-session-backend session))) (and session (lime.dev::development-session-event-loop-condition session))))) (owner (function) (lime.dev:call-in-development-session function :session session)) (paused () (lime.dev::development-session-paused-p session)) (status () (lime.dev:development-status session)) (repl-alive () (let ((socket (usocket:socket-connect "127.0.0.1" port :timeout 1))) (usocket:socket-close socket) t)) (client-exists (window) (find (xlib:window-id window) (xlib:query-tree root) :key #'xlib:window-id)) (new-window () (let ((window (xlib:create-window :parent root :x 0 :y 0 :width 80 :height 80))) (xlib:display-finish-output client-display) window)) (request-configure () (setf (xlib:drawable-width (first windows)) 321) (xlib:display-finish-output client-display)) (inject-failure () (setf (symbol-function 'lime.x11::%handle-configure-request) (lambda (&rest args) (declare (ignore args)) (error "Injected configure failure"))) (request-configure) (await #'paused "fault pauses event handling"))) (dolist (window windows) (xlib:map-window window)) (xlib:display-finish-output client-display) (setf supervisor (bt:make-thread (lambda () (handler-case (lime.dev:run-development-session :display-name display-name :head-discovery :none :session-file nil :event-timeout 0.01 :diagnostic-file log-path :repl-port port) (error (condition) (setf supervisor-error condition)))) :name "Owned resilience supervisor")) (await (lambda () lime.dev:*development-session*) "session startup") (setf session lime.dev:*development-session*) ;; Slynk installs debugger hooks; batch test failures must still ;; exit nonzero rather than falling into an EOF-driven REPL. #+sbcl (sb-ext:disable-debugger) (check (repl-alive) "private Slynk endpoint available") (owner (lambda (backend) (setf original-world (lime.x11:x11-backend-world backend)) (lime.x11:backend-save-view backend view-id "Keep this") (lime.x11:backend-activate-view backend view-id))) ;; BadWindow may arrive BEFORE DestroyNotify has retired the client. (let ((window (new-window))) (owner (lambda (backend) (let* ((display (lime.x11::x11-backend-display backend)) (managed (xlib::lookup-window display (xlib:window-id window)))) (lime.x11:manage-window backend managed) (xlib:display-finish-output display) (xlib:destroy-window window) (xlib:display-finish-output client-display) (setf (xlib:drawable-x managed) 17) (xlib:display-finish-output display)))) (check (not (paused)) "async destroyed-client configure is harmless")) ;; A query on a vanished, unregistered client must unwind, not hang. (let ((window (new-window))) (xlib:destroy-window window) (xlib:display-finish-output client-display) (let ((before (lime.x11::x11-backend-expected-x-error-count (lime.dev:development-session-backend session)))) (owner (lambda (backend) (let ((display (lime.x11::x11-backend-display backend))) (xlib:queue-event display :map-request :append-p t :parent (lime.x11::x11-backend-root backend) :window (xlib::lookup-window display (xlib:window-id window)))))) (await (lambda () (> (lime.x11::x11-backend-expected-x-error-count (lime.dev:development-session-backend session)) before)) "stale MapRequest processed")) (check (not (paused)) "stale MapRequest survives synchronous BadWindow")) ;; Mid-adoption death: registered in the adapter, not yet in the core. (let ((window (new-window)) (destroyed-p nil)) (setf (symbol-function 'lime.x11::icccm-adopt-client) (lambda (backend client-id managed) (when (= (xlib:window-id managed) (xlib:window-id window)) (xlib:destroy-window window) (xlib:display-finish-output client-display) (setf destroyed-p t)) (funcall original-adopt backend client-id managed))) (xlib:map-window window) (xlib:display-finish-output client-display) ;; Do not concurrently query the client connection while the ;; injected owner-thread hook is using that same CLX display. (await (lambda () destroyed-p) "adoption victim gone") (owner (lambda (backend) (check (lime.core:validate-world (lime.x11:x11-backend-world backend)) "partial adoption does not corrupt core"))) (setf (symbol-function 'lime.x11::icccm-adopt-client) original-adopt) (check (not (paused)) "mid-adoption death is harmless")) ;; Focus of an existing but unmapped window produces real BadMatch. (let ((window (new-window))) (owner (lambda (backend) (let ((display (lime.x11::x11-backend-display backend))) (xlib:set-input-focus display (xlib::lookup-window display (xlib:window-id window)) :pointer-root) (xlib:display-finish-output display)))) (xlib:destroy-window window) (xlib:display-finish-output client-display) (check (not (paused)) "unviewable focus is harmless")) (check (>= (getf (getf (getf (status) :backend-status) :diagnostics) :expected-x-errors) 4) "expected races are counted") ;; Root ownership conflicts must remain fatal to the attempted WM. (check (handler-case (progn (lime.x11:start-backend :display-name display-name :head-discovery :none) nil) (xlib:access-error () t)) "second WM cannot silently claim root") (check (not (paused)) "original WM unaffected by second WM") ;; Leave active grabs installed, then fail a real event handler. (owner (lambda (backend) (let ((wm-root (lime.x11::x11-backend-root backend))) (check (eq :success (xlib:grab-keyboard wm-root)) "test keyboard grab") (check (eq :success (xlib:grab-pointer wm-root '(:button-press :button-release))) "test pointer grab") (xlib:display-finish-output (lime.x11::x11-backend-display backend))))) (inject-failure) (let* ((snapshot (status)) (report (getf snapshot :last-error-report))) (check (getf snapshot :running-p) "control session remains running") (check (getf snapshot :event-thread-alive-p) "owner thread services paused mailbox") (check (eq :configure-request (getf (getf report :event) :kind)) "diagnostic has event context") (check (search "Injected configure failure" (getf report :message)) "diagnostic has original failure") (check (search "%DISPATCH-NEXT-EVENT" (getf report :backtrace)) "backtrace captured before unwind") (check (probe-file log-path) "fault diagnostic written") (check (search "Injected configure failure" (uiop:read-file-string log-path)) "fault survives in log") (check (string= "600" (string-trim '(#\Newline) (uiop:run-program (list "stat" "-c" "%a" (namestring log-path)) :output :string))) "log is private") (check (bt:thread-alive-p supervisor) "supervisor did not exit after event fault") (check (repl-alive) "Slynk still accepts connections")) (check (eq :success (xlib:grab-keyboard root)) "fault released keyboard grab") (xlib:ungrab-keyboard client-display) (check (eq :success (xlib:grab-pointer root '(:button-press))) "fault released pointer grab") (xlib:ungrab-pointer client-display) (xlib:display-finish-output client-display) (check (every #'client-exists windows) "application windows survive pause") ;; Deliberately invalid model: recovery must refuse, not reset it. (let ((presentation nil) (old-focus nil)) (owner (lambda (backend) (setf presentation (lime.core:current-presentation (lime.x11:x11-backend-world backend) (lime.x11:x11-backend-focused-head-id backend)) old-focus (lime.core:presentation-focus-client-id presentation) (lime.core:presentation-focus-client-id presentation) "missing-client"))) (check (handler-case (progn (lime.dev:resume-development-session session) nil) (error () t)) "invalid model blocks resume") (check (paused) "failed resume stays paused") (owner (lambda (backend) (declare (ignore backend)) (setf (lime.core:presentation-focus-client-id presentation) old-focus)))) ;; A core-valid but partially lost adapter mapping is not safe either. (let ((id nil) (managed nil)) (owner (lambda (backend) (setf id (lime.x11::%backend-client-id backend (first windows)) managed (gethash id (lime.x11::x11-backend-client-windows backend))) (remhash id (lime.x11::x11-backend-client-windows backend)))) (check (handler-case (progn (lime.dev:resume-development-session session) nil) (error () t)) "inconsistent adapter registration blocks resume") (check (paused) "adapter validation failure stays paused") (owner (lambda (backend) (setf (gethash id (lime.x11::x11-backend-client-windows backend)) managed)))) (setf (symbol-function 'lime.x11::%handle-configure-request) original-configure) (lime.dev:resume-development-session session) (check (not (paused)) "explicit resume succeeds after repair") (owner (lambda (backend) (check (eq original-world (lime.x11:x11-backend-world backend)) "resume keeps same world") (check (lime.core:find-view original-world view-id) "resume keeps saved checkpoint") (check (lime.core:validate-world original-world) "resumed world valid"))) ;; A surviving client whose adoption was interrupted can be finished ;; deliberately on resume, without replaying unrelated events. (let ((window (new-window))) (setf (symbol-function 'lime.x11::icccm-adopt-client) (lambda (backend id managed) (funcall original-adopt backend id managed) (when (= (xlib:window-id managed) (xlib:window-id window)) (error "Injected partial adoption failure")))) (xlib:map-window window) (xlib:display-finish-output client-display) (await #'paused "interrupted live adoption pauses") (setf (symbol-function 'lime.x11::icccm-adopt-client) original-adopt) (lime.dev:resume-development-session session) (owner (lambda (backend) (check (lime.core:find-client original-world (lime.x11::%backend-client-id backend window)) "resume finishes the interrupted adoption") (check (lime.x11::%validate-client-registrations backend) "repaired adoption has consistent registrations"))) (xlib:destroy-window window) (xlib:display-finish-output client-display) (await (lambda () (owner (lambda (backend) (null (lime.x11::%backend-client-id backend window))))) "recovered client retires normally")) ;; Logging itself must never cause the session to exit. (owner (lambda (backend) (declare (ignore backend)) (setf (lime.dev::development-session-diagnostic-file session) (merge-pathnames "fault.log/impossible" directory)))) (inject-failure) (check (getf (status) :diagnostic-write-error) "log write failure remains inspectable") (check (repl-alive) "failed log write does not take down control server") (setf (symbol-function 'lime.x11::%handle-configure-request) original-configure) (owner (lambda (backend) (declare (ignore backend)) (setf (lime.dev::development-session-diagnostic-file session) log-path))) (lime.dev:resume-development-session session) ;; A slow failing restart lasts longer than the xinit supervisor poll. (setf (symbol-function 'lime.x11:start-lime) (lambda (&rest args) (declare (ignore args)) (sleep 1.2) (error "Injected restart failure"))) (check (handler-case (progn (lime.dev:restart-development-session session) nil) (error () t)) "restart failure is reported to caller") (check (bt:thread-alive-p supervisor) "slow failed restart retains xinit supervisor") (check (paused) "failed restart leaves paused control session") (check (repl-alive) "failed restart retains same Slynk endpoint") (check (every #'client-exists windows) "applications survive failed restart") (setf (symbol-function 'lime.x11:start-lime) original-start) (lime.dev:restart-development-session session) (check (not (paused)) "explicit retry can restart") (check (repl-alive) "successful restart retains Slynk") (owner (lambda (backend) (check (not (eq original-world (lime.x11:x11-backend-world backend))) "restart honestly makes a new world") (check (= 2 (hash-table-count (lime.x11::x11-backend-client-windows backend))) "restart readopts surviving clients"))) ;; A deliberate quit still exits the supervisor, even while paused. (inject-failure) ;; A failed UI cleanup must not skip client restoration or CLX close. (setf (symbol-function 'lime.x11::shutdown-head-bars) (lambda (backend) (declare (ignore backend)) (incf cleanup-count) ;; Let the supervisor notice quit while a second caller ;; is already stopping. Cleanup must not run concurrently. (sleep 1.2) (error "Injected bar cleanup failure"))) (owner #'lime.x11:backend-request-quit) (lime.dev:stop-development-session session) (await (lambda () (not (bt:thread-alive-p supervisor))) "intentional quit exits supervisor") (bt:join-thread supervisor) (check (null supervisor-error) "supervisor returned normally") (check (null lime.dev:*development-session*) "intentional quit clears current session") (check (every #'client-exists windows) "graceful stop did not destroy client windows") (check (= 1 cleanup-count) "concurrent explicit/supervised stop cleans up only once") (check (null (lime.x11::x11-backend-display (lime.dev:development-session-backend session))) "failed bar cleanup still closes CLX") (check (find :cleanup (getf (lime.x11:backend-diagnostics (lime.dev:development-session-backend session)) :reports) :key (lambda (report) (getf report :source))) "cleanup failure retained in diagnostics") (format t "~&Live X11 resilience: ~D checks passed. Diagnostics: ~A~%" checks directory)))) (setf (symbol-function 'lime.x11::%handle-configure-request) original-configure (symbol-function 'lime.x11::icccm-adopt-client) original-adopt (symbol-function 'lime.x11::shutdown-head-bars) original-shutdown-bars (symbol-function 'lime.x11:start-lime) original-start) (when lime.dev:*development-session* (lime.dev:stop-development-session)) (when supervisor (bt:join-thread supervisor)) (when client-display (xlib:close-display client-display)) (uiop:terminate-process server) (uiop:wait-process server))) (error (condition) (format *error-output* "~&Resilience smoke failed: ~A~%" condition) (uiop:quit 1)))