Support auth with SCRAM-SHA-1(default authentication mechanism in MongoDB 3.0+)

README.md

@@ -783,10 +783,10 @@ Generate a time stamp the mongo/bson protocol understands.
 
 
 
-<p><br>[Generic function]<br><a class=none name='db.auth'><b>db.auth</b> <i>username password <tt>&amp;key</tt> mongo</i> =&gt; <i>result</i></a>
+<p><br>[Generic function]<br><a class=none name='db.auth'><b>db.auth</b> <i>username password <tt>&amp;key</tt> mongo mechanism</i> =&gt; <i>result</i></a>
 <blockquote><br>
 
-authenticate a user with a password
+authenticate a user with a password, default <i>mechanism</i> is <b>:SCRAM-SHA-1</b>
 
 </blockquote>
 
@@ -1560,4 +1560,4 @@ This documentation was prepared with <a href="http://weitz.de/documentation-temp
 $Header: /usr/local/cvsrep/documentation-template/output.lisp,v 1.14 2008/05/29 08:23:37 edi Exp $
 <p><a href="http://www.mohegan-skunkworks.com/index.html">BACK TO MY HOMEPAGE</a>
 
-</body>
+</body>

cl-mongo.asd

@@ -11,41 +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"
+  :components
+  ((: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")))
 
@@ -57,19 +58,9 @@
   :description "testing cl-mongo"
   :depends-on (:cl-mongo)
   :serial t
-  :components 
+  :components
   ((:module "test"
     :serial t
     :components ((:file "package")
-		 (:file "test-utils")
-		 (:file "regression")))))
-
-
-
-
-
-
-
-
-
-
+                 (:file "test-utils")
+                 (:file "regression")))))

src/bson-binary.lisp

@@ -11,6 +11,10 @@
   ((data :reader data :initarg :data))
   (:documentation "bson binary type; this is the base class."))
 
+(defclass bson-binary-generic (bson-binary-base)
+  ((type-id :reader type-id :initform +bson-binary-generic+))
+  (:documentation "bson generic binary type"))
+
 (defclass bson-binary-function (bson-binary-base)
   ((type-id :reader type-id :initform +bson-binary-function+))
   (:documentation "bson function binary type"))
@@ -33,7 +37,13 @@
 
 (defgeneric bson-binary (type data)
   (:documentation "Create a bson serializable binary object. type is a keyword; either one of
-:function :binary :uuid :md5 or :user. data is the data encapsulated by this type."))
+:generic :function :binary :uuid :md5 or :user. data is the data encapsulated by this type."))
+
+(defmethod bson-binary ((type (eql :generic)) data)
+  (make-instance 'bson-binary-generic :data data))
+
+(defmethod bson-binary ((type (eql +bson-binary-generic+)) data)
+  (make-instance 'bson-binary-generic :data data))
 
 (defmethod bson-binary ((type (eql :function)) data)
   (make-instance 'bson-binary-function :data data))
@@ -82,4 +92,3 @@
   (if (slot-boundp bson-binary-base 'data)
       (rep stream bson-binary-base)
       "binary not set.."))
-

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