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

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

parent a1ee9127
Loading
Loading
Loading
Loading
+0 −1
Original line number Diff line number Diff line
@@ -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/"
+29 −29
Original line number Diff line number Diff line
@@ -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

+3 −3
Original line number Diff line number Diff line
@@ -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)
+53 −37
Original line number Diff line number Diff line
@@ -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)
                                                       :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)))))
            (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)))
      (tagbody
       top
         (handler-bind ((index-object-missing
                          (lambda (c)
                         (read-from-primary)
                         (continue 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)))))
        (open-index-object-stream secondary path
           (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)
                                                               (* 10 60)))
                                                                    (* 60 60)))
                                       :binary-p binary-p
                                  :offset offset)))))
                                       :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"))))
+40 −62
Original line number Diff line number Diff line
@@ -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
(defmethod open-index-object-stream ((index file-index) path (direction (eql :output))
                                     &key signal-if-older-than
                                       binary-p offset)
  (let ((pn (merge-pathnames path (file-index-root index)))
                                       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))
    (unless (probe-file pn)
      (restart-case
          (cerror "Continue" 'index-object-missing :index index :path path)))
    (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 (direction (eql :input))
                                     &key signal-if-older-than
                                       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 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))
Loading