diff --git a/collects/db/private/mysql/connection.rkt b/collects/db/private/mysql/connection.rkt index a57070c529..5f5d44b3d9 100644 --- a/collects/db/private/mysql/connection.rkt +++ b/collects/db/private/mysql/connection.rkt @@ -79,8 +79,6 @@ (define r (with-disconnect-on-error (recv* fsym expectation field-dvecs))) - (when DEBUG-RESPONSES - (eprintf " << ~s\n" r)) (when (error-packet? r) (raise-backend-error fsym r)) r) @@ -95,6 +93,8 @@ (error/comm fsym)) (let-values ([(msg-num next) (parse-packet inport expectation field-dvecs)]) (set! next-msg-num (add1 msg-num)) + (when DEBUG-RESPONSES + (eprintf " << ~s\n" next)) ;; Update transaction status (see Transactions below) (when (ok-packet? next) (set! tx-status @@ -127,6 +127,8 @@ (advance 'prep-params)] [(? eof-packet?) (advance 'field 'data 'binary-data 'prep-params)] + [(struct unknown-packet (expected contents)) + (error/comm fsym expected)] [else (err next)]) next)) diff --git a/collects/db/private/mysql/main.rkt b/collects/db/private/mysql/main.rkt index 2eb68e3bce..21e47e28a1 100644 --- a/collects/db/private/mysql/main.rkt +++ b/collects/db/private/mysql/main.rkt @@ -21,7 +21,8 @@ (case ssl ((no) #f) (else (ssl-make-client-context 'tls)))] - #:notice-handler [notice-handler void]) + #:notice-handler [notice-handler void] + #:debug? [debug? #f]) (let ([connection-options (+ (if (or server port) 1 0) (if socket 1 0))]) @@ -31,6 +32,7 @@ (cond [(procedure? notice-handler) notice-handler] [else (make-print-notice notice-handler)])] [c (new connection% (notice-handler notice-handler))]) + (when debug? (send c debug #t)) (cond [socket (let ([socket (if (eq? socket 'guess) (mysql-guess-socket-path) diff --git a/collects/db/private/mysql/message.rkt b/collects/db/private/mysql/message.rkt index 5570860bec..87ed5838cb 100644 --- a/collects/db/private/mysql/message.rkt +++ b/collects/db/private/mysql/message.rkt @@ -30,6 +30,7 @@ Based on protocol documentation here: (struct-out parameter-packet) (struct-out long-data-packet) (struct-out execute-packet) + (struct-out unknown-packet) supported-result-typeid? parse-field-dvec @@ -305,6 +306,11 @@ Based on protocol documentation here: params) #:transparent) +(define-struct (unknown-packet packet) + (expected + contents) + #:transparent) + (define (write-packet out p number) (let ([o (open-output-bytes)]) (write-packet* o p) @@ -382,13 +388,15 @@ Based on protocol documentation here: ((handshake) (parse-handshake-packet in len)) ((auth) - (unless (eq? (peek-byte in) #x00) - (error/comm 'parse-packet "(expected authentication ok packet)")) - (parse-ok-packet in len)) + (cond [(eq? (peek-byte in) #x00) + (parse-ok-packet in len)] + [else + (parse-unknown-packet in len "(expected authentication ok packet)")])) ((ok) - (unless (eq? (peek-byte in) #x00) - (error/comm 'parse-packet "(expected ok packet)")) - (parse-ok-packet in len)) + (cond [(eq? (peek-byte in) #x00) + (parse-ok-packet in len)] + [else + (parse-unknown-packet in len "(expected ok packet)")])) ((result) (if (eq? (peek-byte in) #x00) (parse-ok-packet in len) @@ -406,7 +414,10 @@ Based on protocol documentation here: (parse-eof-packet in len) (parse-binary-row-data-packet in len field-dvecs))) ((prep-ok) - (parse-ok-prepared-statement-packet in len)) + (cond [(eq? (peek-byte in) #x00) + (parse-ok-prepared-statement-packet in len)] + [else + (parse-unknown-packet in len "(expected ok for prepared statement packet)")])) ((prep-params) (if (and (eq? (peek-byte in) #xFE) (< len 9)) (parse-eof-packet in len) @@ -416,6 +427,9 @@ Based on protocol documentation here: ;; Individual parsers +(define (parse-unknown-packet in len expected) + (make-unknown-packet expected (io:read-bytes-to-eof in))) + (define (parse-handshake-packet in len) (let* ([protocol-version (io:read-byte in)] [server-version (io:read-null-terminated-string in)]