X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-api.lisp;fp=db-postgresql-socket%2Fpostgresql-socket-api.lisp;h=40dc86a780d46d88c1a146b7ecbced867cc6eaee;hp=879e5bb2a0ede5a358f45e88dad9205676790c87;hb=f67c4e2a4e5b8371a1b7c1629828999ff909f538;hpb=2ba41ebdcd4963728c8d5460e389a5381b8e2293

diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp
index 879e5bb..40dc86a 100644
--- a/db-postgresql-socket/postgresql-socket-api.lisp
+++ b/db-postgresql-socket/postgresql-socket-api.lisp
@@ -234,6 +234,14 @@ socket interface"
   (int32 pid)
   (int32 key))
 
+(defun read-bytes (socket length)
+  "Read a byte array of the given length from a stream."
+  (declare (type stream socket)
+           (type fixnum length)
+           (optimize (speed 3) (safety 0)))
+  (let ((result (make-array length :element-type '(unsigned-byte 8))))
+    (read-sequence result socket)
+    result))
 
 (defun read-socket-sequence (stream length &optional (allow-wide t))
   (declare (stream stream)
@@ -487,10 +495,16 @@ troubles."
                                :database database :user user
                                :password (or password ""))))
 
-(defun encrypt-md5 (plaintext salt)
-  (string-downcase
-   (format nil "~{~2,'0X~}"
-           (coerce (md5sum-string (concatenate 'string plaintext salt)) 'list))))
+(defun byte-sequence-to-hex-string (sequence)
+  (string-downcase (format nil "~{~2,'0X~}" (coerce sequence 'list))))
+
+(defun encrypt-password-md5 (password user salt)
+  (let ((pass1 (byte-sequence-to-hex-string
+		(md5::md5sum-string (concatenate 'string password user)))))
+    (byte-sequence-to-hex-string
+     (md5:md5sum-sequence (concatenate '(vector (unsigned-byte 8))
+				   (map '(vector (unsigned-byte 8)) #'char-code pass1)
+				   salt)))))
 
 (defun reopen-postgresql-connection (connection)
   "Reopen the given PostgreSQL connection.  Closes any existing
@@ -532,10 +546,11 @@ connection, if it is still open."
                          (postgresql-connection-password connection) salt)))
                      (force-output socket))
                     (5
-                     (let ((salt (read-socket-sequence socket 4 nil)))
-                       (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
-                                                 (postgresql-connection-user connection)))
-                              (pwd (encrypt-md5 pwd2 salt)))
+                     (let ((salt (read-bytes socket 4)))
+                       (let ((pwd (encrypt-password-md5
+				   (postgresql-connection-password connection)
+				   (postgresql-connection-user connection)
+				   salt)))
                          (send-encrypted-password-message
                           socket
                           (concatenate 'string "md5" pwd))))