From afe2e12f5f49f205763a5011b29c35a54c513e25 Mon Sep 17 00:00:00 2001 From: kimory Date: Wed, 19 Oct 2022 21:22:15 +0200 Subject: [PATCH] Safe-guarding index and partition names, some grooming. --- TODO.md | 5 +---- src/main.lisp | 38 ++++++++++++++++++-------------------- src/scenario.cl | 28 ---------------------------- src/scenario.lisp | 32 ++++++++++++++++++++++++++++++++ 4 files changed, 51 insertions(+), 52 deletions(-) delete mode 100644 src/scenario.cl create mode 100644 src/scenario.lisp diff --git a/TODO.md b/TODO.md index 7e732fe..e3570dc 100644 --- a/TODO.md +++ b/TODO.md @@ -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. diff --git a/src/main.lisp b/src/main.lisp index dccc7e6..a89a6ae 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -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)))) diff --git a/src/scenario.cl b/src/scenario.cl deleted file mode 100644 index 07e9a96..0000000 --- a/src/scenario.cl +++ /dev/null @@ -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)) diff --git a/src/scenario.lisp b/src/scenario.lisp new file mode 100644 index 0000000..67d0107 --- /dev/null +++ b/src/scenario.lisp @@ -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))