initial

2026-04-17 16:33:13 +02:00
parent 61e3e255ea
commit 3c51066fad
17 changed files with 3490 additions and 0 deletions
--- a/keystore.rkt
+++ b/keystore.rkt
@@ -0,0 +1,135 @@
+#lang racket/base
+
+(require racket/contract
+         racket/serialize
+         racket/port
+         db
+         )
+
+(provide ks-open
+         ks-set!
+         ks-get
+         ks-drop!
+         ks-exists?
+         ks-keys
+         ks-keys-glob
+         ks-key-values-glob
+         ks-key-values
+         ks-key-values-raw
+         ks-keys-raw
+         )
+
+(define-struct keystore
+  (file path dbh)
+  #:transparent
+  )
+
+(define/contract (ks-open file)
+  (-> (or/c path? string? symbol?) keystore?)
+  (let ((path (if (symbol? file)
+                  (build-path (find-system-path 'cache-dir) (format "ks-~a.db" file))
+                  (build-path file))))
+    (let ((dbh (sqlite3-connect #:database path #:mode 'create)))
+      (query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar primary key, value varchar, str_key varchar);")
+      (query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(str_key);")
+      (make-keystore file path dbh))))
+
+(define/contract (ks-set! ksh key value)
+  (-> keystore? any/c any/c boolean?)
+   (ks-set!* (keystore-dbh ksh) (value->string key) (format "~a" key) (value->string value)))
+
+(define/contract (ks-exists? ksh key)
+  (-> keystore? any/c boolean?)
+  (ks-exists?* (keystore-dbh ksh) (value->string key)))
+
+(define/contract (ks-get ksh key . default-value)
+  (-> keystore? any/c ... any/c any/c)
+  (ks-get* (keystore-dbh ksh) (value->string key) default-value))
+
+(define/contract (ks-drop! ksh key)
+  (-> keystore? any/c boolean?)
+  (ks-drop!* (keystore-dbh ksh) (value->string key)))
+
+(define/contract (ks-key-values-glob ksh gl)
+  (-> keystore? string? list?)
+  (map (λ (row)
+         (cons (string->value (vector-ref row 0)) (string->value (vector-ref row 1))))
+       (query-rows (keystore-dbh ksh)
+                   "SELECT key, value FROM keystore WHERE str_key GLOB $1"
+                   (string-downcase gl))))
+
+(define/contract (ks-keys-glob ksh sqlite-like)
+  (-> keystore? string? list?)
+  (map (λ (row)
+         (string->value (vector-ref row 0)))
+       (query-rows (keystore-dbh ksh)
+                   "SELECT key FROM keystore WHERE str_key GLOB $1"
+                   (string-downcase sqlite-like))))
+
+(define/contract (ks-keys ksh)
+  (-> keystore? list?)
+  (ks-keys* (keystore-dbh ksh)))
+
+(define/contract (ks-key-values ksh)
+  (-> keystore? list?)
+  (ks-key-values* (keystore-dbh ksh)))
+
+(define/contract (ks-keys-raw ksh)
+  (-> keystore? list?)
+  (map vector->list 
+       (query-rows (keystore-dbh ksh) "SELECT key, str_key FROM keystore")))
+
+(define/contract (ks-key-values-raw ksh)
+  (-> keystore? list?)
+  (map vector->list 
+       (query-rows (keystore-dbh ksh) "SELECT key, str_key, value FROM keystore")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal working
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (ks-set!* dbh key str-key value)
+  (query-exec dbh "INSERT OR REPLACE INTO keystore VALUES($1, $2, $3)"
+              key value (string-downcase str-key))
+  #t)
+
+(define (ks-exists?* dbh key)
+  (> (query-value dbh "SELECT COUNT(*) FROM keystore WHERE key = $1" key) 0))
+
+(define (ks-get* dbh key default-value)
+  (if (ks-exists?* dbh key)
+      (string->value (query-value dbh "SELECT value FROM keystore WHERE key = $1" key))
+      (if (null? default-value)
+          'ks-nil
+          (car default-value))
+      )
+  )
+
+(define (ks-drop!* dbh key)
+  (query-exec dbh "DELETE FROM keystore WHERE key = $1" key)
+  #t)
+
+(define (ks-keys* dbh)
+  (map (λ (row)
+         (string->value (vector-ref row 0)))
+       (query-rows dbh "SELECT key FROM keystore")))
+
+(define (ks-key-values* dbh)
+  (map (λ (row)
+         (cons (string->value (vector-ref row 0))
+               (string->value (vector-ref row 1))))
+       (query-rows dbh "SELECT key, value FROM keystore")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; serialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (value->string v)
+  (call-with-output-string
+   (λ (out) (write (serialize v) out))))
+
+(define (string->value v)
+  (deserialize
+   (call-with-input-string v (λ (in) (read in)))))
+