db: allow mysql-connect without db

collects/db/base.rkt

@@ -224,7 +224,7 @@
  [mysql-data-source
   (->* ()
        (#:user string?
-        #:database string?
+        #:database (or/c string? #f)
         #:server string?
         #:port exact-positive-integer?
         #:socket (or/c string? 'guess)

collects/db/main.rkt

@@ -46,9 +46,9 @@
 
  ;; Duplicates contracts at mysql.rkt
  [mysql-connect
-  (->* (#:user string?
-        #:database string?)
-       (#:password (or/c string? (list/c 'hash string?) #f)
+  (->* (#:user string?)
+       (#:database (or/c string? #f)
+        #:password (or/c string? (list/c 'hash string?) #f)
         #:server (or/c string? #f)
         #:port (or/c exact-positive-integer? #f)
         #:socket (or/c path-string? 'guess #f)

collects/db/mysql.rkt

@@ -7,9 +7,9 @@
 ;; FIXME: Contracts duplicated at main.rkt
 (provide/contract
  [mysql-connect
-  (->* (#:user string?
-        #:database string?)
-       (#:password (or/c string? (list/c 'hash string?) #f)
+  (->* (#:user string?)
+       (#:database (or/c string? #f)
+        #:password (or/c string? (list/c 'hash string?) #f)
         #:server (or/c string? #f)
         #:port (or/c exact-positive-integer? #f)
         #:socket (or/c path-string? 'guess #f)

collects/db/private/mysql/connection.rkt

@@ -184,7 +184,7 @@
       (set! inport in)
       (set! outport out))
 
-    ;; start-connection-protocol : string string string/#f -> void
+    ;; start-connection-protocol : string/#f string string/#f -> void
     (define/public (start-connection-protocol dbname username password ssl ssl-context)
       (with-disconnect-on-error
         (fresh-exchange)
@@ -199,11 +199,9 @@
                     (memq 'ssl capabilities)))
              (when (and (eq? ssl 'yes) (not do-ssl?))
                (uerror 'mysql-connect "server refused SSL connection"))
-             (define wanted-capabilities (desired-capabilities capabilities do-ssl?))
+             (define wanted-capabilities (desired-capabilities capabilities do-ssl? dbname))
              (when do-ssl?
-               (send-message
-                (make-abbrev-client-auth-packet
-                 wanted-capabilities))
+               (send-message (make-abbrev-client-auth-packet wanted-capabilities))
                (let-values ([(sin sout)
                              (ports->ssl-ports inport outport
                                                #:mode 'connect
@@ -244,13 +242,11 @@
                             rf)))
                 REQUIRED-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])))
+    (define/private (desired-capabilities capabilities ssl? dbname)
+      (append (if ssl?   '(ssl)             '())
+              (if dbname '(connect-with-db) '())
+              '(interactive)
+              (filter (lambda (c) (memq c DESIRED-CAPABILITIES)) capabilities)))
 
     ;; Set connection to use utf8 encoding
     (define/private (after-connect)
@@ -576,7 +572,6 @@
     transactions
     protocol-41
     secure-connection
-    connect-with-db
     plugin-auth))
 
 ;; raise-backend-error : symbol ErrorPacket -> raises exn

collects/db/private/mysql/main.rkt

@@ -11,7 +11,7 @@
          mysql-password-hash)
 
 (define (mysql-connect #:user user
-                       #:database database
+                       #:database [database #f]
                        #:password [password #f]
                        #:server [server #f]
                        #:port [port #f]

collects/db/private/mysql/message.rkt

@@ -343,9 +343,9 @@ Based on protocol documentation here:
      (io:write-bytes out (make-bytes 23 0))
      (io:write-null-terminated-string out user)
      (cond [(memq 'secure-connection client-flags)
-            (io:write-length-coded-bytes out scramble)]
+            (io:write-length-coded-bytes out (or scramble #""))]
            [else ;; old-style scramble is *not* length-coded, but \0-terminated
-            (io:write-bytes out scramble)])
+            (io:write-bytes out (or scramble (bytes 0)))])
      (when (memq 'connect-with-db client-flags)
        (io:write-null-terminated-string out database))
      (when (memq 'plugin-auth client-flags)

collects/db/scribblings/connect.scrbl

@@ -144,7 +144,7 @@ Base connections are made using the following functions.
 }
 
 @defproc[(mysql-connect [#:user user string?]
-                  [#:database database string?]
+                  [#:database database (or/c string? #f) #f]
                   [#:server server string? "localhost"]
                   [#:port port exact-positive-integer? 3306]
                   [#:socket socket (or/c path-string? #f) #f]
@@ -158,12 +158,16 @@ Base connections are made using the following functions.
                    void])
          connection?]{
 
-  Creates a connection to a MySQL server. The meaning of the keyword
-  arguments is similar to those of the @racket[postgresql-connect]
-  function, except that the first argument to a
-  @racket[notice-handler] function is a MySQL-specific integer code
-  rather than a SQLSTATE string, and a @racket[socket] argument of
-  @racket['guess] is the same as supplying
+  Creates a connection to a MySQL server. If @racket[database] is
+  @racket[#f], the connection is established without setting the
+  current database; it should be subsequently set with the @tt{USE}
+  SQL command.
+
+  The meaning of the other keyword arguments is similar to those of
+  the @racket[postgresql-connect] function, except that the first
+  argument to a @racket[notice-handler] function is a MySQL-specific
+  integer code rather than a SQLSTATE string, and a @racket[socket]
+  argument of @racket['guess] is the same as supplying
   @racket[(mysql-guess-socket-path)].
 
   If the connection cannot be made, an exception is raised.