Commit dd5c165b authored by Eric Timmons's avatar Eric Timmons

Get rid of lazily updating objects in dual indices

Now all objects in a dual index are updated on their first access. This makes
the view of the index more consistent and easier to reason about.
parent 58db5fc5
......@@ -20,7 +20,6 @@
#:index-project-missing-project-name
#:index-project-names
#:index-projects
#:index-release-data-missing
#:index-save
#:index-sync
#:index-system
......@@ -107,10 +106,6 @@ signaled."))
(:documentation
"Return a list of all projects in INDEX."))
(defgeneric index-release-data-missing (index project release)
(:documentation
"Called when the data for a RELEASE is missing from the INDEX."))
(defgeneric index-save (index)
(:documentation
"Save modifications to INDEX to persistent storage."))
......
......@@ -115,26 +115,6 @@ project-index and system-index files are read to instantiate the objects."))
(defmethod index-projects ((index index))
(hash-table-values (index-project-ht index)))
(defmethod index-release-data-missing ((index index) project release)
"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))
(let ((offset (dual-object-store-update-object (index-object-store index)
(project-releases-path project))))
(cond
((numberp offset)
(with-open-object-stream (s (index-object-store index) (project-releases-path project)
:offset offset)
(project-load-releases-from-stream! project s))
t)
(offset
(with-open-object-stream (s (index-object-store index) (project-releases-path project))
(project-load-releases-from-stream! project s))
t)
(t
nil))))
(defmethod index-save ((index index))
(dolist (p (index-projects index))
(project-save p))
......
......@@ -59,15 +59,11 @@
OBJECT-STORE. Overwrites the object if it exists."))
(defgeneric open-object-stream (object-store path direction
&key signal-if-older-than binary-p offset
&key 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.
......
......@@ -26,15 +26,14 @@
: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."))
stores, the primary and the secondary. On the first access to any object in the
store, the secondary is updated from the primary and then the secondary is read."))
(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-already-updated-p (object-store path)
(gethash path (dual-object-store-updated-paths object-store)))
(defun mark-path-updated (object-store path)
(setf (gethash path (dual-object-store-updated-paths object-store)) t))
(defun path-appendable-p (path)
(let ((file-namestring (file-namestring path)))
......@@ -44,51 +43,23 @@ older than 60 minutes old."))
(let* ((primary (dual-object-store-primary object-store))
(secondary (dual-object-store-secondary object-store)))
(if (path-appendable-p path)
(let ((offset (object-size secondary path)))
(with-open-object-stream (primary-stream primary path
:binary-p t
:offset offset
:if-does-not-exist nil)
(when primary-stream
(object-append secondary path primary-stream)
offset)))
(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)))
(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)))))
(object-write secondary path s))))
(mark-path-updated object-store path)))
(defmethod open-object-stream ((object-store dual-object-store) path (direction (eql :input))
&key signal-if-older-than
binary-p offset
&key 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)))))))
(unless (path-already-updated-p object-store path)
(dual-object-store-update-object object-store path))
(open-object-stream (dual-object-store-secondary object-store) path direction
:offset offset :binary-p binary-p
:if-does-not-exist if-does-not-exist :if-exists if-exists))
......@@ -79,10 +79,8 @@
thunk args)))))
(defmethod open-object-stream ((object-store file-object-store) path (direction (eql :output))
&key signal-if-older-than
binary-p offset
&key 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-object-store-root object-store)))
(open-args nil))
......@@ -94,8 +92,7 @@
open-args)))
(defmethod open-object-stream ((object-store file-object-store) path (direction (eql :input))
&key signal-if-older-than
binary-p offset
&key binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(let* ((pn (merge-pathnames path (file-object-store-root object-store)))
......@@ -111,13 +108,6 @@
(return-from open-object-stream nil))
(:error
(error 'object-missing :store object-store :path path))))
(let ((file-write-date (file-write-date pn)))
(when (and signal-if-older-than
(< file-write-date signal-if-older-than))
(signal 'object-out-of-date
:store object-store
:path path
:universal-time file-write-date)))
(let ((s (apply #'open pn open-args))
(normal-exit-p))
(unwind-protect
......
......@@ -6,7 +6,6 @@
(uiop:define-package #:clpi/object-store-http
(:use #:cl
#:alexandria
#:cl-date-time-parser
#:clpi/defs
#:clpi/object-store
#:clpm-multi-http-client)
......@@ -43,8 +42,7 @@
*default-http-client*))
(defmethod open-object-stream ((object-store http-object-store) path (direction (eql :input))
&key signal-if-older-than
binary-p offset
&key binary-p offset
(if-does-not-exist :error) if-exists)
(declare (ignore if-exists))
(when (and offset (not binary-p))
......@@ -61,7 +59,7 @@
(push (cons :range (format nil "bytes=~D-" (1- offset))) headers)
;; Explicitly ask for no compression.
(push (cons :accept-encoding "identity") headers))
(multiple-value-bind (s code response-headers)
(multiple-value-bind (s code)
(http-client-request (http-object-store-http-client object-store) uri
:additional-headers headers
:want-stream t
......@@ -89,11 +87,4 @@
((= code 206)
;; Got partial content back! Pop off the one extra byte we requested.
(read-byte s)))
(let ((last-modified (parse-date-time (assoc-value response-headers :last-modified))))
(when (and signal-if-older-than
(< last-modified signal-if-older-than))
(signal 'object-out-of-date
:store object-store
:path path
:universal-time last-modified)))
s)))
......@@ -89,9 +89,7 @@ is already present in PROJECT, it is silently skipped."))
(defgeneric project-release (project version-string &optional error)
(:documentation
"Returns two values, the release object matching the given version string and
a boolean that is T iff VERSION-STRING is valid. A VERSION-STRING is valid if
the index states that a release of PROJECT exists with that version.
"Returns the release object matching the given version string.
If ERROR is T (default) and the release cannot be found (there is no such
version or the index does not contain the information about this version) this
......
......@@ -138,19 +138,9 @@ instantiated."))
(release
(values release t))
(error
(when (index-release-data-missing (index project) project version)
(let ((release (gethash version (project-release-ht project))))
(if release
(values release t)
(error 'project-missing-version :project project :version version)))))
(error 'project-missing-version :project project :version version))
(t
(handler-case
(when (index-release-data-missing (index project) project version)
(let ((release (gethash version (project-release-ht project))))
(if release
(values release t)
(values nil t))))
(project-missing-version () (values nil t)))))))
nil))))
(defmethod project-releases ((project project))
;; We can't call HASH-TABLE-VALUES directly because PROJECT-RELEASE contains
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment