I've forked the cl-mongo (common lisp MongoDB library) repository from fons, as it has fallen out of maintenance and does not support the SCRAM-SHA-1 login process. This is my fork: https://github.com/mprelude/cl-mongo -- the main changes are adding a dependence on cl-scram (my implementation of SCRAM), and adding a bson binary generic container.
I'm still trying to send the initial message, so the issue isn't that the password is wrong, as that isn't used yet.
Why is this part of the authentication failing? Can anyone confirm if the BINARY-MESSAGE is what I should be sending if I wish to transmit what's in the MESSAGE to mongo?
This is my call, with some added debug output:
* (asdf:load-system :cl-mongo)
T
* (cl-mongo:db.use "test")
"test"
* (cl-mongo:db.auth "aurumrw" "pencil" :mechanism :SCRAM-SHA-1)
(kv-container : #(#S(CL-MONGO::PAIR :KEY saslStart :VALUE 1)
#S(CL-MONGO::PAIR :KEY mechanism :VALUE SCRAM-SHA-1)
#S(CL-MONGO::PAIR
:KEY payload
:VALUE [CL-MONGO::BSON-BINARY-GENERIC] [binary data of type 0] ))
((CL-MONGO::BINARY-MESSAGE
. #(98 105 119 115 98 106 49 104 100 88 74 49 98 88 74 51 76 72 73 57 83 87
116 122 101 84 100 78 101 71 100 97 90 71 52 53 85 69 86 113 87 108 104
85 89 108 78 75 89 106 74 80 79 87 78 84 99 49 108 84 82 68 99 61))
(CL-MONGO::MESSAGE . "n,,n=aurumrw,r=Iksy7MxgZdn9PEjZXTbSJb2O9cSsYSD7")
(CL-MONGO::CODE . 18) (CL-MONGO::OK . 0.0d0)
(CL-MONGO::ERRMSG . "Authentication failed.")))
Notably, I think Mongo must be reading my request correctly as the message is 'Authentication failed' (error code 18), which suggests that it understands that I've requested a SASL conversation.
I believe the issues I'm having are based on the payload, either the content (base64'd initial message, as octets) or the format.
Drawing on the MongoDB documentation, and the way the original discussion worked, this is my rewritten db.auth function:
(defmethod db.auth ((username string) (password string) &key (mongo (mongo)) (mechanism :SCRAM-SHA-1))
(cond ((equal mechanism :SCRAM-SHA-1)
;; SCRAM-SHA-1 Login
(let* ((nonce (cl-scram:gen-client-nonce))
(pwd (concatenate 'string username ":mongo:" password))
(md5-pwd (hex-md5 pwd))
(md5-pwd-str (ironclad:byte-array-to-hex-string md5-pwd))
(initial-message (cl-scram:gen-client-initial-message :username username
:nonce nonce))
(request (kv (kv "saslStart" 1)
(kv "mechanism" "SCRAM-SHA-1")
(kv "payload"
(bson-binary :generic (ironclad:ascii-string-to-byte-array
(cl-scram:base64-encode initial-message))))))
(response (car (docs (db.find "$cmd" request :limit 1 :mongo mongo))))
(retval (pairlis '(errmsg ok code message binary-message)
(list (get-element "errmsg" response)
(get-element "ok" response)
(get-element "code" response)
initial-message
(ironclad:ascii-string-to-byte-array (cl-scram:base64-encode initial-message))))))
(list request retval)))
((equal mechanism :MONGODB-CR)
;; MONGODB-CR Login.
(let* ((nonce (get-element "nonce" (car (docs (db.run-command 'getnonce :mongo mongo)))))
(pwd (concatenate 'string username ":mongo:" password))
(md5-pwd (hex-md5 pwd))
(md5-pwd-str (ironclad:byte-array-to-hex-string md5-pwd))
(md5-key (hex-md5 (concatenate 'string nonce username md5-pwd-str)))
(md5-key-str (ironclad:byte-array-to-hex-string md5-key))
(request (kv (kv "authenticate" 1)
(kv "user" username)
(kv "nonce" nonce)
(kv "key" md5-key-str)))
(retval (get-element "ok" (car (docs (db.find "$cmd" request :limit 1 :mongo mongo))))))
(if retval t nil)))
(t nil)))