Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpi
Commits
f638af4d
Commit
f638af4d
authored
May 08, 2020
by
Eric Timmons
Browse files
Separate object store implementation from index implementation
parent
293efb50
Changes
13
Hide whitespace changes
Inline
Side-by-side
src/clpi.lisp
View file @
f638af4d
...
...
@@ -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
...
...
src/defs.lisp
View file @
f638af4d
...
...
@@ -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
...
...
src/dual-index.lisp
deleted
100644 → 0
View file @
293efb50
;;;; 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"
))))
src/index-defs.lisp
View file @
f638af4d
...
...
@@ -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
))
src/index.lisp
View file @
f638af4d
...
...
@@ -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-stre
am
(
s
index
"clpi-version"
:if-does-not-exist
nil
)
(
with-open-
object-stream
(
s
(
index-object-st
o
re
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-stre
am
(
s
index
"index"
:if-does-not-exist
nil
)
(
with-open-
object-stream
(
s
(
index-object-st
o
re
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-stre
am
(
s
index
"clpi-version"
:direction
:output
:if-exists
:supersede
)
(
with-open-
object-stream
(
s
(
index-object-st
o
re
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-stre
am
(
s
index
"index"
:direction
:output
:if-exists
:supersede
)
(
with-open-
object-stream
(
s
(
index-object-st
o
re
index
)
"index"
:direction
:output
:if-exists
:supersede
)
(
with-clpi-io-syntax
()
(
pprint
plist
s
)))))
...
...
src/object-store-defs.lisp
0 → 100644
View file @
f638af4d
;;;; 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
))
src/object-store-dual.lisp
0 → 100644
View file @
f638af4d
;;;; 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"))