X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-api.lisp;h=658addc5ea6cc90c55e81aafc34d51bd4090294a;hp=4dffc99241aea6007e3f12af83c43a4e63f3ba30;hb=5d0dbfd9dd1e08745109a18cce6a04750ffb7477;hpb=c26576fadaa8c5e5c5a2406de108529c308bd9b4

diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp
index 4dffc99..658addc 100644
--- a/db-postgresql-socket/postgresql-socket-api.lisp
+++ b/db-postgresql-socket/postgresql-socket-api.lisp
@@ -9,7 +9,7 @@
 ;;;;                
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-socket-api.lisp,v 1.2 2002/10/21 07:45:50 kevin Exp $
+;;;; $Id: postgresql-socket-api.lisp,v 1.3 2003/03/02 20:02:02 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -391,6 +391,11 @@ troubles."
 			       :database database :user user
 			       :password (or password ""))))
 
+(defun encrypt-md5 (plaintext salt)
+  (string-downcase
+   (format nil "~{~2,'0X~}"
+	   (coerce (md5:md5sum-sequence (concatenate 'string plaintext salt)) 'list))))
+
 (defun reopen-postgresql-connection (connection)
   "Reopen the given PostgreSQL connection.  Closes any existing
 connection, if it is still open."
@@ -429,6 +434,15 @@ connection, if it is still open."
 			socket
 			(crypt-password
 			 (postgresql-connection-password connection) salt))))
+		    (5
+		     (let ((salt (make-string 4)))
+		       (read-socket-sequence salt socket)
+		       (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
+						 (postgresql-connection-user connection)))
+			      (pwd (encrypt-md5 pwd2 salt)))
+			 (send-encrypted-password-message
+			  socket
+			  (concatenate 'string "md5" pwd)))))
 		    (t
 		     (error 'postgresql-login-error
 			    :connection connection