Loading src/index-defs.lisp +0 −5 Original line number Diff line number Diff line Loading @@ -20,7 +20,6 @@ #:index-project-missing-project-name #:index-project-names #:index-projects #:index-release-data-missing #:index-save #:index-sync #:index-system Loading Loading @@ -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.")) Loading src/index.lisp +0 −20 Original line number Diff line number Diff line Loading @@ -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)) Loading src/object-store-defs.lisp +1 −5 Original line number Diff line number Diff line Loading @@ -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. Loading src/object-store-dual.lisp +21 −50 Original line number Diff line number Diff line Loading @@ -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))) Loading @@ -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 :offset (object-size secondary path) :if-does-not-exist nil) (when primary-stream (object-append secondary path primary-stream) offset))) (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)) src/object-store-file.lisp +2 −12 Original line number Diff line number Diff line Loading @@ -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)) Loading @@ -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))) Loading @@ -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 Loading Loading
src/index-defs.lisp +0 −5 Original line number Diff line number Diff line Loading @@ -20,7 +20,6 @@ #:index-project-missing-project-name #:index-project-names #:index-projects #:index-release-data-missing #:index-save #:index-sync #:index-system Loading Loading @@ -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.")) Loading
src/index.lisp +0 −20 Original line number Diff line number Diff line Loading @@ -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)) Loading
src/object-store-defs.lisp +1 −5 Original line number Diff line number Diff line Loading @@ -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. Loading
src/object-store-dual.lisp +21 −50 Original line number Diff line number Diff line Loading @@ -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))) Loading @@ -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 :offset (object-size secondary path) :if-does-not-exist nil) (when primary-stream (object-append secondary path primary-stream) offset))) (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))
src/object-store-file.lisp +2 −12 Original line number Diff line number Diff line Loading @@ -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)) Loading @@ -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))) Loading @@ -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 Loading