;;;; Guarded function-only upgrade: preserve every live model object and XID. (in-package #:cl-user) (declaim (special lime.x11::*backend-activity-navigation-states*)) (defun lime-portable-definitions () (let ((manifest '((:lime.core "src/membership.lisp" "%MOVE-CLIENT-MEMBERSHIP" "MOVE-CLIENT-TO-ACTIVITY") (:lime.x11 "src/x11/navigation.lisp" "%FORGET-NAVIGATION-STATE" "BACKEND-PREFLIGHT-ACTIVITY-SWITCH" "BACKEND-SWITCH-TO-ACTIVITY") (:lime.x11 "src/x11/commands.lisp" "BACKEND-MOVE-CLIENT-TO-ACTIVITY" "BACKEND-ACTIVATE-ACTIVITY" "BACKEND-PREFLIGHT-ACTIVITY-ACTIVATION" "BACKEND-PREFLIGHT-VIEW-ACTIVATION" "BACKEND-ACTIVATE-VIEW") (:lime.x11 "src/x11/ui.lisp" "%UI-ACTIVITY-CANDIDATES" "%UI-MOVE-CLIENT-RESULT" "%UI-REQUEST-ACTIVITY-ACTIVATION" "%COMMAND-PALETTE-CANDIDATES" "%UI-KEY-PATH") (:lime.x11 "src/x11/persistence.lisp" "%VALIDATE-SESSION-ENVELOPE" "%PREPARE-SESSION-PERSISTENCE" "%SESSION-SIGNATURE" "%SESSION-SNAPSHOT"))) (definitions nil) (*read-eval* nil)) (dolist (entry manifest) (destructuring-bind (package file &rest names) entry (let* ((*package* (find-package package)) (symbols (mapcar (lambda (name) (intern name *package*)) names)) (found nil)) (with-open-file (in (merge-pathnames file #p"/home/adan/code/common-lisp/lime/")) (loop for form = (read in nil :eof) until (eq form :eof) when (and (consp form) (eq (first form) 'defun) (member (second form) symbols)) do (push form found))) (assert (= (length symbols) (length found))) (dolist (symbol symbols) (assert (find symbol found :key #'second))) (setf definitions (append definitions (mapcar (lambda (symbol) (find symbol found :key #'second)) symbols)))))) definitions)) (defun lime-upgrade-live-portable-activities () (unless (= 1578331 (slynk-backend:getpid)) (error "Unexpected Lime process.")) (lime.dev:with-development-backend (backend) (unless (and (lime.dev::development-session-running-p lime.dev:*development-session*) (not (lime.dev::development-session-paused-p lime.dev:*development-session*))) (error "Lime is not running normally.")) (when (or (lime.x11::x11-backend-pointer-drag backend) (lime.x11::x11-backend-ui-session backend)) (error "Close the menu or finish the drag before upgrading.")) (when (and (boundp 'lime.x11::*backend-activity-navigation-states*) (gethash backend lime.x11::*backend-activity-navigation-states*)) (error "Portable navigation is already installed; do not repeat this migration.")) (let* ((world (lime.x11:x11-backend-world backend)) (before (lime.persistence:snapshot-world world)) (head (lime.x11:x11-backend-focused-head-id backend)) (display (lime.x11::x11-backend-display backend)) (focus (xlib:input-focus display)) (config (lime.x11::x11-backend-configuration backend)) (bindings (lime.x11:list-keybindings backend)) (leases (loop for id being the hash-keys of (lime.core::world-leases world) using (hash-value lease) collect (cons id lease))) (session (lime.x11:backend-save-session backend :wait-p t)) (old-data (lime.x11::%session-snapshot backend)) (backup-directory (uiop:ensure-directory-pathname (string-trim '(#\Newline) (uiop:run-program '("mktemp" "-d" "/home/adan/.local/state/lime/pre-portable-XXXXXX") :output :string)))) (backup-file (merge-pathnames "session-v2.sexp" backup-directory))) ;; The owner thread cannot autosave a newer snapshot during this block. ;; Waiting above drains the writer before making this private backup. (assert (= 2 (getf old-data :version))) (uiop:copy-file (getf session :file) backup-file) (uiop:run-program (list "chmod" "600" (namestring backup-file))) (export (mapcar (lambda (name) (intern name :lime.core)) '("ACTIVITY-PRESENTATIONS" "PREFLIGHT-PRESENTATION-BRING" "BRING-PRESENTATION-TO-HEAD")) :lime.core) (export (mapcar (lambda (name) (intern name :lime.x11)) '("BACKEND-ACTIVITY-NAVIGATION-MODE" "BACKEND-EXTEND-ACTIVITY-TO-HEAD" "BACKEND-MAKE-ACTIVITY-PORTABLE")) :lime.x11) (let* ((definitions (lime-portable-definitions)) (old-functions (mapcar (lambda (form) (cons (second form) (fdefinition (second form)))) definitions)) (copy-checks 0) (policies nil)) (handler-case (progn ;; New modules only: no existing DEFSTRUCT layout is redefined. (dolist (file '("src/presentation-navigation.lisp" "src/x11/activity-navigation.lisp" "src/x11/activity-navigation-ui.lisp")) (load (merge-pathnames file #p"/home/adan/code/common-lisp/lime/"))) (dolist (definition definitions) (eval definition)) ;; Test migration and actual bring/swap transitions on a detached ;; copy of this user's exact saved world before enabling policy. (multiple-value-bind (candidate navigation footprint) (lime.x11::%validate-session-envelope old-data) (declare (ignore navigation)) (assert (equalp before (lime.persistence:snapshot-world candidate))) (setf policies (copy-tree (lime.x11::activity-navigation-state-rows footprint))) (dolist (row policies) (when (and (eq :portable (second row)) (third row)) (dolist (destination (lime.x11:backend-head-ids backend)) (lime.core::bring-presentation-to-head candidate (third row) destination) (assert (lime.core:validate-world candidate)) (incf copy-checks))))) ;; Hash-table iteration order need not survive snapshot/restore. (let ((live-policies (lime.x11::%activity-navigation-snapshot backend))) (assert (= (length policies) (length live-policies))) (dolist (row policies) (assert (equal row (assoc (first row) live-policies :test #'equal))))) (assert (equalp before (lime.persistence:snapshot-world world))) (assert (equal head (lime.x11:x11-backend-focused-head-id backend))) (let ((after-focus (xlib:input-focus display))) (assert (or (eql focus after-focus) (and (typep focus 'xlib:window) (typep after-focus 'xlib:window) (xlib:window-equal focus after-focus))))) (assert (eq config (lime.x11::x11-backend-configuration backend))) (assert (equal bindings (lime.x11:list-keybindings backend))) (assert (= (length leases) (hash-table-count (lime.core::world-leases world)))) (dolist (entry leases) (assert (eq (cdr entry) (lime.core:lease-for-client world (car entry))))) (assert (= 3 (getf (lime.x11::%session-snapshot backend) :version)))) (error (condition) (dolist (entry old-functions) (setf (fdefinition (car entry)) (cdr entry))) (when (boundp 'lime.x11::*backend-activity-navigation-states*) (remhash backend lime.x11::*backend-activity-navigation-states*)) (error "Portable upgrade rolled back; backup ~A. ~A" backup-file condition))) ;; The code/model transaction has committed; a disk failure here must ;; keep the new running code, whose normal autosave retry can recover. (let ((save (handler-case (lime.x11:backend-save-session backend :wait-p t) (error (c) (list :error (princ-to-string c)))))) (list :upgraded t :functions (length definitions) :backup (namestring backup-file) :world-unchanged t :focus-unchanged t :bindings-unchanged t :lease-objects-unchanged t :migration-copy-swaps-tested copy-checks :policies (mapcar (lambda (row) (subseq row 0 2)) policies) :session-save save))))))