db: improved message debugging for mysql

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))

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)

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)
+     (cond [(eq? (peek-byte in) #x00)
-       (error/comm 'parse-packet "(expected authentication ok packet)"))
+            (parse-ok-packet in len)]
-     (parse-ok-packet in len))
+           [else
+            (parse-unknown-packet in len "(expected authentication ok packet)")]))
     ((ok)
-     (unless (eq? (peek-byte in) #x00)
+     (cond [(eq? (peek-byte in) #x00)
-       (error/comm 'parse-packet "(expected ok packet)"))
+            (parse-ok-packet in len)]
-     (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)]