From 84711388e9399e3cf18c865b456e4099a903651f Mon Sep 17 00:00:00 2001 From: muyinliu Date: Sat, 5 Feb 2022 11:28:18 +0800 Subject: [PATCH] Support auth with SCRAM-SHA-1(default authentication mechanism in MongoDB 3.0+) --- README.md | 6 +- cl-mongo.asd | 66 ++++++++++---------- src/bson-decode.lisp | 2 +- src/db.lisp | 144 +++++++++++++++++++++++++++++++------------ 4 files changed, 140 insertions(+), 78 deletions(-) diff --git a/README.md b/README.md index 8094404..1c08b33 100644 --- a/README.md +++ b/README.md @@ -783,10 +783,10 @@ Generate a time stamp the mongo/bson protocol understands. -


[Generic function]
db.auth username password &key mongo => result +


[Generic function]
db.auth username password &key mongo mechanism => result


-authenticate a user with a password +authenticate a user with a password, default mechanism is :SCRAM-SHA-1
@@ -1560,4 +1560,4 @@ This documentation was prepared with BACK TO MY HOMEPAGE - \ No newline at end of file + diff --git a/cl-mongo.asd b/cl-mongo.asd index 40046f5..161b43f 100644 --- a/cl-mongo.asd +++ b/cl-mongo.asd @@ -11,42 +11,42 @@ :licence "MIT" :description "lisp system to interact with mongodb, a non-sql db" :depends-on (:uuid - :babel - :bordeaux-threads - :documentation-template - :lisp-unit - :parenscript - :split-sequence - :usocket + :babel + :bordeaux-threads + :documentation-template + :lisp-unit + :parenscript + :split-sequence + :usocket :cl-scram) :serial t :components - ((:module "src" + ((:module "src" :serial t :components ((:file "packages") - (:file "octets") - (:file "pair") - (:file "encode-float") - (:file "bson-oid") - (:file "bson-binary") - (:file "bson-time") - (:file "bson-regex") - (:file "bson-code") - (:file "bson") - (:file "bson-decode") - (:file "bson-array") - (:file "document") - (:file "mongo-syntax") - (:file "java-script") - (:file "bson-encode-container") - (:file "protocol") - (:file "mongo") - (:file "db") - (:file "mem") - (:file "do-query") - (:file "doc") - (:file "map-reduce") - (:file "shell"))) + (:file "octets") + (:file "pair") + (:file "encode-float") + (:file "bson-oid") + (:file "bson-binary") + (:file "bson-time") + (:file "bson-regex") + (:file "bson-code") + (:file "bson") + (:file "bson-decode") + (:file "bson-array") + (:file "document") + (:file "mongo-syntax") + (:file "java-script") + (:file "bson-encode-container") + (:file "protocol") + (:file "mongo") + (:file "db") + (:file "mem") + (:file "do-query") + (:file "doc") + (:file "map-reduce") + (:file "shell"))) (:static-file "README.md") (:static-file "COPYING"))) @@ -62,5 +62,5 @@ ((:module "test" :serial t :components ((:file "package") - (:file "test-utils") - (:file "regression"))))) + (:file "test-utils") + (:file "regression"))))) diff --git a/src/bson-decode.lisp b/src/bson-decode.lisp index 55825b1..0e75c49 100644 --- a/src/bson-decode.lisp +++ b/src/bson-decode.lisp @@ -60,7 +60,7 @@ (size (if (eql type #x02) (octet-to-int32.1 array (+ pos 5)) (octet-to-int32.1 array pos))) - (offset (if (eql type #x02) 9 5)) + (offset (+ pos (if (eql type #x02) 9 5))) (binary (bson-binary type (subseq array offset (+ offset size))))) (setf (gethash key ht) binary) (incf pos totalsize))) diff --git a/src/db.lisp b/src/db.lisp index dbc1811..380690f 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -26,13 +26,15 @@ mongo documentation. (defmethod db.find ((collection string) (kv t) &key (mongo (mongo)) (options 0) (skip 0) (limit 1) (selector nil)) (labels ((query () - (mongo-message mongo (mongo-query - (full-collection-name mongo collection) kv - :limit limit - :skip skip - :selector (bson-encode-container (expand-selector selector)) - :options options)))) - (multiple-value-bind (header docs) (mongo-reply (query)) + (mongo-message mongo + (mongo-query + (full-collection-name mongo collection) kv + :limit limit + :skip skip + :selector (bson-encode-container (expand-selector selector)) + :options options)))) + (multiple-value-bind (header docs) + (mongo-reply (query)) (list (append header (list collection)) docs)))) (defmethod db.find ((collection symbol) (kv t) @@ -62,9 +64,13 @@ mongo documentation. :mongo mongo :options options :skip skip :limit limit :selector selector)) (defmethod db.find ((collection string) (kv kv-container) - &key (mongo (mongo)) (options 0) (skip 0) (limit 1) (selector nil)) + &key (mongo (mongo)) (options 0) (skip 0) (limit 1) (selector nil)) (db.find collection (bson-encode-container kv) - :mongo mongo :options options :skip skip :limit limit :selector selector)) + :mongo mongo + :options options + :skip skip + :limit limit + :selector selector)) (defmacro db.sort (collection query &rest args) "sort macro : Takes the same arguments and keywords as db.find but converts the query @@ -405,40 +411,96 @@ all the documents in the collection. (defgeneric db.auth (username password &key) (:documentation "authenticate a user with a password")) -(defmethod db.auth ((username string) (password string) &key (mongo (mongo)) (mechanism :SCRAM-SHA-1)) +(defun auth-scram-start (username) + (let* ((client-nonce (cl-scram:gen-client-nonce)) + (first-bare (cl-scram:gen-client-initial-message :username username + :nonce client-nonce)) + (request (kv (kv "saslStart" 1) + (kv "mechanism" "SCRAM-SHA-1") + (kv "payload" + (bson-binary :generic (ironclad:ascii-string-to-byte-array + first-bare))) + (kv "autoAuthorize" 1) + (kv "options" (kv "skipEmptyExchange" t))))) + (values client-nonce + first-bare + request))) + +(defun auth-scram-sha-1 (username password &key mongo) + "SCRAM-SHA-1 auth detail see: + - http://www.alienfactory.co.uk/articles/mongodb-scramsha1-over-sasl recommended + - https://github.com/mongodb/mongo-python-driver/blob/master/pymongo/auth.py#L181 _authenticate_scram" + (multiple-value-bind (client-nonce first-bare request) + (auth-scram-start username) + (let ((response (car (docs (db.find "$cmd" request :limit 1 :mongo mongo))))) + (when (= 1 + (get-element "ok" response)) + (let* ((payload (babel:octets-to-string (data (get-element "payload" response)))) + (client-final-message (cl-scram:gen-client-final-message + :username username + :password password + :client-nonce client-nonce + :client-initial-message first-bare + :server-response payload)) + (server-signature (rest (assoc 'cl-scram::server-signature client-final-message))) + (final-message (rest (assoc 'cl-scram::final-message client-final-message))) + (request (kv (kv "saslContinue" 1) + (kv "conversationId" (get-element "conversationId" response)) + (kv "payload" + (bson-binary :generic (ironclad:ascii-string-to-byte-array + final-message)))))) + (let ((response (car (docs (db.find "$cmd" + request + :limit 1 + :mongo mongo))))) + (if (get-element "done" response) + (and (= 1 + (get-element "ok" response)) + (equal server-signature + (cl-scram:parse-server-signature + :response + (babel:octets-to-string + (data + (get-element "payload" response)))))) + ;; A third empty challenge may be required if the server does not support + ;; skipEmptyExchange: SERVER-44857. + (let* ((request (kv (kv "saslContinue" 1) + (kv "conversationId" (get-element "conversationId" response)) + (kv "payload" + (bson-binary :generic (ironclad:ascii-string-to-byte-array + ""))))) + (response (car (docs (db.find "$cmd" + request + :limit 1 + :mongo mongo))))) + (get-element "done" response))))))))) + +(defun auth-mongodb-cr (username password &key mongo) + (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)))) + (= 1 + (get-element "ok" + (car (docs (db.find "$cmd" + request + :limit 1 + :mongo mongo))))))) + +(defmethod db.auth ((username string) (password string) + &key + (mongo (mongo)) + (mechanism :SCRAM-SHA-1)) (cond ((equal mechanism :SCRAM-SHA-1) - (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))) + (auth-scram-sha-1 username password :mongo mongo)) ((equal mechanism :MONGODB-CR) - (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))) + (auth-mongodb-cr username password :mongo mongo)) (t nil))) ;;(db.find "$cmd" (kv (kv "count" "foo") (kv "query" (kv nil nil)) (kv "fields" (kv nil nil))))