X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-api.lisp;h=dbf41d1f232be7a0b84537b83f64c9c9510d3733;hb=1833e48cea1b37b2f3f9b269e57a7c098d622631;hp=dabaad923b8bbd59886924ef7ceba182d97fffdf;hpb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;p=clsql.git diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp index dabaad9..dbf41d1 100644 --- a/db-postgresql-socket/postgresql-socket-api.lisp +++ b/db-postgresql-socket/postgresql-socket-api.lisp @@ -214,7 +214,7 @@ socket interface" ;;; Support for encrypted password transmission #-scl -(eval-when (compile eval load) +(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *crypt-library-loaded* nil) (unless *crypt-library-loaded* @@ -426,7 +426,7 @@ troubles." (defun encrypt-md5 (plaintext salt) (string-downcase (format nil "~{~2,'0X~}" - (coerce (md5:md5sum-sequence (concatenate 'string plaintext salt)) 'list)))) + (coerce (md5sum-sequence (concatenate 'string plaintext salt)) 'list)))) (defun reopen-postgresql-connection (connection) "Reopen the given PostgreSQL connection. Closes any existing @@ -458,14 +458,16 @@ connection, if it is still open." (3 (send-unencrypted-password-message socket - (postgresql-connection-password connection))) + (postgresql-connection-password connection)) + (force-output socket)) (4 (let ((salt (make-string 2))) (read-socket-sequence salt socket) (send-encrypted-password-message socket (crypt-password - (postgresql-connection-password connection) salt)))) + (postgresql-connection-password connection) salt))) + (force-output socket)) (5 (let ((salt (make-string 4))) (read-socket-sequence salt socket) @@ -474,7 +476,8 @@ connection, if it is still open." (pwd (encrypt-md5 pwd2 salt))) (send-encrypted-password-message socket - (concatenate 'string "md5" pwd))))) + (concatenate 'string "md5" pwd)))) + (force-output socket)) (t (error 'postgresql-login-error :connection connection @@ -539,6 +542,7 @@ connection, if it is still open." while (listen socket) do (case (read-socket-value-int8 socket) + (#.+ready-for-query-message+) (#.+notice-response-message+ (let ((message (read-socket-value-string socket))) (warn 'postgresql-warning :connection connection