Files
racket-wiki/private/database.rkt
T

135 lines
4.9 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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")))))))