Commit 765b37d8 authored by Eric Timmons's avatar Eric Timmons

Get rid of metadata object, use separate objects for all its contents

parent a1ee9127
......@@ -7,7 +7,6 @@
(in-package :asdf-user)
(defsystem #:clpi-test
;;:version (:read-file-form "src/version.lisp" :at (2 2))
:description "Test system for clpi system."
:license "BSD-2-Clause"
:pathname "test/"
......
......@@ -15,10 +15,16 @@ implementation. All symbols in the s-expressions must be keywords.
Any plist may contain keys beyond those defined by this specification. However,
as there is no central registry of extensions to the spec, all such keywords
*must* be prefixed with an identifier folowed by a =/=. For example, the
=ql-clpi= project prefixes all custom keys (such as version aliases) with
=ql/=. New keys for any plist may be added to this version of the specification
so long as the changes are backwards compatible.
*must* be prefixed with an identifier followed by a =/=.
There may also be additional objects in the index beyond those defined by this
specification. Any new objects not part of the spec *must* be prefixed with by
=ext/ID/= where ID is a reasonably unique identifer. For example, the =ql-clpi=
project stores version aliases for projects in the
=projects/PROJECT-NAME/ext/ql/version-aliases= object.
New keys for any plist or new objects may be added to this version of the
specification so long as the changes are backwards compatible.
As many users of an index may desire to work offline and/or not need access to
the entire index, it is designed to be somewhat efficient when syncing across a
......@@ -28,13 +34,12 @@ the secondary.
* Index metadata
The object =metadata= must exist and contain a single plist. The defined keys
are:
The following objects are defined at the top level of the index to contain
information about the entire index.
+ =:clpi-version= :: Required. A string naming the version of the CLPI
specification used by this index. Must be ="0.4"=.
+ =:canonical-url= :: Optional. A string containing the canonical URL to this
index's metadata. Used when hosting a primary index for remote access.
+ =clpi-version= :: Required. A string naming the version of the CLPI
specification used by this index. Must be ="0.4"= for this version of the
spec.
* Index
......@@ -75,20 +80,17 @@ the secondary.
* Project metadata
For every project in the index, the object =projects/PROJECT-NAME/metadata=
must exist, where =PROJECT-NAME= is the project name.
Metadata about projects is stored under the prefix
=projects/PROJECT-NAME/=. The following objects are defined for each
project.
This object must contain a single plist. The defined keys are:
+ =:repo= :: A VCS repository as described in [[*Repository Description]].
+ =:authors= :: A list of person descriptions as described in [[*Person
Description]].
+ =:maintainers= :: A list of person descriptions as described in [[*Person
Description]].
+ =:homepage= :: A string containing the URL of the project's homepage.
+ =:releases-object-version= :: An integer or NIL/missing whose purpose is
+ =repo= :: The project's VCS repository, as described in [[*Repository Description]].
+ =authors= :: A list of person descriptions, as described in [[*Person Description]].
+ =maintainers= :: A list of person descriptions, as described in [[*Person Description]].
+ =homepage= :: A string containing the URL of the project's homepage.
+ =releases-object-version= :: An integer or NIL/missing whose purpose is
further described in [[*Project releases]].
+ =:version-scheme= :: A keyword describing how this project versions its
+ =version-scheme= :: A keyword describing how this project versions its
releases. =:date= implies a date based version that is comparable with
=#'string<=. =:semantic= implies version numbers that are compatible with
[[https://semver.org/][Semver v2]].
......@@ -130,14 +132,12 @@ the secondary.
* System metadata
For every primary system in the index, the object
=systems/SYSTEM-NAME/metadata= must exist, where =SYSTEM-NAME= is the primary
system name.
This object must contain a single plist. The defined keys are:
Metadata about systems is stored under the prefix =projects/SYSTEM-NAME/=
where =SYSTEM-NAME= is the primary system name. The following objects are
defined for each primary system.
+ =:primary-project= :: A string naming the current home project of this
system.
+ =primary-project= :: A string naming the current home project of this
system and all its child systems.
* System dependency
......
......@@ -10,13 +10,13 @@
#:clpi/dual-index
#:clpi/file-index
#:clpi/http-index
#:clpi/metadata
#:clpi/project
#:clpi/release
#:clpi/repos
#:clpi/system
#:clpi/system-file
#:clpi/system-release)
#:clpi/system-release
#:clpi/utils)
(:reexport #:clpi/defs
#:clpi/dual-index
#:clpi/file-index
......@@ -27,6 +27,6 @@
#:clpi/system
#:clpi/system-file
#:clpi/system-release)
(:export #:metadata-value))
(:export #:with-clpi-io-syntax))
(in-package #:clpi/clpi)
......@@ -6,10 +6,8 @@
(uiop:define-package #:clpi/dual-index
(:use #:cl
#:alexandria
#:clpi/index-defs
#:clpi/index
#:clpi/metadata
#:clpi/project-defs)
#:clpi/defs
#:clpi/index)
(:export #:dual-index
#:dual-index-sync))
......@@ -29,17 +27,14 @@
"A logical view of an index that is backed by two separate indices, the
primary and the secondary. All reads prefer the secondary, but if some data is
missing, it will be transparently read from the primary and placed into the
secondary. Additionally, any metadata file and the project/system indices will
be read from the primary on first access if the local copies are older than 10
secondary. Additionally, any metadata object and the project/system indices will
be read from the primary on first access if the local copies are older than 60
minutes old."))
(defmethod initialize-instance :after ((index dual-index) &rest initargs)
(declare (ignore initargs))
(setf (index-secondary-p (dual-index-secondary index)) t))
(defmethod index-backing-objects-exist-p ((index dual-index))
t)
(defmethod index-release-data-missing ((index dual-index) project release)
(let* ((path (project-releases-path project))
(primary (dual-index-primary index))
......@@ -51,9 +46,7 @@ minutes old."))
(index-object-append secondary path primary-stream))))
(defun path-should-be-fetched-if-old-p (index path)
(and (or (equal path "project-index")
(equal path "system-index")
(ends-with-subseq "metadata" path))
(and (not (path-appendable-p path))
(not (gethash path (dual-index-updated-paths index)))))
(defun path-appendable-p (path)
......@@ -66,40 +59,63 @@ minutes old."))
(if (path-appendable-p path)
(with-open-index-object-stream (primary-stream primary path
:binary-p t
:offset (index-object-size secondary path))
(index-object-append secondary path primary-stream))
(with-open-index-object-stream (s primary path)
(index-object-write secondary path s)
(setf (gethash path (dual-index-updated-paths index)) t)))))
:offset (index-object-size secondary path)
:if-does-not-exist nil)
(when primary-stream
(index-object-append secondary path primary-stream)
t))
(with-open-index-object-stream (s primary path
:if-does-not-exist nil)
(when s
(index-object-write secondary path s)
(setf (gethash path (dual-index-updated-paths index)) t)
t)))))
(defmethod open-index-object-stream ((index dual-index) path
(defmethod open-index-object-stream ((index dual-index) path (direction (eql :input))
&key signal-if-older-than
binary-p offset)
binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(let ((secondary (dual-index-secondary index)))
(flet ((read-from-primary ()
(update-object-from-primary index path)))
(handler-bind ((index-object-missing
(lambda (c)
(read-from-primary)
(continue c)))
(index-object-out-of-date
(lambda (c)
(declare (ignore c))
(when (path-should-be-fetched-if-old-p index path)
(read-from-primary)))))
(open-index-object-stream secondary path
:signal-if-older-than (or signal-if-older-than
(- (get-universal-time)
(* 10 60)))
:binary-p binary-p
:offset offset)))))
(tagbody
top
(handler-bind ((index-object-missing
(lambda (c)
(declare (ignore c))
(if (read-from-primary)
(go top)
(ecase if-does-not-exist
(:error
(error 'index-object-missing :index index :path path))
((nil)
(return-from open-index-object-stream nil))))))
(index-object-out-of-date
(lambda (c)
(declare (ignore c))
(when (path-should-be-fetched-if-old-p index path)
(read-from-primary)))))
(return-from
open-index-object-stream
(open-index-object-stream secondary path :input
:signal-if-older-than (or signal-if-older-than
(- (get-universal-time)
(* 60 60)))
:binary-p binary-p
:offset offset)))))))
(defun dual-index-sync (index)
"Ensure that every object is present in INDEX's secondary."
(update-object-from-primary index (metadata-path index))
(update-object-from-primary index "clpi-version")
(update-object-from-primary index "index")
(dolist (p (index-projects index))
(update-object-from-primary index (metadata-path p))
(update-object-from-primary index (project-object-path p "repo"))
(update-object-from-primary index (project-object-path p "authors"))
(update-object-from-primary index (project-object-path p "maintainers"))
(update-object-from-primary index (project-object-path p "homepage"))
(update-object-from-primary index (project-object-path p "releases-object-version"))
(update-object-from-primary index (project-object-path p "version-scheme"))
(update-object-from-primary index (project-releases-path p)))
(dolist (s (index-systems index))
(update-object-from-primary index (metadata-path s))))
(update-object-from-primary index (system-object-path s "primary-project"))))
......@@ -7,7 +7,6 @@
(:use #:cl
#:clpi/defs
#:clpi/index
#:clpi/metadata
#:clpi/utils)
(:export #:file-index))
......@@ -26,9 +25,6 @@
(unless (uiop:directory-pathname-p root)
(error ":ROOT must be a directory pathname")))
(defmethod index-backing-objects-exist-p ((index file-index))
(probe-file (merge-pathnames (metadata-path index) (file-index-root index))))
(defmethod index-object-append ((index file-index) path in-stream)
(let ((pn (merge-pathnames path (file-index-root index))))
(ensure-directories-exist pn)
......@@ -68,70 +64,52 @@
:if-exists :supersede)
(uiop:copy-stream-to-stream in-stream s))))
(defmethod index-save ((index file-index))
(when (metadata-dirty-p (metadata index))
(let ((pn (merge-pathnames "metadata" (file-index-root index))))
(ensure-directories-exist pn)
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream index s)))))
(let ((pn (merge-pathnames "index" (file-index-root index))))
(ensure-directories-exist pn)
(let ((plist (index-plist index)))
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(pprint plist s))))))
(dolist (p (index-projects index))
(let ((dirty-p (project-dirty-p p))
(appendable-p (project-changes-appendable-p p))
(releases-object-version (project-releases-object-version p)))
(when dirty-p
(when (and releases-object-version (not appendable-p))
(incf (project-releases-object-version p)))
(let ((pn (merge-pathnames (project-releases-path p) (file-index-root index))))
(ensure-directories-exist pn)
(with-staging-pathname (pn :append-p appendable-p)
(with-open-file (s pn
:direction :output
:if-exists (if appendable-p :append :supersede)
:if-does-not-exist :create)
(if (and appendable-p releases-object-version)
(project-write-changes-to-stream p s)
(project-write-to-stream p s))))))
(when (metadata-dirty-p (metadata p))
(let ((pn (merge-pathnames (metadata-path p) (file-index-root index))))
(ensure-directories-exist pn)
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream p s)))))))
(dolist (system (index-systems index))
(when (metadata-dirty-p (metadata system))
(let ((pn (merge-pathnames (metadata-path system) (file-index-root index))))
(defmethod call-with-open-index-object-stream ((index file-index) path thunk
&rest args
&key (direction :input)
(if-exists :error)
&allow-other-keys)
(if (eql direction :input)
(call-next-method)
(let ((pn (merge-pathnames path (file-index-root index))))
(ensure-directories-exist pn)
(with-staging-pathname (pn)
(with-open-file (s pn
:direction :output
:if-exists :supersede)
(metadata-write-to-stream system s)))))))
(with-staging-pathname (pn :append-p (eql if-exists :append))
(apply #'call-next-method index (enough-namestring pn (file-index-root index))
thunk args)))))
(defmethod open-index-object-stream ((index file-index) path (direction (eql :output))
&key signal-if-older-than
binary-p offset
if-does-not-exist (if-exists :error))
(declare (ignore signal-if-older-than))
(assert (null offset))
(let* ((pn (merge-pathnames path (file-index-root index)))
(open-args nil))
(when binary-p
(push '(unsinged-byte 8) open-args)
(push :element-type open-args))
(apply #'open pn :direction :output :if-does-not-exist if-does-not-exist
:if-exists if-exists
open-args)))
(defmethod open-index-object-stream ((index file-index) path
(defmethod open-index-object-stream ((index file-index) path (direction (eql :input))
&key signal-if-older-than
binary-p offset)
(let ((pn (merge-pathnames path (file-index-root index)))
(open-args nil))
binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(let* ((pn (merge-pathnames path (file-index-root index)))
(open-args nil)
(exists-p (probe-file pn)))
(when binary-p
(push '(unsinged-byte 8) open-args)
(push :element-type open-args))
(unless (probe-file pn)
(restart-case
(cerror "Continue" 'index-object-missing :index index :path path)))
(unless exists-p
(ecase if-does-not-exist
((nil)
(signal 'index-object-missing :index index :path path)
(return-from open-index-object-stream nil))
(:error
(error 'index-object-missing :index index :path path))))
(let ((file-write-date (file-write-date pn)))
(when (and signal-if-older-than
(< file-write-date signal-if-older-than))
......
......@@ -9,7 +9,6 @@
#:cl-date-time-parser
#:clpi/index
#:clpi/index-defs
#:clpi/metadata
#:clpm-multi-http-client)
(:import-from #:puri)
(:export #:http-index))
......@@ -40,12 +39,11 @@
client)))
*default-http-client*))
(defmethod index-backing-objects-exist-p ((index http-index))
t)
(defmethod open-index-object-stream ((index http-index) path
(defmethod open-index-object-stream ((index http-index) path (direction (eql :input))
&key signal-if-older-than
binary-p offset)
binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(when (and offset (not binary-p))
;; Technically we can offset if it's not binary, but its not very efficient
;; (we'd have to transfer the entire prefix from the server).
......@@ -64,8 +62,13 @@
(declare (ignore content))
;;(format t "~S~%" headers)
(when (= code 404)
(cerror "Continue" 'index-object-missing :index index :path path))
(when (>= code 400)
(ecase if-does-not-exist
((nil)
(signal 'index-object-missing :index index :path path)
(return-from open-index-object-stream nil))
(:error
(cerror "Continue" 'index-object-missing :index index :path path))))
(when (and (>= code 400) (/= code 404))
(error "Unknown error!"))
(setf size (assoc-value headers :content-length))
(setf accept-ranges (assoc-value headers :accept-ranges))
......
......@@ -6,10 +6,10 @@
(uiop:define-package #:clpi/index-defs
(:use #:cl
#:alexandria)
(:export #:index
(:export #:call-with-open-index-object-stream
#:index
#:index-add-project
#:index-add-system
#:index-backing-objects-exist-p
#:index-initialize
#:index-initialize-internal
#:index-object-append
......@@ -48,7 +48,7 @@
(in-package #:clpi/index-defs)
(define-condition index-object-missing (error)
(define-condition index-object-missing ()
((index
:initarg :index
:reader index-object-missing-index)
......@@ -71,7 +71,7 @@
(:documentation
"Condition stating that an object is out of date."))
(define-condition index-project-missing (error)
(define-condition index-project-missing ()
((index
:initarg :index
:reader index-project-missing-index)
......@@ -81,7 +81,7 @@
(:documentation
"Condition stating that a project is missing from an index."))
(define-condition index-system-missing (error)
(define-condition index-system-missing ()
((index
:initarg :index
:reader index-system-missing-index)
......@@ -103,10 +103,6 @@
(:documentation
"Add the SYSTEM to the INDEX."))
(defgeneric index-backing-objects-exist-p (object)
(:documentation
"Returns T iff the objects for OBJECT exist in the index."))
(defgeneric index-initialize (index)
(:documentation
"Read the INDEX information from the index object and populate the
......@@ -198,7 +194,9 @@ signaled."))
(:documentation
"Returns the CLPI version of INDEX."))
(defgeneric open-index-object-stream (index path &key signal-if-older-than binary-p offset)
(defgeneric open-index-object-stream (index path direction
&key signal-if-older-than binary-p offset
if-does-not-exist if-exists)
(:documentation
"Open a stream with the contents of the object from INDEX located at PATH.
......@@ -208,20 +206,42 @@ universal time specified by SIGNAL-IF-OLDER-THAN.
If BINARY-P is true, the returned stream is of type (UNSIGNED-BYTE 8).
If OFFSET is specified, the stream will start at the provided offset."))
(defun call-with-open-index-object-stream (index path thunk &rest args &key binary-p offset)
(declare (ignore binary-p offset))
(let ((stream (apply #'open-index-object-stream index path args)))
(with-open-stream (stream stream)
(funcall thunk stream))))
If OFFSET is specified, the stream will start at the provided offset.
IF-DOES-NOT-EXIST should be NIL (in which case NIL is returned if the object
does not exist) or :ERROR to signal an error."))
(defgeneric call-with-open-index-object-stream (index path thunk
&rest args
&key direction
binary-p offset
if-does-not-exist
if-exists))
(defmethod call-with-open-index-object-stream (index path thunk
&rest args
&key (direction :input)
binary-p offset
if-does-not-exist
if-exists)
(declare (ignore binary-p offset if-does-not-exist if-exists))
(let ((stream (apply #'open-index-object-stream
index path direction
(remove-from-plist args :direction))))
(if stream
(with-open-stream (stream stream)
(funcall thunk stream))
(funcall thunk stream))))
(defmacro with-open-index-object-stream ((s index path
&rest args
&key
(direction :input)
binary-p
offset)
offset
if-does-not-exist
if-exists)
&body body)
(declare (ignore binary-p offset))
(declare (ignore binary-p offset if-does-not-exist if-exists direction))
`(call-with-open-index-object-stream ,index ,path (lambda (,s) ,@body)
,@args))
......@@ -7,7 +7,6 @@
(:use #:cl
#:alexandria
#:clpi/defs
#:clpi/metadata
#:clpi/project
#:clpi/system
#:clpi/utils)
......@@ -15,11 +14,15 @@
(in-package #:clpi/index)
(defclass index (has-metadata)
(defclass index ()
((project-ht
:accessor index-project-ht
:documentation
"Maps project names to project instances.")
(version
:accessor index-version
:documentation
"The version of the CLPI spec to which this index adhears.")
(system-ht
:accessor index-system-ht
:documentation
......@@ -53,10 +56,15 @@ project-index and system-index files are read to instantiate the objects."))
(defmethod index-initialize ((index index))
(let (contents)
(when (or (index-backing-objects-exist-p index) (index-secondary-p index))
(with-open-index-object-stream (s index "index")
(with-open-index-object-stream (s index "clpi-version" :if-does-not-exist nil)
(if s
(with-clpi-io-syntax ()
(setf (index-version index) (read s)))
(setf (index-version index) "0.4")))
(with-open-index-object-stream (s index "index" :if-does-not-exist nil)
(when s
(with-clpi-io-syntax ()
(setf contents (read s nil nil)))))
(setf contents (read s)))))
(apply #'index-initialize-internal index contents)))
(defmethod index-initialize-internal ((index index) &key projects systems &allow-other-keys)
......@@ -69,7 +77,6 @@ project-index and system-index files are read to instantiate the objects."))
(apply #'make-instance (index-project-class index)
:index index
:name name
:backing-objects-exist-p t
plist))))
(dolist (system-description systems)
(destructuring-bind (name &rest plist)
......@@ -78,7 +85,6 @@ project-index and system-index files are read to instantiate the objects."))
(apply #'make-instance (index-system-class index)
:index index
:name name
:backing-objects-exist-p t
plist))))
(setf (slot-value index 'project-ht) project-ht
(slot-value index 'system-ht) system-ht)))
......@@ -113,6 +119,18 @@ project-index and system-index files are read to instantiate the objects."))
error."
(error 'project-missing-version :version release :project project))
(defmethod index-save ((index index))
(let ((plist (index-plist index)))
(with-open-index-object-stream (s index "index"
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(pprint plist s))))
(dolist (p (index-projects index))
(project-save p))
(dolist (s (index-systems index))
(system-save s)))
(defmethod index-system ((index index) system-name &optional (error t))
(multiple-value-bind (value exists-p)
(gethash system-name (index-system-ht index))
......@@ -126,17 +144,8 @@ error."
(defmethod index-systems ((index index))
(hash-table-values (index-system-ht index)))
(defmethod index-version (index)
(metadata-value index :clpi-version))
(defmethod metadata-path ((index index))
"metadata")
(defmethod slot-unbound (class (index index) slot-name)