X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-api.lisp;h=94d33f1d4c093b3ddf50cdfa3f12f1620f0a8489;hp=7ad32362f2c86da708aebc53d6a83de6100c6939;hb=6f9c91e01227e25e36560220628269258c80712d;hpb=39095e2eef81a3457756334cea4580026828eaf8

diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp
index 7ad3236..94d33f1 100644
--- a/db-postgresql-socket/postgresql-socket-api.lisp
+++ b/db-postgresql-socket/postgresql-socket-api.lisp
@@ -107,10 +107,13 @@ socket interface"
 (defun send-socket-value-string (socket value)
   (declare (type stream socket)
 	   (type string value))
+  #-sb-unicode
   (loop for char across value
-	for code = (char-code char)
-	do (write-byte code socket)
-	finally (write-byte 0 socket))
+        for code = (char-code char)
+        do (write-byte code socket)
+        finally (write-byte 0 socket))
+  #+sb-unicode
+  (write-sequence (sb-ext:string-to-octets value :null-terminate t) socket)
   nil)
 
 (defun send-socket-value-limstring (socket value limit)
@@ -151,10 +154,20 @@ socket interface"
 
 (defun read-socket-value-string (socket)
   (declare (type stream socket))
+  #-sb-unicode
   (with-output-to-string (out)
     (loop for code = (read-byte socket)
-	  until (zerop code)
-	  do (write-char (code-char code) out))))
+          until (zerop code)
+          do (write-char (code-char code) out)))
+  #+sb-unicode
+  (let ((bytes (make-array 64
+                           :element-type '(unsigned-byte 8)
+                           :adjustable t
+                           :fill-pointer 0)))
+    (loop for code = (read-byte socket)
+          until (zerop code)
+          do (vector-push-extend code bytes))
+    (sb-ext:octets-to-string bytes)))
 
 
 (defmacro define-message-sender (name (&rest args) &rest clauses)
@@ -200,15 +213,20 @@ socket interface"
   (int32 key))
 
 
-(defun read-socket-sequence (string stream)
+(defun read-socket-sequence (stream length)
   "KMR -- Added to support reading from binary stream into a string"
-  (declare (string string)
-	   (stream stream)
+  (declare (stream stream)
 	   (optimize (speed 3) (safety 0)))
-  (dotimes (i (length string))
-    (declare (fixnum i))
-    (setf (char string i) (code-char (read-byte stream))))
-  string)
+  #-sb-unicode
+  (let ((result (make-string length)))
+    (dotimes (i length result)
+      (declare (fixnum i))
+      (setf (char result i) (code-char (read-byte stream)))))
+  #+sb-unicode
+  (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
+    (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
+    (read-sequence bytes stream)
+    (sb-ext:octets-to-string bytes)))
 
 
 ;;; Support for encrypted password transmission
@@ -220,7 +238,7 @@ socket interface"
   (unless *crypt-library-loaded*
     (uffi:load-foreign-library 
      (uffi:find-foreign-library "libcrypt"
-			   '(#+64bit "/usr/lib64/"
+			   '(#+(or 64bit x86-64) "/usr/lib64/"
 			     "/usr/lib/" "/usr/local/lib/" "/lib/"))
      :supporting-libraries '("c"))
     (setq *crypt-library-loaded* t)))
@@ -316,15 +334,19 @@ socket interface"
   (etypecase host
     (pathname
      ;; Directory to unix-domain socket
-     (sb-bsd-sockets:socket-connect
-      (namestring
-       (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
-		      :defaults host))))
+     (let ((sock (make-instance 'sb-bsd-sockets:local-socket
+				:type :stream)))
+       (sb-bsd-sockets:socket-connect
+        sock
+        (namestring
+         (make-pathname :name ".s.PGSQL" :type (princ-to-string port)
+                        :defaults host)))
+       sock))
     (string
      (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
 				:type :stream
 				:protocol :tcp)))
-       (sb-bsd-sockets:socket-connect 
+       (sb-bsd-sockets:socket-connect
 	sock 
 	(sb-bsd-sockets:host-ent-address
 	 (sb-bsd-sockets:get-host-by-name host)) 
@@ -461,16 +483,14 @@ connection, if it is still open."
 		      (postgresql-connection-password connection))
                       (force-output socket))
 		    (4
-		     (let ((salt (make-string 2)))
-		       (read-socket-sequence salt socket)
+		     (let ((salt (read-socket-sequence socket 2)))
 		       (send-encrypted-password-message
 			socket
 			(crypt-password
 			 (postgresql-connection-password connection) salt)))
                      (force-output socket))
 		    (5
-		     (let ((salt (make-string 4)))
-		       (read-socket-sequence salt socket)
+		     (let ((salt (read-socket-sequence socket 4)))
 		       (let* ((pwd2 (encrypt-md5 (postgresql-connection-password connection)
 						 (postgresql-connection-user connection)))
 			      (pwd (encrypt-md5 pwd2 salt)))
@@ -542,6 +562,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
@@ -636,9 +657,7 @@ connection, if it is still open."
       (:double
        (read-double-from-socket socket length))
       (t
-       (let ((result (make-string length)))
-	 (read-socket-sequence result socket)
-	 result)))))
+       (read-socket-sequence socket length)))))
 
 (uffi:def-constant +char-code-zero+ (char-code #\0))
 (uffi:def-constant +char-code-minus+ (char-code #\-))