Commit f638af4d authored by Eric Timmons's avatar Eric Timmons

Separate object store implementation from index implementation

parent 293efb50
......@@ -7,9 +7,11 @@
(:nicknames #:clpi)
(:use #:cl
#:clpi/defs
#:clpi/dual-index
#:clpi/file-index
#:clpi/http-index
#:clpi/index
#:clpi/object-store
#:clpi/object-store-dual
#:clpi/object-store-file
#:clpi/object-store-http
#:clpi/project
#:clpi/release
#:clpi/repos
......@@ -18,9 +20,11 @@
#:clpi/system-release
#:clpi/utils)
(:reexport #:clpi/defs
#:clpi/dual-index
#:clpi/file-index
#:clpi/http-index
#:clpi/index
#:clpi/object-store
#:clpi/object-store-dual
#:clpi/object-store-file
#:clpi/object-store-http
#:clpi/project
#:clpi/release
#:clpi/repos
......
......@@ -6,12 +6,14 @@
(uiop:define-package #:clpi/defs
(:use #:cl
#:clpi/index-defs
#:clpi/object-store-defs
#:clpi/project-defs
#:clpi/release-defs
#:clpi/system-defs
#:clpi/system-file-defs
#:clpi/system-release-defs)
(:reexport #:clpi/index-defs
#:clpi/object-store-defs
#:clpi/project-defs
#:clpi/release-defs
#:clpi/system-defs
......
;;;; Dual Index Definitions
;;;;
;;;; This software is part of CLPI. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpi/dual-index
(:use #:cl
#:alexandria
#:clpi/defs
#:clpi/index)
(:export #:dual-index
#:dual-index-sync))
(in-package #:clpi/dual-index)
(defclass dual-index (index)
((primary
:initarg :primary
:reader dual-index-primary)
(secondary
:initarg :secondary
:reader dual-index-secondary)
(updated-paths
:initform (make-hash-table :test 'equal)
:reader dual-index-updated-paths))
(:documentation
"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 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-release-data-missing ((index dual-index) project release)
(let* ((path (project-releases-path project))
(primary (dual-index-primary index))
(secondary (dual-index-secondary index))
(secondary-size (index-object-size secondary path)))
(with-open-index-object-stream (primary-stream primary path
:binary-p t
:offset secondary-size)
(index-object-append secondary path primary-stream))))
(defun path-should-be-fetched-if-old-p (index path)
(and (not (path-appendable-p path))
(not (gethash path (dual-index-updated-paths index)))))
(defun path-appendable-p (path)
(let ((file-namestring (file-namestring path)))
(starts-with-subseq "releases-" file-namestring)))
(defun update-object-from-primary (index path)
(let* ((primary (dual-index-primary index))
(secondary (dual-index-secondary index)))
(if (path-appendable-p path)
(with-open-index-object-stream (primary-stream primary path
:binary-p 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 (direction (eql :input))
&key signal-if-older-than
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)
(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 "clpi-version")
(update-object-from-primary index "index")
(dolist (p (index-projects index))
(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 (system-object-path s "primary-project"))))
......@@ -6,22 +6,12 @@
(uiop:define-package #:clpi/index-defs
(:use #:cl
#:alexandria)
(:export #:call-with-open-index-object-stream
#:index
(:export #:index
#:index-add-project
#:index-add-system
#:index-initialize
#:index-initialize-internal
#:index-object-append
#:index-object-size
#:index-object-write
#:index-object-missing
#:index-object-missing-index
#:index-object-missing-path
#:index-object-out-of-date
#:index-object-out-of-date-index
#:index-object-out-of-date-path
#:index-object-out-of-date-universal-time
#:index-object-store
#:index-plist
#:index-project
#:index-project-class
......@@ -32,7 +22,6 @@
#:index-projects
#:index-release-data-missing
#:index-save
#:index-secondary-p
#:index-system
#:index-system-class
#:index-system-file-class
......@@ -42,35 +31,10 @@
#:index-system-names
#:index-system-release-class
#:index-systems
#:index-version
#:open-index-object-stream
#:with-open-index-object-stream))
#:index-version))
(in-package #:clpi/index-defs)
(define-condition index-object-missing ()
((index
:initarg :index
:reader index-object-missing-index)
(path
:initarg :path
:reader index-object-missing-path))
(:documentation
"Condition stating that an object is missing from an index."))
(define-condition index-object-out-of-date ()
((index
:initarg :index
:reader index-object-out-of-date-index)
(path
:initarg :path
:reader index-object-out-of-date-path)
(universal-time
:initarg :universal-time
:reader index-object-out-of-date-universal-time))
(:documentation
"Condition stating that an object is out of date."))
(define-condition index-project-missing ()
((index
:initarg :index
......@@ -114,18 +78,9 @@ to be defered until first access instead of instantiation."))
"Performs initialization of the index using the data read from the index
object."))
(defgeneric index-object-append (index path in-stream)
(defgeneric index-object-store (index)
(:documentation
"Append the contents of IN-STREAM to the object in INDEX located at PATH."))
(defgeneric index-object-size (index path)
(:documentation
"Returns the size of the object located at PATH in the INDEX in bytes."))
(defgeneric index-object-write (index path in-stream)
(:documentation
"Write the contents of IN-STREAM to the object located at PATH in the
INDEX. Overwrites the object if it exists."))
"Returns the object store backing the index."))
(defgeneric index-plist (index)
(:documentation
......@@ -159,10 +114,6 @@ signaled."))
(:documentation
"Save modifications to INDEX to persistent storage."))
(defgeneric index-secondary-p (index)
(:documentation
"T iff INDEX is a secondary index."))
(defgeneric index-system (index system-name &optional error)
(:documentation
"Return the system with the name SYSTEM-NAME.
......@@ -193,55 +144,3 @@ signaled."))
(defgeneric index-version (index)
(:documentation
"Returns the CLPI version of INDEX."))
(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.
If SIGNAL-IF-OLDER-THAN is non-NIL, a condition of type INDEX-OBJECT-OUT-OF-DATE
will be signaled if the last modification time of the object was before the
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.
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
if-does-not-exist
if-exists)
&body body)
(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,6 +7,7 @@
(:use #:cl
#:alexandria
#:clpi/defs
#:clpi/object-store-dual
#:clpi/project
#:clpi/system
#:clpi/utils)
......@@ -15,7 +16,10 @@
(in-package #:clpi/index)
(defclass index ()
((project-ht
((object-store
:initarg :object-store
:accessor index-object-store)
(project-ht
:accessor index-project-ht
:documentation
"Maps project names to project instances.")
......@@ -26,10 +30,7 @@
(system-ht
:accessor index-system-ht
:documentation
"Maps system names to system instances.")
(secondary-p
:initform nil
:accessor index-secondary-p))
"Maps system names to system instances."))
(:documentation
"The base class for an index. Contains a mapping from project (system) names
to projects (systems). Each map slot starts as unbound, when first accessed, the
......@@ -56,12 +57,12 @@ project-index and system-index files are read to instantiate the objects."))
(defmethod index-initialize ((index index))
(let (contents)
(with-open-index-object-stream (s index "clpi-version" :if-does-not-exist nil)
(with-open-object-stream (s (index-object-store 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)
(with-open-object-stream (s (index-object-store index) "index" :if-does-not-exist nil)
(when s
(with-clpi-io-syntax ()
(setf contents (read s)))))
......@@ -115,25 +116,28 @@ project-index and system-index files are read to instantiate the objects."))
(hash-table-values (index-project-ht index)))
(defmethod index-release-data-missing ((index index) project release)
"The default method. Nothing can be done to correct the situation, so just
error."
(error 'project-missing-version :version release :project project))
"If the object store is a dual object store, try to update the relevant
object, otherwise error."
(unless (typep (index-object-store index) 'dual-object-store)
(error 'project-missing-version :version release :project project))
(dual-object-store-update-object (index-object-store index)
(project-releases-path project)))
(defmethod index-save ((index index))
(dolist (p (index-projects index))
(project-save p))
(dolist (s (index-systems index))
(system-save s))
(with-open-index-object-stream (s index "clpi-version"
:direction :output
:if-exists :supersede)
(with-open-object-stream (s (index-object-store index) "clpi-version"
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(write "0.4" :stream s)
(terpri s)))
(let ((plist (index-plist index)))
(with-open-index-object-stream (s index "index"
:direction :output
:if-exists :supersede)
(with-open-object-stream (s (index-object-store index) "index"
:direction :output
:if-exists :supersede)
(with-clpi-io-syntax ()
(pprint plist s)))))
......
;;;; Object store definitions
;;;;
;;;; This software is part of CLPI. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpi/object-store-defs
(:use #:cl
#:alexandria)
(:export #:call-with-open-object-stream
#:object-append
#:object-size
#:object-write
#:object-missing
#:object-missing-store
#:object-missing-path
#:object-out-of-date
#:object-out-of-date-store
#:object-out-of-date-path
#:object-out-of-date-universal-time
#:open-object-stream
#:with-open-object-stream))
(in-package #:clpi/object-store-defs)
(define-condition object-missing ()
((store
:initarg :store
:reader object-missing-store)
(path
:initarg :path
:reader object-missing-path))
(:documentation
"Condition stating that an object is missing from an object store."))
(define-condition object-out-of-date ()
((store
:initarg :store
:reader object-out-of-date-store)
(path
:initarg :path
:reader object-out-of-date-path)
(universal-time
:initarg :universal-time
:reader object-out-of-date-universal-time))
(:documentation
"Condition stating that an object is out of date."))
(defgeneric object-append (object-store path in-stream)
(:documentation
"Append the contents of IN-STREAM to the object in OBJECT-STORE located at PATH."))
(defgeneric object-size (object-store path)
(:documentation
"Returns the size of the object located at PATH in the OBJECT-STORE in bytes."))
(defgeneric object-write (object-store path in-stream)
(:documentation
"Write the contents of IN-STREAM to the object located at PATH in the
OBJECT-STORE. Overwrites the object if it exists."))
(defgeneric open-object-stream (object-store 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 OBJECT-STORE located at PATH.
If SIGNAL-IF-OLDER-THAN is non-NIL, a condition of type OBJECT-OUT-OF-DATE will
be signaled if the last modification time of the object was before the 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.
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-object-stream (object-store path thunk
&rest args
&key direction
binary-p offset
if-does-not-exist
if-exists))
(defmethod call-with-open-object-stream (object-store 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-object-stream
object-store path direction
(remove-from-plist args :direction))))
(if stream
(with-open-stream (stream stream)
(funcall thunk stream))
(funcall thunk stream))))
(defmacro with-open-object-stream ((s object-store path
&rest args
&key
(direction :input)
binary-p
offset
if-does-not-exist
if-exists)
&body body)
(declare (ignore binary-p offset if-does-not-exist if-exists direction))
`(call-with-open-object-stream ,object-store ,path (lambda (,s) ,@body)
,@args))
;;;; Dual Object Store
;;;;
;;;; This software is part of CLPI. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpi/object-store-dual
(:use #:cl
#:alexandria
#:clpi/defs
#:clpi/object-store)
(:export #:dual-object-store
#:dual-object-store-sync
#:dual-object-store-update-object))
(in-package #:clpi/object-store-dual)
(defclass dual-object-store (object-store)
((primary
:initarg :primary
:reader dual-object-store-primary)
(secondary
:initarg :secondary
:reader dual-object-store-secondary)
(updated-paths
:initform (make-hash-table :test 'equal)
:reader dual-object-store-updated-paths))
(:documentation
"A logical view of an object store that is backed by two separate object
stores, 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 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."))
(defun path-should-be-fetched-if-old-p (object-store path)
(and (not (path-appendable-p path))
(not (gethash path (dual-object-store-updated-paths object-store)))))
(defun path-appendable-p (path)
(let ((file-namestring (file-namestring path)))
(starts-with-subseq "releases-" file-namestring)))
(defun dual-object-store-update-object (object-store path)
(let* ((primary (dual-object-store-primary object-store))
(secondary (dual-object-store-secondary object-store)))
(if (path-appendable-p path)
(with-open-object-stream (primary-stream primary path
:binary-p t
:offset (object-size secondary path)
:if-does-not-exist nil)
(when primary-stream
(object-append secondary path primary-stream)
t))
(with-open-object-stream (s primary path
:if-does-not-exist nil)
(when s
(object-write secondary path s)
(setf (gethash path (dual-object-store-updated-paths object-store)) t)
t)))))
(defmethod open-object-stream ((object-store dual-object-store) path (direction (eql :input))
&key signal-if-older-than
binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(let ((secondary (dual-object-store-secondary object-store)))
(flet ((read-from-primary ()
(dual-object-store-update-object object-store path)))
(tagbody
top
(handler-bind ((object-missing
(lambda (c)
(declare (ignore c))
(if (read-from-primary)
(go top)
(ecase if-does-not-exist
(:error
(error 'object-missing :store object-store :path path))
((nil)
(return-from open-object-stream nil))))))
(object-out-of-date
(lambda (c)
(declare (ignore c))
(when (path-should-be-fetched-if-old-p object-store path)
(read-from-primary)))))
(return-from
open-object-stream
(open-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 (object-store)
;; "Ensure that every object is present in OBJECT-STORE's secondary."
;; (dual-object-store-update-object object-store "clpi-version")
;; (dual-object-store-update-object object-store "index")
;; (dolist (p (index-projects object-store))
;; (dual-object-store-update-object object-store (project-object-path p "repo"))
;; (dual-object-store-update-object object-store (project-object-path p "authors"))
;; (dual-object-store-update-object object-store (project-object-path p "maintainers"))
;; (dual-object-store-update-object object-store (project-object-path p "homepage"))
;; (dual-object-store-update-object object-store (project-object-path p "releases-object-version"))
;; (dual-object-store-update-object object-store (project-object-path p "version-scheme"))