172 lines
7.2 KiB
Racket
172 lines
7.2 KiB
Racket
#lang racket/base
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; PostgreSQL connection settings and database initialization.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Supporting functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Check whether PostgreSQL settings have been saved.
|
|
; pre : config is a wiki-config value.
|
|
; post : The settings path has only been inspected.
|
|
; result : #t when database.rktd exists, otherwise #f.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Read the saved PostgreSQL connection settings.
|
|
; pre : config is a wiki-config value.
|
|
; post : The settings file, when present, has only been read.
|
|
; result : A database-settings value, or #f when no settings file exists.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (read-database-settings config)
|
|
(and (database-settings-exist? config)
|
|
(call-with-input-file (database-config-path config)
|
|
(λ (in)
|
|
(datum->settings (read in))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Persist PostgreSQL connection settings.
|
|
; pre : config and settings are wiki-config and database-settings values.
|
|
; post : database.rktd contains settings and is private where supported.
|
|
; result : void.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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)
|
|
(let ((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))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Verify that supplied PostgreSQL settings can execute a query.
|
|
; pre : settings is a database-settings value for a reachable database.
|
|
; post : The temporary connection is closed on success or failure.
|
|
; result : void, or a database exception when validation fails.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (test-database-settings! settings)
|
|
(let ((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)
|
|
(let ((settings (read-database-settings config)))
|
|
(unless settings
|
|
(error 'call-with-wiki-database "PostgreSQL is not configured"))
|
|
(let ((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))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Initialize the wiki schema using explicit PostgreSQL settings.
|
|
; pre : settings can connect to a writable PostgreSQL database.
|
|
; post : Migrations are complete, expired sessions are removed and the connection is closed.
|
|
; result : void.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (initialize-database-with-settings! settings config)
|
|
(let ((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))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Check whether the configured database has the required core tables.
|
|
; pre : config is a wiki-config value.
|
|
; post : The database is unchanged and every temporary connection is closed.
|
|
; result : #t when settings and core tables are available, otherwise #f.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(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.concept_maps') IS NOT NULL")
|
|
(query-value db "SELECT to_regclass('public.sessions') IS NOT NULL")))))))
|