diff --git a/README.md b/README.md index b990a2f9..0e189e7b 100644 --- a/README.md +++ b/README.md @@ -290,7 +290,16 @@ The environment also allows administrator overrides. Using the `:static` and `:t See `environment-change`, `environment`, `environment-directory`, `environment-module-directory`, `environment-module-pathname`, `check-environment`, `mconfig-pathname`, `mconfig-storage`, `mconfig`, `defaulted-mconfig`, `config`, `defaulted-config`, `template-file`, `@template`, `static-file`, `@static` -### 1.12 Instance Management +### 1.12 Migration System +Sometimes systems evolve in backwards incompatible ways. In that case, for existing setups to continue functioning with the new version, runtime data migration is necessary. Radiance offers a system to automate this process and allow a smooth upgrade. + +The migration between versions should occur automatically during Radiance's startup sequence. As an administrator or author you should not need to perform any additional steps for migrations to occur. However, as a module author, you will naturally have to provide the code to perform the necessary data migration steps for your module. + +In order for a module to be migratable, it needs to be loaded by an ASDF system that has a version specification. The version should follow the standard dotted number scheme, with an optional version hash that can be added at the end. You may then define migration steps between individual versions by using `define-version-migration`. Once defined, Radiance will automatically pick up on concrete versions and perform the necessary migrations in sequence to reach the current target version. For more information on the precise procedure and what you can do, see `migrate` and `migrate-versions`. + +See `last-known-system-version`, `migrate-versions`, `define-version-migration`, `ready-dependency-for-migration`, `ensure-dependencies-ready`, `versions`, `migrate` + +### 1.13 Instance Management Finally, Radiance provides a standard startup and shutdown sequence that should ensure things are properly setup and readied, and afterwards cleaned up nicely again. A large part of that sequence is just ensuring that certain hooks are called in the proper order and at the appropriate times. While you can start a server manually by using the appropriate interface function, you should not expect applications to run properly if you do it that way. Many of them will expect certain hooks to be called in order to work properly. This is why you should always, unless you exactly know what you're doing, use `startup` and `shutdown` to manage a Radiance instance. The documentation of the two functions should explain exactly which hooks are triggered and in which order. An implementation may provide additional, unspecified definitions on symbols in the interface package, as long as said symbols are not exported. diff --git a/conditions.lisp b/conditions.lisp index 2b5ad1b7..1a7c60e9 100644 --- a/conditions.lisp +++ b/conditions.lisp @@ -23,6 +23,17 @@ This definition may lead to unintended overrides.~@[~%~a~]" (message c))))) +(define-condition system-has-no-version (radiance-error) + ((system :initarg :system :initform (error "SYSTEM required."))) + (:report (lambda (c s) (format s "The system ~a has no version specified, so Radiance does not know how to migrate it to the latest point." + (asdf:component-name (slot-value c 'system)))))) + +(define-condition backwards-migration-not-allowed (radiance-error) + ((from :initarg :from :initform (error "FROM required.")) + (to :initarg :to :initform (error "TO required."))) + (:report (lambda (c s) (format s "Cannot migrate a system backwards from ~a to ~a." + (encode-version (slot-value c 'from)) (encode-version (slot-value c 'to)))))) + (define-condition environment-not-set (radiance-error) () (:report "The application environment was not yet set but is required. This means you are either using Radiance for the first time or forgot to set it up properly. diff --git a/defaults.lisp b/defaults.lisp index 2ff64947..e943bb5a 100644 --- a/defaults.lisp +++ b/defaults.lisp @@ -228,3 +228,29 @@ (T ;; Other refer, no change. )))))) + +;;; Default logger to make sure we can log even before the real impl is loaded. +(defun l:log (level category log-string &rest format-args) + (format *error-output* "~&~a [~a] <~a> ~?~%" + (format-human-date (get-universal-time)) level category log-string format-args)) + +(defun l:trace (category log-string &rest format-args) + (declare (ignore category log-string format-args))) + +(defun l:debug (category log-string &rest format-args) + (declare (ignore category log-string format-args))) + +(defun l:info (category log-string &rest format-args) + (apply #'l:log :info category log-string format-args)) + +(defun l:warn (category log-string &rest format-args) + (apply #'l:log :warn category log-string format-args)) + +(defun l:error (category log-string &rest format-args) + (apply #'l:log :error category log-string format-args)) + +(defun l:severe (category log-string &rest format-args) + (apply #'l:log :severe category log-string format-args)) + +(defun l:fatal (category log-string &rest format-args) + (apply #'l:log :fatal category log-string format-args)) diff --git a/documentation.lisp b/documentation.lisp index c9649f69..3a6cb28e 100644 --- a/documentation.lisp +++ b/documentation.lisp @@ -283,6 +283,24 @@ systems. See RADIANCE-WARNING") + (type system-has-no-version + "Error signalled when an ASDF system does not store a version string. + +Without a version string, Radiance is incapable of tracking what the +current version of a system is and is thus unable to automatically +migrate it. + +This error should be continuable. + +See MIGRATE +See RADIANCE-ERROR") + + (type backwards-migration-not-allowed + "Error signalled when a migration from a later version to an earlier version is attempted. + +See MIGRATE +See RADIANCE-ERROR") + (type environment-not-set "Error signalled when an action was performed that requires an initialised environment, but no environment has been configured yet. @@ -1257,6 +1275,289 @@ information until later. See DEFINE-INTERFACE")) +;; migration.lisp +(docs:define-docs + (function encode-version + "Encodes the given version into a version name as a keyword. + +Each part of the version spec is concatenated as follows: + VERSION-NAME ::= (string|integer) (VERSION-STRING | VERSION-INTEGER)* + VERSION-STRING ::= '-' string + VERSION-INTEGER ::= '.' integer + +Essentially meaning that integer sub-versions are preceded by a +dot and string sub-versions by a dash.") + + (function parse-version + "Parses the given string into a version spec. + +The string should be of the following format: + VERSION-NAME ::= VERSION-PART (('.' | '-') VERSION-PART)+ + VERSION-PART ::= integer | string + +See ENSURE-PARSED-VERSION") + + (function ensure-parsed-version + "Ensures that the given version is in the version spec format. + +Returns a version spec: + VERSION-SPEC ::= (VERSION-PART+) + VERSION-PART ::= integer | string + +See PARSE-VERSION") + + (function ensure-versions-comparable + "Ensures the two versions are of the same length. + +If one of the versions is shorter, it is extended by 0 elements +in its spec. Both of the versions are returned, with the specs +having equal length. + +See ENSURE-PARSED-VERSION") + + (function version-part= + "Returns T if the two version parts are considered equal. + +The following table should cover all cases: + ↓A B→ INTEGER STRING +INTEGER = NIL +STRING NIL STRING=") + + (function version-part< + "Returns T if the first version part is considered lower. + +The following table should cover all the cases: + ↓A B→ INTEGER STRING +INTEGER < T +STRING NIL STRING<") + + (function version= + "Returns T if the two version specs are considered equal. + +First ensures both versions are of equal length, then calls +VERSION-PART= on each part of the versions. If they are all +VERSION-PART=, then T is returned and NIL otherwise. + +A special exemption is made for NIL version specs. If both +versions are NIL, T is returned. Otherwise, if only one spec is +NIL, NIL is returned. + +See ENSURE-VERSIONS-COMPARABLE +See VERSION-PART=") + + (function version< + "Returns T if the first version is considered lower. + +First ensures both versions are of equal length, then calls +VERSION-PART= on each part of the versions. If it returns NIL, +then VERSION-PART< is called. If this returns T, T is returned, +otherwise NIL is returned. If all parts are VERSION-PART=, NIL is +returned. + +A special exemption is made for NIL version specs. If both +versions are NIL, NIL is returned. Otherwise, if the first spec +is NIL, T is returned. If the second spec is NIL, NIL is returned. + +See ENSURE-VERSIONS-COMPARABLE +See VERSION-PART= +See VERSION-PART<") + + (function version<= + "Returns T if the first version is considered lower. + +First ensures both versions are of equal length, then calls +VERSION-PART= on each part of the versions. If it returns NIL, +then VERSION-PART< is called. If this returns T, T is returned, +otherwise NIL is returned. If all parts are VERSION-PART=, T is +returned. + +A special exemption is made for NIL version specs. If both +versions are NIL, T is returned. Otherwise, if the first spec +is NIL, T is returned. If the second spec is NIL, NIL is returned. + +See ENSURE-VERSIONS-COMPARABLE +See VERSION-PART= +See VERSION-PART<") + + (function version-region + "Returns the versions in VERSIONS that are between START and END, inclusive. + +For instance, the version list '(1 2 4 5 6) for the bounds 3 and 6 +would return '(4 5 6). + +The list of versions is assumed to be sorted by VERSION<. + +See VERSION<=") + + (function version-bounds + "Returns the versions in VERSIONS that are between START and END, inclusive, ensuring the sequence starts with START and ends with END, if provided. + +For instance, the version list '(1 2 4 5 6) for the bounds 3 and 6 +would return '(3 4 5 6). + +The list of versions is assumed to be sorted by VERSION<. + +See VERSION-REGION") + + (function last-known-system-version + "Return the last known version of this system that had been migrated to. + +Returns the version as an encoded keyword or NIL if the system +has not seen a migration previously. This version is automatically +adapted after MIGRATE-VERSIONS on the system completes +successfully. + +See MIGRATE-VERSIONS") + + (function migrate-versions + "Perform a migration of the system from the given source version to the given target version. + +If a system or module requires manual intervention to upgrade +data or other parts in order to move between versions, the author +of the system should specialise a method on this function that +performs the requested upgrade step. + +FROM and TO should be encoded versions in keyword form. FROM can +also be the NIL symbol, which is useful to migrate from previously +unknown versions to another. + +Note that the version steps between migrate-version methods on the +same system should be contiguous. This means that if a system has +the concrete versions 1, 2, 3, and 4, then there should be methods +(if necessary) to upgrade from 1 to 2, from 2 to 3, from 3 to 4. +Migration steps with gaps, such as from 2 to 4, will not be +triggered by the system. + +Also note that by default the list of concrete versions a system +offers are inferred from the methods defined on this function. +There is no need to further inform the system on available +concrete versions of a system. + +A default method that performs no action is provided on this +function, as in the majority of cases no migration step is +required. As such, methods need only be added to this function if +an action is required. + +Before the primary method is executed, ENSURE-DEPENDENCIES-READY +is called on the system and the source version. This should +ensure that dependant systems are on a required version for this +system to perform its own actions. + +After the primary method has completed, the target version is +recorded as the last known concrete system version. + +The user should NOT call this function. It is called by MIGRATE +as appropriate. + +See DEFINE-VERSION-MIGRATION +See VERSIONS +See MIGRATE +See ENSURE-DEPENDENCIES-READY +See LAST-KNOWN-SYSTEM-VERSION") + + (function define-version-migration + "A shorthand to define a version migration method for a system. + +SYSTEM may be a string or symbol naming the ASDF system to define +a migration action for. FROM may be NIL, a symbol, or a string +naming the source version. TO may be a symbol or a string naming +the target version. + +BODY should be a number of forms to be executed when the system +is moved from the source version to the target version. + +See MIGRATE-VERSIONS") + + (function ready-dependency-for-migration + "This function should ensure that the dependency conforms to the system's required state to migrate away from the given version. + +By default this will invoke MIGRATE on the dependency with both +source and from versions being T. + +The user should supply methods on this function to customise the +precise versions or features required to perform the migration of +the system properly. + +See MIGRATE") + + (function ensure-dependencies-ready + "This function should ensure that all dependencies of the given system are ready for the system to perform a migration away from the given version. + +By default this will call READY-DEPENDENCY-FOR-MIGRATION on all +systems that are recorded in the system's defsystem-dependencies +and regular dependencies, AND are virtual-module systems. + +The user should supply methods on this function in case it is +necessary to perform actions on other systems for the migration +to perform smoothly. + +See READY-DEPENDENCY-FOR-MIGRATION +See ASDF:SYSTEM-DEFSYSTEM-DEPENDS-ON +See ASDF:SYSTEM-DEPENDS-ON") + + (function versions + "Returns a list of concrete version designators that are known for the given system. + +This list is deduplicated and sorted in such a way that lower +versions come earlier in the list. + +By default this list is computed by inspecting the list of primary +methods on MIGRATE-VERSION, extracting the version specifiers, and +subsequently deduplicating and sorting the resulting list. + +The user may supply methods on this function in case the +automatically computed list of versions is inadequate somehow. + +See VERSION< +See MIGRATE +See MIGRATE-VERSIONS") + + (function migrate + "Migrates the given system between the given versions. + +Sometimes when versions change, a migration of runtime data is +required to ensure that the system still operates correctly on +existing data. + +This function should ensure that this compatibility is achieved. + +The system should be a designator for an ASDF system. + +FROM may be one of the following: + T --- The system is migrated from its last known version. + NIL --- The system is migrated from a time before migrations. + version --- The system is migrated from this specific version. + +TO may be one of the following: + T --- The system is migrated to its current system version. + version --- The system is migrated to this specific version. + +When this function is called it determines the list of concrete +versions in the range of the specified FROM and TO versions. +It then calls MIGRATE-VERSION on the system and each pair of +versions in the computed range. For instance, if the list of +versions is (1 2 3 4), then MIGRATE-VERSION is called with the +pairs (1 2) (2 3) (3 4). + +If the target version is T and the system has no recorded version, +an error of type SYSTEM-HAS-NO-VERSION is signalled. If the target +version is considered less than the source version, an error of +type BACKWARDS-MIGRATION-NOT-ALLOWED is signalled. + +Two restarts are established during migration: + ABORT --- Aborts migration of the current system, + leaving the last known system version the + same. + FORCE-VERSION --- Aborts the migration of the current system, + but forces the last known system version to + the requested target version. + +See ENSURE-PARSED-VERSION +See VERSIONS +See MIGRATE-VERSION +See SYSTEM-HAS-NO-VERSION +See BACKWARDS-MIGRATION-NOT-ALLOWED")) + ;; modules.lisp (docs:define-docs (function module-domain diff --git a/init.lisp b/init.lisp index 967aac32..558535ac 100644 --- a/init.lisp +++ b/init.lisp @@ -17,9 +17,11 @@ (defun startup (&optional (environment (or *environment* "default"))) (check-type environment string) - (when *running* (error "Radiance is already running!")) + + ;; Migrate Radiance on its own if necessary. + (migrate 'radiance-core T T) (setf *startup-time* (get-universal-time)) (setf (environment) environment) @@ -28,17 +30,23 @@ (setf *debugger* (config :debugger))) (unless (implementation 'logger) - (load-implementation 'logger)) + (migrate (load-implementation 'logger) T T)) (trigger 'startup) (l:info :radiance "Starting up.") (l:info :radiance "Ensuring prerequisites.") (unless (implementation 'server) - (load-implementation 'server)) + (migrate (load-implementation 'server) T T)) (l:info :radiance "Starting server.") (trigger 'server-start) + + (l:info :radiance "Migrating already loaded systems.") + (dolist (system (asdf:already-loaded-systems)) + (when (typep system 'virtual-module) + (migrate system T T))) + (setf *running* T) (trigger 'server-ready) diff --git a/interface-components.lisp b/interface-components.lisp index aa73e2a9..76e15f1e 100644 --- a/interface-components.lisp +++ b/interface-components.lisp @@ -19,10 +19,11 @@ (define-hook-switch ,on ,off ,args)))) (define-component-expander define-resource-locator (interface type args) - `(define-resource-locator ,(package-name interface) ,type ,args - (declare (ignore ,@(lambda-fiddle:extract-lambda-vars args))) - (error "Resource locator ~a not implemented for interface ~a!" - ,(string-upcase type) ,(package-name interface)))) + `(unless (modularize-interfaces:implementation ,interface) + (define-resource-locator ,(package-name interface) ,type ,args + (declare (ignore ,@(lambda-fiddle:extract-lambda-vars args))) + (error "Resource locator ~a not implemented for interface ~a!" + ,(string-upcase type) ,(package-name interface))))) (define-component-expander define-option-type (interface name) `',(or (find-symbol (string name) interface) diff --git a/interfaces.lisp b/interfaces.lisp index c3caccf1..985438ca 100644 --- a/interfaces.lisp +++ b/interfaces.lisp @@ -27,7 +27,7 @@ (if (find-symbol "RESOLVE-DEPENDENCY-COMBINATION" :asdf) (eval - `(defmethod ,(find-symbol "RESOLVE-DEPENDENCY-COMBINATION" :asdf) ((virtual-module virtual-module) (combinator (eql :interface)) args) + `(defmethod ,(find-symbol "RESOLVE-DEPENDENCY-COMBINATION" :asdf) (system (combinator (eql :interface)) args) (find-implementation (first args)))) (error "Radiance cannot support this version of ASDF. Sorry!")) @@ -40,6 +40,10 @@ (funcall ,symbol ,@args))))) (defmethod asdf:perform :after ((op asdf:load-op) (virtual-module virtual-module)) + ;; Trigger potential migrations if we're already started up. + (when *running* + (migrate virtual-module T T)) + ;; Register implementations (loop for interface in (module-storage (module (virtual-module-name virtual-module)) :implements) do (trigger (find-symbol (string :implemented) (interface interface))) (future l debug :interfaces "~a now implemented by ~a" (module-name interface) (module-name (virtual-module-name virtual-module))))) @@ -89,7 +93,8 @@ #-quicklisp (asdf:load-system implementation) #+:quicklisp - (ql:quickload implementation))))))) + (ql:quickload implementation)) + implementation))))) (defmacro define-interface (name &body components) `(interfaces:define-interface ,name diff --git a/migration.lisp b/migration.lisp new file mode 100644 index 00000000..ec527253 --- /dev/null +++ b/migration.lisp @@ -0,0 +1,207 @@ +#| + This file is a part of Radiance + (c) 2016 Shirakumo http://tymoon.eu (shinmera@tymoon.eu) + Author: Nicolas Hafner +|# + +(in-package #:org.shirakumo.radiance.core) + +(defun encode-version (version) + (etypecase version + (null NIL) + (keyword version) + (string (intern version :KEYWORD)) + (cons (encode-version + (with-output-to-string (out) + (princ (first version) out) + (dolist (part (rest version)) + (etypecase part + (integer (format out ".~d" part)) + (string (format out "-~:@(~a~)" part))))))))) + +(defun parse-version (version) + (loop for part in (cl-ppcre:split "[.-]" version) + collect (or (ignore-errors (parse-integer part)) + part))) + +(defun ensure-parsed-version (version) + (etypecase version + (null NIL) + (cons version) + ((or string keyword) + (parse-version (string version))))) + +(defun ensure-versions-comparable (a b) + (let* ((a (ensure-parsed-version a)) + (b (ensure-parsed-version b)) + (al (length a)) + (bl (length b))) + (cond ((< al bl) + (values (append a (make-list (- bl al) :initial-element 0)) + b)) + ((< bl al) + (values a + (append b (make-list (- al bl) :initial-element 0)))) + (T + (values a b))))) + +(defmethod version-part= ((a integer) (b integer)) (= a b)) +(defmethod version-part= ((a integer) (b string)) NIL) +(defmethod version-part= ((a string) (b integer)) NIL) +(defmethod version-part= ((a string) (b string)) (string= a b)) +(defmethod version-part< ((a integer) (b integer)) (< a b)) +(defmethod version-part< ((a integer) (b string)) T) +(defmethod version-part< ((a string) (b integer)) NIL) +(defmethod version-part< ((a string) (b string)) (string< a b)) + +(defun version= (a b) + (cond ((eql a b) T) + ((or (null a) (null b)) NIL) + (T (multiple-value-bind (a-parts b-parts) (ensure-versions-comparable a b) + (loop for a in a-parts + for b in b-parts + always (version-part= a b)))))) + +(defun version< (a b) + (cond ((eql a b) NIL) + ((null a) T) + ((null b) NIL) + (T (multiple-value-bind (a-parts b-parts) (ensure-versions-comparable a b) + (loop for a in a-parts + for b in b-parts + do (cond ((version-part= a b)) + ((version-part< a b) (return T)) + (T (return NIL))) + finally (return NIL)))))) + +(defun version<= (a b) + (cond ((eql a b) T) + ((null a) T) + ((null b) NIL) + (T (multiple-value-bind (a-parts b-parts) (ensure-versions-comparable a b) + (loop for a in a-parts + for b in b-parts + do (cond ((version-part= a b)) + ((version-part< a b) (return T)) + (T (return NIL))) + finally (return T)))))) + +(defun version-region (versions &key start end) + (loop for version in versions + when (and (or (not start) (version<= start version)) + (or (not end) (version<= version end))) + collect version)) + +(defun version-bounds (versions &key (start NIL start-p) end) + (when versions + (let* ((versions (version-region versions :start start :end end)) + (last (last versions))) + (when (and start-p (version< start (first versions))) + (push start versions)) + (when (and end (version< (car last) end)) + (setf (cdr last) (list end))) + versions))) + +(defmethod last-known-system-version ((system asdf:system)) + (config :versions (asdf:component-name system))) + +(defmethod last-known-system-version (system) + (last-known-system-version (asdf:find-system system T))) + +(defmethod (setf last-known-system-version) (version (system asdf:system)) + (setf (config :versions (asdf:component-name system)) (encode-version version))) + +(defmethod (setf last-known-system-version) (version system) + (setf (last-known-system-version (asdf:find-system system T)) version)) + +(defun ensure-system (system-ish &optional parent) + (typecase system-ish + (asdf:system + system-ish) + ((or string symbol) + (asdf:find-system system-ish T)) + (cons + (asdf/find-component:resolve-dependency-spec + parent system-ish)))) + +(defgeneric migrate-versions (system from to)) + +(defmethod ready-dependency-for-migration (dependency system from) + (declare (ignore system from)) + (handler-bind ((system-has-no-version #'continue)) + (migrate dependency T T))) + +(defmethod ensure-dependencies-ready ((system asdf:system) from) + (loop for spec in (append (asdf:system-defsystem-depends-on system) + (asdf:system-depends-on system)) + for dependency = (ensure-system spec system) + do (when (typep dependency 'virtual-module) + (ready-dependency-for-migration dependency system from)))) + +(defmethod migrate-versions :before (system from to) + (l:debug :radiance.migration "Migrating ~a from ~a to ~a." + (asdf:component-name system) (encode-version from) (encode-version to)) + (ensure-dependencies-ready system from)) + +(defmethod migrate-versions (system from to)) + +(defmethod migrate-versions :after (system from to) + (setf (last-known-system-version system) to)) + +(defmacro define-version-migration (system (from to) &body body) + (check-type system (or symbol string)) + (let ((from (etypecase from + ((or null keyword) from) + ((or symbol string) (intern (string-upcase from) :keyword)))) + (to (etypecase to + (keyword to) + ((or symbol string) (intern (string-upcase to) :keyword))))) + `(defmethod migrate-versions ((,(gensym "SYSTEM") (eql (asdf:find-system ',system))) + (,(gensym "FROM") (eql ,from)) + (,(gensym "TO") (eql ,to))) + ,@body))) + +(defmethod versions ((system asdf:system)) + (sort (remove-duplicates + (loop for method in (c2mop:generic-function-methods #'migrate-versions) + for (sys from to) = (c2mop:method-specializers method) + for matching = (and (null (method-qualifiers method)) + (typep sys 'c2mop:eql-specializer) + (eql system (c2mop:eql-specializer-object sys))) + when (and matching (typep from 'c2mop:eql-specializer)) + collect (c2mop:eql-specializer-object from) + when (and matching (typep to 'c2mop:eql-specializer)) + collect (c2mop:eql-specializer-object to)) + :test #'version=) + #'version<)) + +(defmethod migrate ((system asdf:system) from to) + (unless (version= from to) + (with-simple-restart (abort "Abort the migration.") + (with-simple-restart (force-version "Treat the migration as having been successful.") + (assert (version< from to) (from to) + 'backwards-migration-not-allowed + :from from :to to) + (l:info :radiance.migration "Migrating ~a from ~a to ~a." + (asdf:component-name system) (encode-version from) (encode-version to)) + (let ((versions (version-bounds (versions system) :start from :end to))) + (loop for (from to) on versions + while to + do (migrate-versions system from to)))) + (setf (last-known-system-version system) to)))) + +(defmethod migrate ((system asdf:system) from (to (eql T))) + (let ((version (asdf:component-version system))) + (if version + (migrate system from version) + (cerror "Don't migrate the system and continue." + 'system-has-no-version :system system)))) + +(defmethod migrate ((system asdf:system) (from (eql T)) to) + (migrate system (last-known-system-version system) to)) + +(defmethod migrate ((system symbol) from to) + (migrate (asdf:find-system system T) from to)) + +(defmethod migrate ((system string) from to) + (migrate (asdf:find-system system T) from to)) diff --git a/module.lisp b/module.lisp index cea633c1..7a633697 100644 --- a/module.lisp +++ b/module.lisp @@ -72,6 +72,8 @@ #:radiance-condition #:message #:definition-for-shared-package + #:system-has-no-version + #:backwards-migration-not-allowed #:environment-not-set #:internal-error #:request-error @@ -173,6 +175,15 @@ #:load-implementation #:define-interface #:define-implement-trigger) + ;; migration.lisp + (:export + #:last-known-system-version + #:migrate-versions + #:define-version-migration + #:ready-dependency-for-migration + #:ensure-dependencies-ready + #:versions + #:migrate) ;; modules.lisp (:export #:module-domain diff --git a/radiance-core.asd b/radiance-core.asd index 29901ec6..0af758db 100644 --- a/radiance-core.asd +++ b/radiance-core.asd @@ -8,7 +8,7 @@ :class "modularize:virtual-module" :defsystem-depends-on (:modularize) :module-name "RADIANCE-CORE" - :version "1.5.0" + :version "2.0.0" :license "Artistic" :author "Nicolas Hafner " :maintainer "Nicolas Hafner " @@ -33,7 +33,9 @@ (:file "standard-interfaces") (:file "handle") (:file "defaults") + (:file "migration") (:file "init") + (:file "version-upgrades") (:file "documentation")) :depends-on (:modularize-hooks :modularize-interfaces @@ -46,5 +48,6 @@ :form-fiddle :bordeaux-threads :documentation-utils - :babel) + :babel + :closer-mop) :in-order-to ((asdf:test-op (asdf:test-op :radiance-test)))) diff --git a/radiance.asd b/radiance.asd index df393bfd..fffaeaff 100644 --- a/radiance.asd +++ b/radiance.asd @@ -5,7 +5,7 @@ |# (asdf:defsystem radiance - :version "1.5.0" + :version "2.0.0" :license "Artistic" :author "Nicolas Hafner " :maintainer "Nicolas Hafner " diff --git a/version-upgrades.lisp b/version-upgrades.lisp new file mode 100644 index 00000000..4ac85c55 --- /dev/null +++ b/version-upgrades.lisp @@ -0,0 +1,29 @@ +#| + This file is a part of Radiance + (c) 2016 Shirakumo http://tymoon.eu (shinmera@tymoon.eu) + Author: Nicolas Hafner +|# + +(in-package #:org.shirakumo.radiance.core) + +(define-version-migration radiance-core (NIL 2.0.0) + (let ((previous-config-directory (merge-pathnames "radiance/" (ubiquitous:config-directory)))) + (when (uiop:directory-exists-p previous-config-directory) + (l:info :radiance.migration "Migrating previous configuration from ~a" + previous-config-directory) + (loop for original-path in (uiop:subdirectories previous-config-directory) + for environment = (car (last (pathname-directory original-path))) + for new-path = (environment-directory environment :configuration) + for temp-path = (make-pathname :directory (append (butlast (pathname-directory new-path)) + (list (format NIL "before-migration-~a" environment))) + :defaults new-path) + do (when (uiop:directory-exists-p new-path) + (rename-file new-path temp-path) + (l:info :radiance.migration "The existing configuration for the ~s environment has been moved to~% ~a" + environment temp-path)) + (rename-file original-path new-path) + (when (string= environment (environment)) + (l:info :radiance.migration "Restored current environment ~s from old site, reloading." + environment) + (reload-environment))) + (uiop:delete-empty-directory previous-config-directory))))