suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db: added ssl support for mysql connections

Browse Source
This commit is contained in:
Ryan Culpepper 2011-09-24 01:34:30 -06:00
parent 247a51d5bd
commit 36149b92a7
9 changed files with 56 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/db/main.rkt
View File

@ -52,6 +52,8 @@
#:server (or/c string? #f)
#:port (or/c exact-positive-integer? #f)
#:socket (or/c path-string? 'guess #f)
#:ssl (or/c 'yes 'no 'optional)
#:ssl-context ssl-client-context?
#:notice-handler (or/c 'output 'error output-port? procedure?))
connection?)]
[mysql-guess-socket-path

3
collects/db/mysql.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require racket/contract
openssl
"base.rkt"
"private/mysql/main.rkt")
@ -12,6 +13,8 @@
#:server (or/c string? #f)
#:port (or/c exact-positive-integer? #f)
#:socket (or/c path-string? 'guess #f)
#:ssl (or/c 'yes 'no 'optional)
#:ssl-context ssl-client-context?
#:notice-handler (or/c 'output 'error output-port? procedure?))
connection?)]
[mysql-guess-socket-path

2
collects/db/private/generic/dsn.rkt
View File

@ -190,7 +190,7 @@ considered important.
(define mysql-data-source
(mk-specialized 'mysql-data-source 'mysql 0
'(#:user #:database #:password #:server #:port #:socket
'(#:user #:database #:password #:server #:port #:socket #:ssl
#:notice-handler)))
(define sqlite3-data-source

31
collects/db/private/mysql/connection.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/class
racket/match
openssl
openssl/sha1
"../generic/interfaces.rkt"
"../generic/prepared.rkt"
@ -180,7 +181,7 @@
(set! outport out))
;; start-connection-protocol : string string string/#f -> void
(define/public (start-connection-protocol dbname username password)
(define/public (start-connection-protocol dbname username password ssl ssl-context)
(with-disconnect-on-error
(fresh-exchange)
(let ([r (recv 'mysql-connect 'handshake)])
@ -189,9 +190,24 @@
(check-required-flags capabilities)
(unless (equal? auth "mysql_native_password")
(uerror 'mysql-connect "unsupported authentication plugin: ~s" auth))
(define do-ssl?
(and (case ssl ((yes optional) #t) ((no) #f))
(memq 'ssl capabilities)))
(when (and (eq? ssl 'yes) (not do-ssl?))
(uerror 'mysql-connect "server refused SSL connection"))
(when do-ssl?
(send-message
(make-abbrev-client-authentication-packet
(desired-capabilities capabilities #t)))
(let-values ([(sin sout)
(ports->ssl-ports inport outport
#:mode 'connect
#:context ssl-context
#:close-original? #t)])
(attach-to-ports sin sout)))
(send-message
(make-client-authentication-packet
(desired-capabilities capabilities)
(desired-capabilities capabilities do-ssl?)
MAX-PACKET-LENGTH
'utf8-general-ci ;; charset
username
@ -208,10 +224,13 @@
rf)))
REQUIRED-CAPABILITIES))
(define/private (desired-capabilities capabilities)
(cons 'interactive
(filter (lambda (c) (memq c DESIRED-CAPABILITIES))
capabilities)))
(define/private (desired-capabilities capabilities ssl?)
(let ([base
(cons 'interactive
(filter (lambda (c) (memq c DESIRED-CAPABILITIES))
capabilities))])
(cond [ssl? (cons 'ssl base)]
[else base])))
;; expect-auth-confirmation : -> void
(define/private (expect-auth-confirmation)

8
collects/db/private/mysql/main.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/class
racket/tcp
openssl
file/sha1
"../generic/interfaces.rkt"
"../generic/socket.rkt"
@ -15,6 +16,11 @@
#:server [server #f]
#:port [port #f]
#:socket [socket #f]
#:ssl [ssl 'no]
#:ssl-context [ssl-context
(case ssl
((no) #f)
(else (ssl-make-client-context 'tls)))]
#:notice-handler [notice-handler void])
(let ([connection-options
(+ (if (or server port) 1 0)
@ -36,7 +42,7 @@
[port (or port 3306)])
(let-values ([(in out) (tcp-connect server port)])
(send c attach-to-ports in out)))])
(send c start-connection-protocol database user password)
(send c start-connection-protocol database user password ssl ssl-context)
c))
;; make-print-notification : output-port -> number string -> void

7
collects/db/private/mysql/message.rkt
View File

@ -15,6 +15,7 @@ Based on protocol documentation here:
packet?
(struct-out handshake-packet)
(struct-out client-authentication-packet)
(struct-out abbrev-client-authentication-packet)
(struct-out command-packet)
(struct-out command:statement-packet)
(struct-out command:change-user-packet)
@ -209,6 +210,10 @@ Based on protocol documentation here:
database)
#:transparent)
(define-struct (abbrev-client-authentication-packet packet)
(client-flags)
#:transparent)
(define-struct (command-packet packet)
(command
argument)
@ -311,6 +316,8 @@ Based on protocol documentation here:
(define (write-packet* out p)
(match p
[(struct abbrev-client-authentication-packet (client-flags))
(io:write-le-int32 out (encode-server-flags client-flags))]
[(struct client-authentication-packet
(client-flags max-length charset user scramble database))
(io:write-le-int32 out (encode-server-flags client-flags))

6
collects/db/private/postgresql/connection.rkt
View File

@ -3,7 +3,7 @@
racket/match
racket/vector
file/md5
openssl/mzssl
openssl
"../generic/interfaces.rkt"
"../generic/sql-data.rkt"
"../generic/prepared.rkt"
@ -127,7 +127,7 @@
(disconnect* #f)
(uerror fsym
(string-append
"backend attempted to change the client character encoding "
"server attempted to change the client character encoding "
"from UTF8 to ~a, disconnecting")
value))]
[else (void)])]))
@ -509,7 +509,7 @@
;; Backend gracefully declined
(void (read-byte in))
(unless (eq? ssl 'optional)
(error 'postgresql-connect "backend refused SSL connection"))
(error 'postgresql-connect "server refused SSL connection"))
(super attach-to-ports in out))
((#\E)
(let ([r (parse-server-message in)])

5
collects/db/private/postgresql/main.rkt
View File

@ -17,7 +17,10 @@
#:socket [socket #f]
#:allow-cleartext-password? [allow-cleartext-password? #f]
#:ssl [ssl 'no]
#:ssl-context [ssl-context (ssl-make-client-context 'sslv3)]
#:ssl-context [ssl-context
(case ssl
((no) #f)
(else (ssl-make-client-context 'sslv3)))]
#:notice-handler [notice-handler void]
#:notification-handler [notification-handler void])
(let ([connection-options

4
collects/db/scribblings/connect.scrbl
View File

@ -148,6 +148,9 @@ Base connections are made using the following functions.
[#:server server string? "localhost"]
[#:port port exact-positive-integer? 3306]
[#:socket socket (or/c path-string? #f) #f]
[#:ssl ssl (or/c 'yes 'optional 'no) 'no]
[#:ssl-context ssl-context ssl-client-context?
(ssl-make-client-context 'tls)]
[#:password password (or/c string? #f) #f]
[#:notice-handler notice-handler
(or/c 'output 'error output-port?
@ -624,6 +627,7 @@ ODBC's DSNs.
[#:server server string? @#,absent]
[#:port port exact-positive-integer? @#,absent]
[#:socket socket (or/c path-string? 'guess #f) @#,absent]
[#:ssl ssl (or/c 'yes 'optional 'no) @#,absent]
[#:password password (or/c string? #f) @#,absent]
[#:notice-handler notice-handler (or/c 'output 'error) @#,absent])
data-source?]