Safe-guarding index and partition names, some grooming.

draft
kimory 2022-10-19 21:22:15 +02:00
parent 0d1411fb61
commit afe2e12f5f
4 changed files with 51 additions and 52 deletions

View File

@ -4,7 +4,4 @@
- Grooming (create a consistent and convenient API, comments)
- Improve data search
- Check for TODOs
- For indexes and partitions: check that the structure attribute exists.
- Verify names of indexes and partitions: names are directly related to directory paths.
- db/data-filepath instead of get-filepath.
- database -> db-path
- Check types.

View File

@ -24,11 +24,17 @@
(defun number->filename (number)
(format nil "~15,'0D" number))
(defun value->string (value)
(typecase value
(defun is-forbidden-character-p (some-char)
(member some-char (list #\/ #\\)))
(defun protect-file-system (value)
(substitute-if #\_ #'is-forbidden-character-p value))
(defun value->safe-string (value)
(protect-file-system (typecase value
(string value)
(symbol (symbol-name value))
(t (format nil "~A" value))))
(t (format nil "~A" value)))))
; index = 1-1
; partition = 1-n
@ -60,25 +66,19 @@
:data data
:current-index current-index)))
; Example: ./storage/cars 18 -> ./storage/cars/data/000000000000018
; USAGE: when dealing with hash keys from the in-memory db.
; The hash key is the number used to build the filename.
(defun db/data-filepath (dbpath number)
(concatenate 'string dbpath "/data/" (number->filename number)))
; Example: returns "./storage/cars/indexes/by_name/".
(defun db/index/get-directory-path (dbpath index-name)
(concatenate 'string dbpath "/indexes/by_" index-name "/"))
; Example: returns "./storage/cars/partitions/by_color/Red/".
(defun db/partition/get-directory-path (dbpath name object-attribute)
(let ((value (value->string object-attribute)))
(let ((value (value->safe-string object-attribute)))
(concatenate 'string dbpath "/partitions/by_" name "/" value "/")))
; Example: "./storage/cars/" "name" #'vehicle-name object -> "./storage/cars/indexes/by_name/Corvet".
(defun db/index/get-symlink-path (dbpath index-name fsymbol object)
(let* ((value (funcall fsymbol object))
(symlink-basename (value->string value)))
(symlink-basename (value->safe-string value)))
(concatenate 'string
(db/index/get-directory-path dbpath index-name)
symlink-basename)))
@ -126,7 +126,8 @@
(delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename)))
(defun db/new-index (database index-name fsymbol)
(let ((dbpath (db-path database)))
(let ((dbpath (db-path database))
(index-name (value->safe-string index-name)))
; create a directory for the indexes
(ensure-directories-exist
(concatenate 'string dbpath "/indexes/by_" index-name "/"))
@ -152,7 +153,8 @@
(db/partition/new dbpath partition-name fsymbol object file-name)))))
(defun db/new-partition (database partition-name fsymbol)
(let ((dbpath (db-path database)))
(let ((dbpath (db-path database))
(partition-name (value->safe-string partition-name)))
; create a directory for the partitions
(ensure-directories-exist
(concatenate 'string dbpath "/partitions/by_" partition-name "/"))
@ -167,17 +169,13 @@
(format t "dodb:db/new-partition: symlink already exists, ignoring.~&"))))
(db-data database))))
; Example: database -> "000000000000018".
(defun db/add/new-data-basename (database)
(number->filename (db-current-index database)))
; Example: "./storage/cars/data/000000000000018".
(defun get-filepath (dbpath file-name)
(concatenate 'string dbpath "/data/" file-name))
(defun db/add (database object)
(incf (db-current-index database))
(let* ((file-basename (db/add/new-data-basename database))
(let* ((file-basename (number->filename (db-current-index database)))
(dbpath (db-path database))
(tmp-file-basename (concatenate 'string file-basename "_tmp"))
(tmp-file-path (get-filepath dbpath tmp-file-basename)))
@ -225,7 +223,7 @@
; Search for the data from the FS.
(defun db/get-by-index (database index-name attribute-value)
(let ((value (value->string attribute-value)))
(let ((value (value->safe-string attribute-value)))
(filename->integer
(osicat:read-link
(concatenate 'string
@ -233,7 +231,7 @@
; Search for the data from the FS.
(defun db/get-by-partition (database name attribute-value)
(let ((value (value->string attribute-value))
(let ((value (value->safe-string attribute-value))
(dbpath (db-path database)))
(loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value))
collect (filename->integer filename))))

View File

@ -1,28 +0,0 @@
(in-package :dodb)
(defstruct vehicle name color (nb-of-lights 4))
; to launch the tests in RAM
(defparameter cars (db/new "/tmp/storage/cars/"))
(db/add cars (make-vehicle :name "Corvet" :color "Red"))
(db/add cars (make-vehicle :name "Ferrari" :color "Red"))
(db/add cars (make-vehicle :name "Deudeuch" :color "Beige"))
(db/add cars (make-vehicle :name "BMW" :color "Blue"))
(db/add cars (make-vehicle :name "Suzuki Wagon" :color "Blue" :nb-of-lights 6))
(db/new-index cars "name" #'vehicle-name)
(db/new-partition cars "color" #'vehicle-color)
(db/new-partition cars "nb-of-lights" #'vehicle-nb-of-lights)
(format t "~&~S~&" cars)
(format t "db/get-by-index ~S~&" (db/get-by-index cars "name" "Corvet"))
(format t "db/get-by-partition red cars:~&")
(loop for car in (db/get-by-partition cars "color" "Red")
do (format t "- ~S~&" car))
(let ((suzuki (db/get-by-index cars "name" "Suzuki Wagon")))
(setf (vehicle-color (gethash suzuki (db-data cars))) "White")
(db/update cars suzuki))

32
src/scenario.lisp Normal file
View File

@ -0,0 +1,32 @@
(defpackage :dodb-scenario
(:use :common-lisp :dodb))
(in-package dodb-scenario)
(defstruct vehicle name color (nb-of-lights 4))
(defparameter cars (dodb:db/new "/tmp/storage/cars/"))
(dodb:db/add cars (make-vehicle :name "Corvet" :color "Red"))
(dodb:db/add cars (make-vehicle :name "Ferrari" :color "Red"))
(dodb:db/add cars (make-vehicle :name "Deudeuch" :color "Beige"))
(dodb:db/add cars (make-vehicle :name "BMW" :color "Blue"))
(dodb:db/add cars (make-vehicle :name "Suzuki Wagon" :color "Blue" :nb-of-lights 6))
(dodb:db/new-index cars "name" #'vehicle-name)
(dodb:db/new-partition cars "color" #'vehicle-color)
(dodb:db/new-partition cars "nb-of-lights" #'vehicle-nb-of-lights)
(dodb:db/new-partition cars "\ot//her\\par/tit" #'vehicle-color)
(dodb:db/new-index cars "\ot//her\\i/name/r" #'vehicle-name)
(format t "~&~S~&" cars)
(format t "db/get-by-index ~S~&" (dodb:db/get-by-index cars "name" "Corvet"))
(format t "db/get-by-partition red cars:~&")
(loop for car in (dodb:db/get-by-partition cars "color" "Red")
do (format t "- ~S~&" car))
(let ((suzuki (dodb:db/get-by-index cars "name" "Suzuki Wagon")))
(setf (vehicle-color (gethash suzuki (dodb:db-data cars))) "White")
(dodb:db/update cars suzuki))