#lang racket/base
(require racket/class
racket/contract
racket/tcp
"../generic/main.rkt"
(only-in "../generic/interfaces.rkt" make-handler)
"../generic/socket.rkt"
"../generic/find-socket.rkt"
"connection.rkt"
"dbsystem.rkt")
(provide postgresql-connect
postgresql-guess-socket-path
(rename-out [dbsystem postgresql-dbsystem]))
(define (postgresql-connect #:user user
#:database database
#:password [password #f]
#:server [server #f]
#:port [port #f]
#:socket [socket #f]
#:input-port [input-port #f]
#:output-port [output-port #f]
#:allow-cleartext-password? [allow-cleartext-password? #f]
#:ssl [ssl 'no]
#:ssl-encrypt [ssl-encrypt 'sslv2-or-v3]
#:notice-handler [notice-handler void]
#:notification-handler [notification-handler void])
(let ([connection-options
(+ (if (or server port) 1 0)
(if socket 1 0)
(if (or input-port output-port) 1 0))]
[notice-handler (make-handler notice-handler "notice")]
[notification-handler
(if (procedure? notification-handler)
notification-handler
(make-print-notification notification-handler))])
(when (> connection-options 1)
(raise-user-error 'connect
(string-append
"cannot specify more than one of server/port, "
"socket, or input-port/output-port arguments")))
(when (or input-port output-port)
(unless (and input-port output-port)
(raise-user-error 'connect
"must give input-port and output-port arguments together")))
(let ([c (new connection%
(notice-handler notice-handler)
(notification-handler notification-handler)
(allow-cleartext-password? allow-cleartext-password?))])
(let-values ([(in out)
(cond [socket (unix-socket-connect socket)]
[input-port (values input-port output-port)]
[else (let ([server (or server "localhost")]
[port (or port 5432)])
(tcp-connect server port))])])
(send c attach-to-ports in out ssl ssl-encrypt)
(send c start-connection-protocol database user password)
c))))
(define socket-paths
'("/var/run/postgresql/.s.PGSQL.5432"))
(define (postgresql-guess-socket-path)
(guess-socket-path/paths 'postgresql-guess-socket-path socket-paths))
(define ((make-print-notification out) condition)
(fprintf (case out
((output) (current-output-port))
((error) (current-error-port))
(else out))
"notification: ~a\n" condition))