127 lines
4.5 KiB
Racket
127 lines
4.5 KiB
Racket
#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")))))))
|