[pg-cvs] CVS pg

[emarsden]

Update of /project/pg/cvsroot/pg
In directory clnet:/tmp/cvs-serv12747

Modified Files:
	v3-protocol.lisp 
Log Message:
Fix problems with text data in prepared statements. Unlike the rest of
the protocol, strings are not sent NUL-terminated.


--- /project/pg/cvsroot/pg/v3-protocol.lisp	2006/09/15 20:49:03	1.21
+++ /project/pg/cvsroot/pg/v3-protocol.lisp	2006/09/18 21:37:48	1.22
@@ -306,6 +306,7 @@
                                 ((:int16) 2)
                                 ((:int32) 4)
                                 ((:rawdata) (length value))
+                                ((:string) (length (convert-string-to-bytes value)))
                                 ((:cstring) (1+ (length (convert-string-to-bytes value))))
                                 ((:ucstring) (1+ (length value)))))))
          (data (make-array (- length 4)
@@ -356,6 +357,13 @@
              (setf (elt data position) 0)
              (incf position))
 
+            ;; a string without the trailing NUL character
+            ((:string)
+             (check-type value string)
+             (let ((encoded (convert-string-to-bytes value)))
+               (replace data encoded :start1 position)
+               (incf position (length encoded))))
+
 	    ((:rawdata)
              (check-type value (array (unsigned-byte 8) *))
 	     (replace data value :start1 position)
@@ -374,26 +382,16 @@
 to connect to the database using a Unix socket."
   (let* ((stream (socket-connect port host))
          (connection (make-instance 'pgcon-v3 :stream stream :host host :port port))
-         (user-packet-length (+ 4 ; length
-                                4 ; protocol version
-                                (length "user")
-                                1
-                                (length user)
-                                1
-                                (length "database")
-                                1
-                                (length dbname)
-                                1
-                                1)))
+         (connect-options `("user" ,user
+                            "database" ,dbname))
+         (user-packet-length (+ 4 4 (loop :for item :in connect-options :sum (1+ (length item))) 1)))
     ;; send the startup packet
     ;; this is one of the only non-standard packets!
     (%send-net-int stream user-packet-length 4)
     (%send-net-int stream 3 2)          ; major
     (%send-net-int stream 0 2)          ; minor
-    (%send-cstring stream "user")
-    (%send-cstring stream user)
-    (%send-cstring stream "database")
-    (%send-cstring stream dbname)
+    (dolist (item connect-options)
+      (%send-cstring stream item))
     (%send-net-int stream 0 1)
     (%flush connection)
 
@@ -634,9 +632,7 @@
           (warn "Got unexpected packet: ~S, resetting connection"
                 packet)
           ;; sync
-          (send-packet connection
-                       #\S
-                       nil)
+          (send-packet connection #\S nil)
           (%flush connection)))))))
 
 (defmethod pg-exec ((connection pgcon-v3) &rest args)
@@ -851,16 +847,16 @@
       t))
 
 (defmethod pg-bind ((connection pgcon-v3) (portal string)  (statement-name string) list-of-types-and-values)
-    (let ((formats (when list-of-types-and-values
+  (let ((formats (when list-of-types-and-values
                    (loop :for (type value) :in list-of-types-and-values
                          :collect
                          (ecase type
-                           ((:string) `(:int16 0))
-                           ((:byte :int16 :int32 :char) `(:int16 1))))))
-        (data  nil))
+                           ((:string) '(:int16 0))
+                           ((:byte :int16 :int32 :char) '(:int16 1))))))
+        (data nil))
 
     (when list-of-types-and-values
-      (loop :for  (type value) :in list-of-types-and-values
+      (loop :for (type value) :in list-of-types-and-values
             :do
             (ecase type
               ((:int32)
@@ -875,10 +871,12 @@
               ((:char)
                (push '(:int32 1) data)
                (push `(:int8 ,(char-code value)) data))
+              ;; this is not a NUL-terminated string, so send exactly
+              ;; the string length rather than 1+
               ((:string)
-               (push `(:int32 ,(1+ (length value))) data)
-               (push `(:cstring ,value) data))))
-
+               (let ((encoded-length (length (convert-string-to-bytes value (pg-client-encoding connection)))))
+                 (push `(:int32 ,encoded-length) data)
+                 (push `(:string ,value) data)))))
       (setf data (nreverse data)))
 
     (cond
@@ -912,13 +910,10 @@
   (send-packet connection
                #\E
                `((:cstring ,portal)
-                 (:int32 ,maxinum-number-of-rows)))
+                 (:int32 ,maximum-number-of-rows)))
   ;; send all data:
-  (send-packet connection
-               #\S
-               nil)
+  (send-packet connection #\S nil)
   (%flush connection)
-
   (do-followup-query connection))
 
 (defun pg-close (connection name type)