Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv1507 Modified Files: large-object.lisp pg-tests.lisp v3-protocol.lisp Log Message: Implement binary-mode transfers for large-object operations in the v3 protocol. The v2 protocol transfers arguments in binary mode, but the v3 protocol requires the client to specify for each argument of a FunctionCall whether it is encoded as binary or as text. - add possibility to send (unsigned-byte 8) arguments to function calls - add a method READ-OCTETS-FROM-PACKET that reads raw octets - make PG-IMPORT and PG-EXPORT use binary I/O - PGLO-READ reads data in binary - change the large-object tests to use binary I/O (fixes the pglo test) Date: Fri Aug 13 09:50:37 2004 Author: emarsden Index: pg/large-object.lisp diff -u pg/large-object.lisp:1.1 pg/large-object.lisp:1.2 --- pg/large-object.lisp:1.1 Fri Mar 5 10:08:08 2004 +++ pg/large-object.lisp Fri Aug 13 09:50:37 2004 @@ -1,7 +1,6 @@ ;;; large-object.lisp -- support for BLOBs ;;; ;;; Author: Eric Marsden <emarsden@laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> ;; ;; ;; Sir Humphrey: Who is Large and to what does he object? @@ -82,8 +81,10 @@ (defun pglo-close (connection fd) (fn connection "lo_close" t fd)) +;; note that the 3rd argument means that we are reading data in binary +;; format, not text (defun pglo-read (connection fd bytes) - (fn connection "loread" nil fd bytes)) + (fn connection "loread" t fd bytes)) (defun pglo-write (connection fd buf) (fn connection "lowrite" t fd buf)) @@ -98,9 +99,10 @@ (fn connection "lo_unlink" t oid)) (defun pglo-import (connection filename) - (let ((buf (make-string +LO_BUFSIZ+)) + (let ((buf (make-array +LO_BUFSIZ+ :element-type '(unsigned-byte 8))) (oid (pglo-create connection "rw"))) - (with-open-file (in filename :direction :input) + (with-open-file (in filename :direction :input + :element-type '(unsigned-byte 8)) (loop :with fdout = (pglo-open connection oid "w") :for bytes = (read-sequence buf in) :until (< bytes +LO_BUFSIZ+) @@ -111,7 +113,8 @@ oid)) (defun pglo-export (connection oid filename) - (with-open-file (out filename :direction :output) + (with-open-file (out filename :direction :output + :element-type '(unsigned-byte 8)) (loop :with fdin = (pglo-open connection oid "r") :for str = (pglo-read connection fdin +LO_BUFSIZ+) :until (zerop (length str)) Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.7 pg/pg-tests.lisp:1.8 --- pg/pg-tests.lisp:1.7 Wed Aug 11 06:27:48 2004 +++ pg/pg-tests.lisp Fri Aug 13 09:50:37 2004 @@ -13,9 +13,15 @@ #+cmu :fwrappers)) (in-package :pg-tests) +(defmacro with-pg-connection/2 ((con &rest open-args) &body body) + `(let ((,con (pg::pg-connect/v2 ,@open-args))) + (unwind-protect + (progn ,@body) + (when ,con (pg-disconnect ,con))))) + ;; !!! CHANGE THE VALUES HERE !!! (defun call-with-test-connection (function) - (with-pg-connection (conn "test" "pgdotlisp" :host "melbourne" :port 5433 :password "lisp") + (with-pg-connection (conn "test" "pgdotlisp") (funcall function conn))) (defmacro with-test-connection ((conn) &body body) @@ -194,24 +200,27 @@ (sleep 1) (pglo-unlink conn oid))))) -;; test of large-object interface +;; test of large-object interface. We are careful to use vectors of +;; bytes instead of strings, because with the v3 protocol strings +;; undergo \\xxx encoding (for instance #\newline is transformed to \\012). (defun test-lo-read () (format *debug-io* "Testing read of large object ...~%") (with-test-connection (conn) (with-pg-transaction conn (let* ((oid (pglo-create conn "rw")) (fd (pglo-open conn oid "rw"))) - (pglo-write conn fd "Hi there mate") + (pglo-write conn fd (map '(vector (unsigned-byte 8)) #'char-code (format nil "Hi there mate~%What's up?~%"))) (pglo-lseek conn fd 3 0) ; SEEK_SET = 0 - (assert (= 3 (pglo-tell conn fd))) + (assert (eql 3 (pglo-tell conn fd))) ;; this should print "there mate" - (format *debug-io* "Read ~s from lo~%" (pglo-read conn fd 10)) + (format *debug-io* "Read ~s from lo~%" (map 'string #'code-char (pglo-read conn fd 10))) + (format *debug-io* "Rest is ~s~%" (map 'string #'code-char (pglo-read conn fd 1024))) (pglo-close conn fd) - (pglo-unlink conn oid))))) + #+nil (pglo-unlink conn oid))))) #+cmu (defun test-lo-import () - (format *debug-io* "Testing import of large object ...~%") + (format *debug-io* "Testing import of large object ...~%") (with-test-connection (conn) (with-pg-transaction conn (let ((oid (pglo-import conn "/etc/group"))) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.12 pg/v3-protocol.lisp:1.13 --- pg/v3-protocol.lisp:1.12 Wed Aug 11 06:27:48 2004 +++ pg/v3-protocol.lisp Fri Aug 13 09:50:37 2004 @@ -267,7 +267,7 @@ ;; that really want READ-OCTET-ARRAY-FROM-PACKET (defgeneric read-string-from-packet (packet length) (:documentation - "Reads an array of LENGTH bytes from the packet") + "Reads a string of LENGTH characters from the packet") (:method ((packet pg-packet) (length (eql -1))) nil) (:method ((packet pg-packet) (length (eql 0))) @@ -289,6 +289,13 @@ (incf position length) result)))) +(defmethod read-octets-from-packet ((packet pg-packet) (length integer)) + (let ((result (make-array length :element-type '(unsigned-byte 8)))) + (with-slots (data position) packet + (replace result data :start2 position :end2 (+ position length)) + (incf position length) + result))) + (defun send-packet (connection code description) @@ -305,8 +312,9 @@ ((:byte :char) 1) ((:int16) 2) ((:int32) 4) + ((:rawdata) (length value)) ((:cstring) (1+ (length (convert-string-to-bytes value)))) - ((:ucstring :rawdata) (1+ (length value))))))) + ((:ucstring) (1+ (length value))))))) (data (make-array (- length 4) :element-type '(unsigned-byte 8))) (stream (pgcon-stream connection))) @@ -698,7 +706,7 @@ ;; Argument FN is either an integer, in which case it is the OID of an ;; element in the pg_proc table, and otherwise it is a string which we ;; look up in the alist *lo-functions* to find the corresponding OID. -(defmethod fn ((connection pgcon-v3) fn integer-result &rest args) +(defmethod fn ((connection pgcon-v3) fn binary-result &rest args) (or *lo-initialized* (lo-init connection)) (let ((fnid (cond ((integerp fn) fn) ((not (stringp fn)) @@ -711,33 +719,31 @@ `((:int32 ,fnid) (:int16 ,(length args)) ,@(let ((result nil)) - (loop for arg in args - do - (cond - ((integerp arg) - (push `(:int16 1) - result)) - ((stringp arg) - (push `(:int16 0) - result)) - (t (error 'protocol-error - :reason (format nil "Unknown fastpath type ~s" arg))))) + (dolist (arg args) + (etypecase arg + (integer + (push `(:int16 1) result)) + ((vector (unsigned-byte 8)) + (push `(:int16 1) result)) + (string + (push `(:int16 0) result)))) (nreverse result)) (:int16 ,(length args)) ,@(let ((result nil)) - (loop for arg in args - do - (cond - ((integerp arg) - (push '(:int32 4) result) - (push `(:int32 ,arg) result)) - ((stringp arg) - (push `(:int32 ,(1+ (length arg))) result) - (push `(:cstring ,arg) result)) - (t (error 'protocol-error - :reason (format nil "Unknown fastpath type ~s" arg))))) + (dolist (arg args) + (etypecase arg + (integer + (push '(:int32 4) result) + (push `(:int32 ,arg) result)) + ((vector (unsigned-byte 8)) + (push `(:int32 ,(length arg)) result) + (push `(:rawdata ,arg) result)) + (string + ;; FIXME this should be STRING-OCTET-LENGTH instead of LENGTH + (push `(:int32 ,(1+ (length arg))) result) + (push `(:cstring ,arg) result)))) (nreverse result)) - (:int16 ,(if integer-result 1 0)))) + (:int16 ,(if binary-result 1 0)))) (%flush connection) (loop :with result = nil :for packet = (read-packet connection) @@ -746,14 +752,16 @@ ((#\V) ; FunctionCallResponse (let* ((length (read-from-packet packet :int32)) (data (unless (= length -1) - (if integer-result - (ecase length + (if binary-result + (case length ((1) (read-from-packet packet :byte)) ((2) (read-from-packet packet :int16)) ((4) - (read-from-packet packet :int32))) + (read-from-packet packet :int32)) + (t + (read-octets-from-packet packet length))) (read-string-from-packet packet length))))) (if data (setf result data)