Initial import

2026-08-14 21:47:23 +02:00
parent 8538f57678
commit 40ad35b418
22 changed files with 5319 additions and 1 deletions
@@ -0,0 +1,126 @@
+#lang racket/base
+
+(require db
+         racket/file
+         racket/port
+         "config.rkt"
+         "migrations.rkt")
+
+(provide (struct-out database-settings)
+         database-settings-exist?
+         read-database-settings
+         write-database-settings!
+         test-database-settings!
+         call-with-wiki-database
+         initialize-database!
+         initialize-database-with-settings!
+         database-ready?)
+
+(struct database-settings (server port database user password ssl) #:transparent)
+
+(define (database-settings-exist? config)
+  (file-exists? (database-config-path config)))
+
+(define (settings->datum settings)
+  (hash 'server (database-settings-server settings)
+        'port (database-settings-port settings)
+        'database (database-settings-database settings)
+        'user (database-settings-user settings)
+        'password (database-settings-password settings)
+        'ssl (database-settings-ssl settings)))
+
+(define (datum->settings value)
+  (database-settings (hash-ref value 'server "localhost")
+                     (hash-ref value 'port 5432)
+                     (hash-ref value 'database "racket_wiki")
+                     (hash-ref value 'user "")
+                     (hash-ref value 'password "")
+                     (hash-ref value 'ssl 'no)))
+
+(define (read-database-settings config)
+  (and (database-settings-exist? config)
+       (call-with-input-file (database-config-path config)
+         (λ (in)
+           (datum->settings (read in))))))
+
+(define (write-database-settings! config settings)
+  (make-directory* (wiki-config-data-dir config))
+  (call-with-output-file (database-config-path config)
+    (λ (out)
+      (write (settings->datum settings) out)
+      (newline out))
+    #:exists 'truncate/replace)
+  (with-handlers ((exn:fail? (λ (_e) (void))))
+    (file-or-directory-permissions (database-config-path config) #o600))
+  (void))
+
+(define (connect settings)
+  (define password
+    (if (string=? (database-settings-password settings) "")
+        #f
+        (database-settings-password settings)))
+  (postgresql-connect #:server (database-settings-server settings)
+                      #:port (database-settings-port settings)
+                      #:database (database-settings-database settings)
+                      #:user (database-settings-user settings)
+                      #:password password
+                      #:ssl (database-settings-ssl settings)))
+
+(define (test-database-settings! settings)
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (query-value db "SELECT 1"))
+   (λ () (disconnect db)))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run a procedure with a fresh PostgreSQL connection.
+; pre    : PostgreSQL settings have been saved and proc accepts one connection.
+; post   : The connection is closed after proc returns or raises.
+; result : The value returned by proc.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (call-with-wiki-database config proc)
+  (define settings (read-database-settings config))
+  (unless settings
+    (error 'call-with-wiki-database "PostgreSQL is not configured"))
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (proc db))
+   (λ () (disconnect db))))
+
+(define (initialize-on-connection! db config)
+  (migrate-database! db config)
+  (query-exec db "DELETE FROM sessions WHERE expires_at <= $1" (current-seconds))
+  (void))
+
+(define (initialize-database-with-settings! settings config)
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (initialize-on-connection! db config))
+   (λ () (disconnect db))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Initialize the PostgreSQL schema used by racket-wiki.
+; pre    : Valid PostgreSQL settings have been saved.
+; post   : All wiki tables and indexes exist and expired sessions are removed.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (initialize-database! config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (initialize-on-connection! db config))))
+
+(define (database-ready? config)
+  (and (database-settings-exist? config)
+       (with-handlers ((exn:fail? (λ (_e) #f)))
+         (call-with-wiki-database
+          config
+          (λ (db)
+            (and (query-value db "SELECT to_regclass('public.users') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.pages') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.page_versions') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.sessions') IS NOT NULL")))))))