Safe-guarding index and partition names, some grooming.

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.
+- Check types.
-- Verify names of indexes and partitions: names are directly related to directory paths.
-- db/data-filepath instead of get-filepath.
-- database -> db-path

src/main.lisp

@@ -24,11 +24,17 @@
 (defun number->filename (number)
   (format nil "~15,'0D" number))
 
-(defun value->string (value)
+(defun is-forbidden-character-p (some-char)
-  (typecase value
+  (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))))

src/scenario.cl

@@ -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))

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))