March 2004 - pg-cvs@common-lisp.net - mailman3.common-lisp.net

[pg-cvs] CVS update: pg/pg-tests.lisp pg/v3-protocol.lisp
by Peter Van Eynde 20 Mar '04

20 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv29373 Modified Files: pg-tests.lisp v3-protocol.lisp Log Message: now COPY IN/OUT actually works, also created test-case Date: Sat Mar 20 16:48:42 2004 Author: pvaneynde Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.5 pg/pg-tests.lisp:1.6 --- pg/pg-tests.lisp:1.5 Mon Mar 8 11:45:16 2004 +++ pg/pg-tests.lisp Sat Mar 20 16:48:41 2004 @@ -315,6 +315,37 @@ (when created (pg-exec conn "DROP TABLE count_test"))))))) +(defun test-copy-in-out () + (with-test-connection (conn) + (ignore-errors + (pg-exec conn "DROP TABLE foo")) + (pg-exec conn "CREATE TABLE foo (a int, b int)") + (pg-exec conn "INSERT INTO foo VALUES (1, 2)") + (pg-exec conn "INSERT INTO foo VALUES (2, 4)") + + (with-open-file (stream "/tmp/foo-out" + :direction :output + :element-type '(unsigned-byte 8) + :if-does-not-exist :create + :if-exists :overwrite) + (setf (pgcon-sql-stream conn) stream) + (pg-exec conn "COPY foo TO stdout")) + + (pg-exec conn "DELETE FROM foo") + (with-open-file (stream "/tmp/foo-out" + :direction :input + :element-type '(unsigned-byte 8) + :if-does-not-exist :error + :if-exists :overwrite) + (setf (pgcon-sql-stream conn) stream) + (pg-exec conn "COPY foo FROM stdout")) + + (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 1"))) + (assert (eql 2 (first (pg-result res :tuple 0))))) + (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 2"))) + (assert (eql 4 (first (pg-result res :tuple 0))))) + + (pg-exec conn "DROP TABLE foo"))) (defun test () (with-test-connection (conn) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.7 pg/v3-protocol.lisp:1.8 --- pg/v3-protocol.lisp:1.7 Wed Mar 17 13:15:26 2004 +++ pg/v3-protocol.lisp Sat Mar 20 16:48:41 2004 @@ -72,7 +72,8 @@ :type base-char :reader pg-packet-type) (length :initarg :length - :type (unsigned-byte 32)) + :type (unsigned-byte 32) + :reader pg-packet-length) (data :initarg :data :type (array (unsigned-byte 8) *)) (position :initform 0 @@ -532,7 +533,7 @@ (when receive-data-p ;; we break the nice packet abstraction here to ;; get some speed: - (let ((length (read-from-packet packet :int32))) + (let ((length (- (pg-packet-length packet) 4))) (write-sequence (make-array length :element-type '(unsigned-byte 8) :displaced-to (slot-value packet

1 0

[pg-cvs] CVS update: pg/v3-protocol.lisp
by Eric Marsden 17 Mar '04

17 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv30493 Modified Files: v3-protocol.lisp Log Message: - fix bogus type declaration - remove bogus use of CMUCL's finalization (can't reference dying object from the finalizer) Date: Wed Mar 17 13:15:27 2004 Author: emarsden Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.6 pg/v3-protocol.lisp:1.7 --- pg/v3-protocol.lisp:1.6 Tue Mar 9 11:27:20 2004 +++ pg/v3-protocol.lisp Wed Mar 17 13:15:26 2004 @@ -1,7 +1,6 @@ ;;; v3-protocol.lisp -- frontend/backend protocol from PostgreSQL v7.4 ;;; ;;; Author: Peter Van Eynde <pvaneynd(a)debian.org> -;;; Time-stamp: <2004-03-08 emarsden> (in-package :postgresql) @@ -10,7 +9,7 @@ :initform (list)) (sql-stream :initform nil :accessor pgcon-sql-stream - :type (or nil stream)))) + :type (or null stream)))) (define-condition error-response (postgresql-error) @@ -365,7 +364,6 @@ (%send-cstring stream dbname) (%send-net-int stream 0 1) (%flush connection) - #+cmu (ext:finalize connection (lambda () (pg-disconnect connection))) (loop :for packet = (read-packet connection)

1 0

[pg-cvs] CVS update: pg/sysdep.lisp
by Eric Marsden 17 Mar '04

17 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv8352 Modified Files: sysdep.lisp Log Message: - changes for Armed Bear Lisp: change to new API for binary socket streams; autoload a working FORMAT Date: Wed Mar 17 13:13:10 2004 Author: emarsden Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.3 pg/sysdep.lisp:1.4 --- pg/sysdep.lisp:1.3 Mon Mar 8 13:12:45 2004 +++ pg/sysdep.lisp Wed Mar 17 13:13:10 2004 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-08 emarsden> +;;; Time-stamp: <2004-03-17 emarsden> ;; ;; @@ -112,7 +112,7 @@ (error 'connection-failure :host host :port port)))) -#+db-sockets +#+(and db-sockets broken) (defun socket-connect (port host) (declare (type integer port)) (handler-case @@ -264,11 +264,17 @@ (si::socket port :host host)) + +#+armedbear +(eval-when (:load-toplevel :execute :compile-toplevel) + (require 'format)) + +;; MAKE-SOCKET with :element-type as per 2004-03-09 #+armedbear (defun socket-connect (port host) (declare (type integer port)) (handler-case - (ext:make-binary-socket host port) + (ext:make-socket host port :element-type '(unsigned-byte 8)) (error (e) (error 'connection-failure :host host

1 0

[pg-cvs] CVS update: pg/defpackage.lisp pg/v3-protocol.lisp
by Peter Van Eynde 09 Mar '04

09 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv8897 Modified Files: defpackage.lisp v3-protocol.lisp Log Message: untested COPY IN/OUT code. I am not happy about how this looks... Date: Tue Mar 9 11:27:20 2004 Author: pvaneynde Index: pg/defpackage.lisp diff -u pg/defpackage.lisp:1.2 pg/defpackage.lisp:1.3 --- pg/defpackage.lisp:1.2 Mon Mar 8 09:38:07 2004 +++ pg/defpackage.lisp Tue Mar 9 11:27:20 2004 @@ -6,6 +6,7 @@ #+openmcl :ccl) #+openmcl (:shadow ccl:socket-connect) (:export #:pg-connect #:pg-exec #:pg-result #:pg-disconnect + #:pgcon-sql-stream #:*pg-disable-type-coercion* #:pg-databases #:pg-tables #:pg-columns #:pg-backend-version Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.5 pg/v3-protocol.lisp:1.6 --- pg/v3-protocol.lisp:1.5 Mon Mar 8 13:12:45 2004 +++ pg/v3-protocol.lisp Tue Mar 9 11:27:20 2004 @@ -7,8 +7,10 @@ (defclass pgcon-v3 (pgcon) ((parameters :accessor pgcon-parameters - :initform (list)))) - + :initform (list)) + (sql-stream :initform nil + :accessor pgcon-sql-stream + :type (or nil stream)))) (define-condition error-response (postgresql-error) @@ -279,7 +281,8 @@ ((:byte :char) 1) ((:int16) 2) ((:int32) 4) - ((:cstring) + ((:cstring + :rawdata) (+ 1 (length value))))))) (data (make-array (- length 4) @@ -320,7 +323,12 @@ (char-code char)) (incf position)) (setf (elt data position) 0) - (incf position)))) + (incf position)) + ((:rawdata) + (check-type value (array (unsigned-byte 8) *)) + + (replace data value :start1 position) + (incf position (length value))))) (%send-net-int stream (char-code code) 1) (%send-net-int stream length 4 ) @@ -449,6 +457,7 @@ (loop :for packet = (read-packet connection) :with got-data-p = nil + :with receive-data-p = nil :do (when packet (case (pg-packet-type packet) @@ -472,27 +481,72 @@ (setf got-data-p t)) ((#\G) ;; CopyInResponse - (cerror "Just ignore it" "What to do with #\G?") - ;; The backend is ready to copy data from the frontend to a table; - ;; see Section 44.2.5 in http://www.postgresql.org/docs/7.4/interactive/protocol-flow.html - ;; for now we make it fail gracefully: - (send-packet connection - #\f - ;;CopyFail - '((:cstring "not implemented by pg.lisp yet"))) - ) + (cond + ((and (streamp (pgcon-sql-stream connection)) + (input-stream-p (pgcon-sql-stream connection))) + ;; we ignore the data stuff. + (handler-case + (progn + (loop :with buffer = (make-array 4096 + :element-type '(unsigned-byte 8) + :adjustable t) + :for length = (read-sequence buffer (pgcon-sql-stream connection)) + :until (= length 0) + :do + ;; send data + (unless (= length 4096) + (setf buffer + (adjust-array buffer (list length)))) + (send-packet connection + #\d + `((:rawdata ,buffer)))) + + ;; CopyDone + (send-packet connection + #\c + nil)) + ((or error serious-condition) (condition) + (warn "Got an error while writing sql data: ~S aborting transfer!" + condition) + (send-packet connection + #\f + ;;CopyFail + '((:cstring "No input data provided"))))) + (%flush connection)) + (t + (warn "We had to provide data, but my sql-stream isn't an input-stream. Aborting transfer") + + (send-packet connection + #\f + ;;CopyFail + '((:cstring "No input data provided")))))) ((#\H) ;; CopyOutResponse - (cerror "Just ignore it" "What to do with #\H?") - ;; The backend is ready to copy data from a table to the frontend; - ;; see Section 44.2.5. - ;; for now we make it fail gracefully (we cannot stop the transfer... - ) - (( #\d - ;; CopyData - #\c - ;;CopyDone - ) + (cond + ((and (streamp (pgcon-sql-stream connection)) + (output-stream-p (pgcon-sql-stream connection))) + (setf receive-data-p t)) + (t + (setf receive-data-p nil) + (warn "I should receive data but my sql-stream isn't an outputstream!~%Ignoring data")))) + (( #\d) + ;; CopyData + (when receive-data-p + ;; we break the nice packet abstraction here to + ;; get some speed: + (let ((length (read-from-packet packet :int32))) + (write-sequence (make-array length + :element-type '(unsigned-byte 8) + :displaced-to (slot-value packet + 'data) + :displaced-index-offset + (slot-value packet 'position)) + (pgcon-sql-stream connection))))) + (( #\c ) + ;;CopyDone + ;; we do nothing (the exec will return and the user + ;; can do something if he/she wants + (setf receive-data-p nil) t) ((#\T) ;; RowDescription (metadata for subsequent tuples), #\T

1 0

[pg-cvs] CVS update: pg/debian/changelog pg/debian/control pg/debian/copyright pg/debian/dirs pg/debian/links pg/debian/postinst pg/debian/prerm pg/debian/rules
by Peter Van Eynde 09 Mar '04

09 Mar '04

Update of /project/pg/cvsroot/pg/debian In directory common-lisp.net:/tmp/cvs-serv30140/debian Added Files: changelog control copyright dirs links postinst prerm rules Log Message: debian directory import Date: Tue Mar 9 11:25:27 2004 Author: pvaneynde

1 0

[pg-cvs] CVS update: Directory change: pg/debian
by Peter Van Eynde 09 Mar '04

09 Mar '04

Update of /project/pg/cvsroot/pg/debian In directory common-lisp.net:/tmp/cvs-serv20846/debian Log Message: Directory /project/pg/cvsroot/pg/debian added to the repository Date: Tue Mar 9 11:24:27 2004 Author: pvaneynde New directory pg/debian added

1 0

[pg-cvs] CVS update: CVSROOT/config
by root 09 Mar '04

09 Mar '04

Update of /project/pg/cvsroot/CVSROOT In directory common-lisp.net:/tmp/CVSROOT Modified Files: config Log Message: fixing broken anonncvs Date: Tue Mar 9 09:37:41 2004 Author: root Index: CVSROOT/config diff -u CVSROOT/config:1.2 CVSROOT/config:1.3 --- CVSROOT/config:1.2 Tue Mar 2 15:29:48 2004 +++ CVSROOT/config Tue Mar 9 09:37:41 2004 @@ -0,0 +1,14 @@ +# Set this to "no" if pserver shouldn't check system users/passwords +#SystemAuth=no + +# Put CVS lock files in this directory rather than directly in the repository. +LockDir=/var/lock/pg + +# Set `TopLevelAdmin' to `yes' to create a CVS directory at the top +# level of the new working directory when using the `cvs checkout' +# command. +#TopLevelAdmin=no + +# Set `LogHistory' to `all' or `TOFEWGCMAR' to log all transactions to the +# history file, or a subset as needed (ie `TMAR' logs all write operations) +#LogHistory=TOFEWGCMAR

1 0

[pg-cvs] CVS update: pg/lowlevel.lisp pg/sysdep.lisp pg/v2-protocol.lisp pg/v3-protocol.lisp
by Eric Marsden 08 Mar '04

08 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv30232 Modified Files: lowlevel.lisp sysdep.lisp v2-protocol.lisp v3-protocol.lisp Log Message: - improvements to the system-dependent functionality: OpenMCL is able to use a local connection to the backend; most implementations resignal connection errors as a postgres-error. - fixes to the lowlevel code Date: Mon Mar 8 13:12:45 2004 Author: emarsden Index: pg/lowlevel.lisp diff -u pg/lowlevel.lisp:1.2 pg/lowlevel.lisp:1.3 --- pg/lowlevel.lisp:1.2 Mon Mar 8 11:45:16 2004 +++ pg/lowlevel.lisp Mon Mar 8 13:12:45 2004 @@ -52,6 +52,7 @@ (defun %read-bytes (stream howmany) "Reads HOWMANY bytes from the STREAM. Returns the array of " + (declare (type stream stream)) (let ((v (make-array howmany :element-type '(unsigned-byte 8)))) (read-sequence v stream) v)) @@ -65,6 +66,7 @@ (defun %read-bytes (stream howmany) "Reads HOWMANY bytes from the STREAM. Returns the array of " + (declare (type stream stream)) (let ((v (make-array howmany :element-type '(unsigned-byte 8)))) (do ((continue-at (read-sequence v stream :start 0 :end howmany) (read-sequence v stream :start continue-at :end howmany))) @@ -72,19 +74,18 @@ ) v)) -(defun %read-chars (connection howmany) +(defun %read-chars (stream howmany) (declare (type fixnum howmany)) - (let ((bytes (%read-bytes connection howmany)) + (let ((bytes (%read-bytes stream howmany)) (str (make-string howmany))) (dotimes (i howmany) (setf (aref str i) (code-char (aref bytes i)))) str)) -(defun %read-cstring (connection maxbytes) +(defun %read-cstring (stream maxbytes) "Read a null-terminated string from CONNECTION." (declare (type fixnum maxbytes)) - (let ((stream (pgcon-stream connection)) - (chars nil)) + (let ((chars nil)) (do ((b (read-byte stream nil nil) (read-byte stream nil nil)) (i 0 (+ i 1))) ((or (= i maxbytes) ; reached allowed length Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.2 pg/sysdep.lisp:1.3 --- pg/sysdep.lisp:1.2 Fri Mar 5 13:08:08 2004 +++ pg/sysdep.lisp Mon Mar 8 13:12:45 2004 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> +;;; Time-stamp: <2004-03-08 emarsden> ;; ;; @@ -159,7 +159,7 @@ :remote-port port :format :binary) (error (e) - (signal 'connection-failure + (error 'connection-failure :host host :port port :transport-error e)))) @@ -169,9 +169,15 @@ #+lispworks (defun socket-connect (port host) (declare (type integer port)) - (comm:open-tcp-stream host port - :element-type '(unsigned-byte 8) - :direction :io)) + (handler-case + (comm:open-tcp-stream host port + :element-type '(unsigned-byte 8) + :direction :io) + (error (e) + (error 'connection-failure + :host host + :port port + :transport-error e)))) ;; this doesn't work, since the Corman sockets module doesn't support ;; binary I/O on socket streams. @@ -184,18 +190,32 @@ (let ((sock (sockets:make-client-socket :host host :port port))) (sockets:make-socket-stream sock))) (error (e) - (declare (ignore e)) - (error 'connection-failure :host host :port port)))) + (error 'connection-failure + :host host + :port port + :transport-error e)))) #+openmcl (defun socket-connect (port host) (declare (type integer port)) - (let ((sock (make-socket :type :stream - :connect :active - :format :binary - :remote-host host - :remote-port port))) - sock)) + (handler-case + (if host + (make-socket :address-family :internet + :type :stream + :connect :active + :format :binary + :remote-host host + :remote-port port) + (make-socket :address-family :file + :type :stream + :connect :active + :format :binary + :remote-filename (format nil "/var/run/postgresql/.s.PGSQL.~D" port))) + (error (e) + (error 'connection-failure + :host host + :port port + :transport-error e)))) ;; from John DeSoi #+(and mcl (not openmcl)) @@ -226,27 +246,13 @@ #+ecl (defun socket-connect (port host) (declare (type integer port)) - (si:open-client-stream host port)) - -;; #+ecl -;; (defun write-sequence (seq stream &key start end) -;; (declare (ignore start end)) -;; (loop :for element :across seq -;; :do (write-byte element stream))) -;; -;; #+ecl -;; (defun read-bytes (connection howmany) -;; (let ((v (make-array howmany :element-type '(unsigned-byte 8))) -;; (s (pgcon-stream connection))) -;; (loop :for pos :below howmany -;; :do (setf (aref v pos) (read-byte s))) -;; v)) -;; -;; #+ecl -;; (defun cl:read-sequence (seq stream &key (start 0) (end (length seq))) -;; (loop :for pos :from start :below end -;; :do (setf (aref seq pos) (read-byte stream)))) - + (handler-case + (si:open-client-stream host port) + (error (e) + (error 'connection-failure + :host host + :port port + :transport-error e)))) @@ -261,25 +267,13 @@ #+armedbear (defun socket-connect (port host) (declare (type integer port)) - (ext:make-binary-socket host port)) - -#+armedbear -(defun cl:write-sequence (seq stream &key (start 0) (end (length seq))) - (declare (ignore start end)) - (loop :for element :across seq - :do (write-byte element stream))) - -#+armedbear -(defun read-bytes (connection howmany) - (let ((v (make-array howmany :element-type '(unsigned-byte 8))) - (s (pgcon-stream connection))) - (loop :for pos :below howmany - :do (setf (aref v pos) (read-byte s))) - v)) + (handler-case + (ext:make-binary-socket host port) + (error (e) + (error 'connection-failure + :host host + :port port + :transport-error e)))) -#+armedbear -(defun cl:read-sequence (seq stream &key (start 0) (end (length seq))) - (loop :for pos :from start :below end - :do (setf (aref seq pos) (read-byte stream)))) ;; EOF Index: pg/v2-protocol.lisp diff -u pg/v2-protocol.lisp:1.2 pg/v2-protocol.lisp:1.3 --- pg/v2-protocol.lisp:1.2 Mon Mar 8 10:01:53 2004 +++ pg/v2-protocol.lisp Mon Mar 8 13:12:45 2004 @@ -34,7 +34,7 @@ ((69) (close stream) (error 'authentication-failure - :reason (%read-cstring connection 4096))) + :reason (%read-cstring stream 4096))) ;; Authentication ((82) @@ -54,7 +54,7 @@ (send-int connection 0 1) (%flush connection)) ((4) ; AuthEncryptedPassword - (let* ((salt (%read-chars connection 2)) + (let* ((salt (%read-chars stream 2)) (crypted (crypt password salt))) #+debug (format *debug-io* "Got salt of ~s~%" salt) @@ -109,7 +109,7 @@ ;; CompletedResponse, #\C ((67) - (let ((status (%read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((status (%read-cstring stream +MAX_MESSAGE_LEN+))) (setf (pgresult-status result) status) (setf (pgresult-tuples result) (nreverse tuples)) (setf (pgresult-attributes result) attributes) @@ -124,7 +124,7 @@ ;; ErrorResponse, #\E ((69) - (let ((msg (%read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((msg (%read-cstring stream +MAX_MESSAGE_LEN+))) (error 'backend-error :reason msg))) ;; #\G and #\H: start copy in, start copy out @@ -147,7 +147,7 @@ ;; CursorResponse, #\P ((80) - (let ((str (%read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((str (%read-cstring stream +MAX_MESSAGE_LEN+))) (declare (ignore str)) ;; (format *debug-io* "Portal name ~a~%" str) )) @@ -204,13 +204,13 @@ (let ((len (read-net-int connection 4))) (if integer-result (setq result (read-net-int connection len)) - (setq result (%read-chars connection len))))) + (setq result (%read-chars (pgcon-stream connection) len))))) (t (error 'protocol-error :reason "wierd FunctionResultResponse"))))) ;; end of FunctionResult ((48) (return-from fn result)) - ((69) (error 'backend-error :reason (%read-cstring connection 4096))) + ((69) (error 'backend-error :reason (%read-cstring (pgcon-stream connection) 4096))) ;; NoticeResponse ((78) @@ -240,7 +240,7 @@ (attributes '())) (do ((i attribute-count (- i 1))) ((zerop i) (nreverse attributes)) - (let ((type-name (%read-cstring connection +MAX_MESSAGE_LEN+)) + (let ((type-name (%read-cstring (pgcon-stream connection) +MAX_MESSAGE_LEN+)) (type-id (read-net-int connection 4)) (type-len (read-net-int connection 2)) ;; this doesn't exist in the 6.3 protocol !! @@ -266,7 +266,7 @@ (defun read-tuple/v2 (connection attributes) (let* ((num-attributes (length attributes)) (num-bytes (ceiling (/ num-attributes 8))) - (bitmap (%read-bytes connection num-bytes)) + (bitmap (%read-bytes (pgcon-stream connection) num-bytes)) (correction (if (pgcon-binary-p connection) 0 -4)) (tuples '())) (do ((i 0 (+ i 1)) @@ -276,13 +276,13 @@ (push nil tuples)) (t (let* ((len (+ (read-net-int connection 4) correction)) - (raw (%read-chars connection (max 0 len))) + (raw (%read-chars (pgcon-stream connection) (max 0 len))) (parsed (parse raw (car type-ids)))) (push parsed tuples))))))) ;; FIXME could signal a postgresql-notification condition (defun handle-notice (connection) - (push (%read-cstring connection +MAX_MESSAGE_LEN+) + (push (%read-cstring (pgcon-stream connection) +MAX_MESSAGE_LEN+) (pgcon-notices connection))) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.4 pg/v3-protocol.lisp:1.5 --- pg/v3-protocol.lisp:1.4 Mon Mar 8 11:45:16 2004 +++ pg/v3-protocol.lisp Mon Mar 8 13:12:45 2004 @@ -71,7 +71,7 @@ :type base-char :reader pg-packet-type) (length :initarg :length - :type (integer 32)) + :type (unsigned-byte 32)) (data :initarg :data :type (array (unsigned-byte 8) *)) (position :initform 0

1 0

[pg-cvs] CVS update: pg/lowlevel.lisp pg/pg-tests.lisp pg/v3-protocol.lisp
by Eric Marsden 08 Mar '04

08 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv11317 Modified Files: lowlevel.lisp pg-tests.lisp v3-protocol.lisp Log Message: - fix to the lowlevel factorization - modify parameter handling in v3 protocol to add parameters to the connection object, instead of issuing a warning Date: Mon Mar 8 11:45:17 2004 Author: emarsden Index: pg/lowlevel.lisp diff -u pg/lowlevel.lisp:1.1 pg/lowlevel.lisp:1.2 --- pg/lowlevel.lisp:1.1 Mon Mar 8 10:01:53 2004 +++ pg/lowlevel.lisp Mon Mar 8 11:45:16 2004 @@ -74,7 +74,7 @@ (defun %read-chars (connection howmany) (declare (type fixnum howmany)) - (let ((bytes (read-bytes connection howmany)) + (let ((bytes (%read-bytes connection howmany)) (str (make-string howmany))) (dotimes (i howmany) (setf (aref str i) (code-char (aref bytes i)))) Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.4 pg/pg-tests.lisp:1.5 --- pg/pg-tests.lisp:1.4 Mon Mar 8 10:01:53 2004 +++ pg/pg-tests.lisp Mon Mar 8 11:45:16 2004 @@ -17,7 +17,7 @@ ;; !!! CHANGE THE VALUES HERE !!! (defun call-with-test-connection (function) - (with-pg-connection (conn "template1" "emarsden" :host "locke" :port 5432) + (with-pg-connection (conn "template1" "emarsden" :host nil :port 5432) (funcall function conn))) (defmacro with-test-connection ((conn) &body body) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.3 pg/v3-protocol.lisp:1.4 --- pg/v3-protocol.lisp:1.3 Mon Mar 8 10:01:53 2004 +++ pg/v3-protocol.lisp Mon Mar 8 11:45:16 2004 @@ -457,10 +457,7 @@ ;; XXX investigate (let* ((parameter (read-from-packet packet :cstring)) (value (read-from-packet packet :cstring))) - ;;#+debug - (warn "~&Got unexpected parameter ~S = ~S" - parameter - value))) + (push (cons parameter value) (pgcon-parameters connection)))) ((#\A) ;; NotificationResponse ;; Not documented?

1 0

[pg-cvs] CVS update: pg/lowlevel.lisp pg/CREDITS pg/NEWS pg/README pg/pg-tests.lisp pg/pg.asd pg/pg.lisp pg/v2-protocol.lisp pg/v3-protocol.lisp
by Eric Marsden 08 Mar '04

08 Mar '04

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv9321 Modified Files: CREDITS NEWS README pg-tests.lisp pg.asd pg.lisp v2-protocol.lisp v3-protocol.lisp Added Files: lowlevel.lisp Log Message: More factorization of lowlevel functions between v2 and v3 protocols. Date: Mon Mar 8 10:01:53 2004 Author: emarsden Index: pg/CREDITS diff -u pg/CREDITS:1.1 pg/CREDITS:1.2 --- pg/CREDITS:1.1 Fri Mar 5 13:08:08 2004 +++ pg/CREDITS Mon Mar 8 10:01:53 2004 @@ -4,3 +4,10 @@ Peter Van Eynde: Wrote the support for the v3 PostgreSQL protocol. + +Thanks to Marc Battyani for the LW port and for bugfixes, to Johannes +Grødem <johs(a)copyleft.no> for a fix to parsing of DATE types, to Doug +McNaught and Howard Ding for bugfixes, to Ernst Jeschek for pointing +out a bug in float parsing, to Brian Lui for providing fixes for ACL6, +to James Anderson for providing a fix for a change in PostgreSQL +timestamp format. Index: pg/NEWS diff -u pg/NEWS:1.1.1.1 pg/NEWS:1.2 --- pg/NEWS:1.1.1.1 Wed Mar 3 08:11:50 2004 +++ pg/NEWS Mon Mar 8 10:01:53 2004 @@ -1,4 +1,17 @@ -=== Version 0.20, 2003-xxxx ============================================ +=== Version 0.21, 2003-xxxx ============================================ + + - added support for the v3 frontend/backend protocol, used by + PostgreSQL version 7.4 and up (thanks for Peter Van Eynde). + pg-dot-lisp will attempt to connect to your database server using + the new protocol, and upon failure will reconnect using the older + protocol. To avoid this once-per-connection overhead if you know + you're only using older PostgreSQL versions, use PG-CONNECT/V2 + instead of PG-CONNECT. + + - split out functionality into more files + + +=== Version 0.20 (unreleased) ========================================== - added more tests for BOOLEAN types, to check the handling of PostgreSQL errors (violation of an integrity constraint leads to an Index: pg/README diff -u pg/README:1.1.1.1 pg/README:1.2 --- pg/README:1.1.1.1 Wed Mar 3 08:11:50 2004 +++ pg/README Mon Mar 8 10:01:53 2004 @@ -1,10 +1,10 @@ pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp Author: Eric Marsden <emarsden(a)laas.fr> - Time-stamp: <2003-10-10 emarsden> - Version: 0.20 + Time-stamp: <2004-03-08 emarsden> + Version: 0.21 - Copyright (C) 1999,2000,2001,2002,2003 Eric Marsden + Copyright (C) 1999,2000,2001,2002,2003,2004 Eric Marsden This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public @@ -20,10 +20,10 @@ License along with this library; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - Please send suggestions and bug reports to <emarsden(a)laas.fr> - The latest version of this package should be available from + For download information, mailing lists for suggestions and bug + reports, see - <URL:http://purl.org/net/emarsden/home/downloads/> + <URL:http://www.common-lisp.net/project/pg/> == Overview ========================================================= @@ -240,19 +240,12 @@ end of the tunnel, since pg.lisp defaults to this value. - This code has been tested or reported to work with +This code has been tested or reported to work with - * CMUCL 18d on Solaris/SPARC and Linux/x86 + * CMUCL 18d and 18e on Solaris/SPARC and Linux/x86 * CLISP 2.30 on LinuxPPC and SPARC * ACL 6.1 trial/x86 - * PostgreSQL 6.5, 7.0, 7.1.2, 7.2. - -Thanks to Marc Battyani for the LW port and for bugfixes, to Johannes -Grødem <johs(a)copyleft.no> for a fix to parsing of DATE types, to Doug -McNaught and Howard Ding for bugfixes, to Ernst Jeschek for pointing -out a bug in float parsing, to Brian Lui for providing fixes for ACL6, -to James Anderson for providing a fix for a change in PostgreSQL -timestamp format. + * PostgreSQL 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4 You may be interested in using "pg-psql" by Harley Gorrell, which @@ -260,15 +253,5 @@ tabulated output), on top of this library. See <URL:http://www.mahalito.net/~harley/cl/pg-psql.lisp> - - - - -== TODO ============================================================ - - * add a mechanism for parsing user-defined types. The user should - be able to define a parse function and a type-name; we query - pg_type to get the type's OID and add the information to - pg:*parsers*. Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.3 pg/pg-tests.lisp:1.4 --- pg/pg-tests.lisp:1.3 Mon Mar 8 09:37:43 2004 +++ pg/pg-tests.lisp Mon Mar 8 10:01:53 2004 @@ -1,7 +1,7 @@ ;;; pg-tests.lisp -- incomplete test suite ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> +;;; Time-stamp: <2004-03-08 emarsden> ;; ;; ;; @@ -17,7 +17,7 @@ ;; !!! CHANGE THE VALUES HERE !!! (defun call-with-test-connection (function) - (with-pg-connection (conn "template1" "emarsden" :host nil :port 5432) + (with-pg-connection (conn "template1" "emarsden" :host "locke" :port 5432) (funcall function conn))) (defmacro with-test-connection ((conn) &body body) Index: pg/pg.asd diff -u pg/pg.asd:1.3 pg/pg.asd:1.4 --- pg/pg.asd:1.3 Sat Mar 6 17:59:39 2004 +++ pg/pg.asd Mon Mar 8 10:01:53 2004 @@ -21,6 +21,7 @@ (:file "meta-queries" :depends-on ("defpackage")) (:file "parsers" :depends-on ("defpackage")) (:file "utility" :depends-on ("defpackage")) + (:file "lowlevel" :depends-on ("defpackage")) (:file "pg" :depends-on ("sysdep" "parsers")) (:file "large-object" :depends-on ("pg")) (:file "v2-protocol" :depends-on ("pg" "large-object" "utility")) Index: pg/pg.lisp diff -u pg/pg.lisp:1.3 pg/pg.lisp:1.4 --- pg/pg.lisp:1.3 Mon Mar 8 09:37:31 2004 +++ pg/pg.lisp Mon Mar 8 10:01:53 2004 @@ -1,7 +1,7 @@ ;;; pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp ;; ;; Author: Eric Marsden <emarsden(a)laas.fr> -;; Time-stamp: <2004-03-05 emarsden> +;; Time-stamp: <2004-03-08 emarsden> ;; Version: 0.21 ;; ;; Copyright (C) 1999,2000,2001,2002,2003 Eric Marsden @@ -275,107 +275,6 @@ (parse-integer (subseq status 7 (position #\space status :start 7))) (error "Only INSERT commands generate an oid: ~s" status)))) (t (error "Unknown result request: ~s" what)))) - - - - - - -;; support routines =================================================== - -;; read an integer in network byte order -(defun read-net-int (connection bytes) - (declare (type (integer 0) bytes) - (type pgcon connection)) - - (do ((i bytes (- i 1)) - (stream (pgcon-stream connection)) - (accum 0)) - ((zerop i) accum) - (setq accum (+ (* 256 accum) (read-byte stream))))) - -(defun read-int (connection bytes) - (do ((i bytes (- i 1)) - (stream (pgcon-stream connection)) - (multiplier 1 (* multiplier 256)) - (accum 0)) - ((zerop i) accum) - (incf accum (* multiplier (read-byte stream))))) - -#-cmu -(defun read-bytes (connection howmany) - (declare (type fixnum howmany)) - (let ((v (make-array howmany :element-type '(unsigned-byte 8))) - (s (pgcon-stream connection))) - (read-sequence v s) - v)) - -;; There is a bug in CMUCL's implementation of READ-SEQUENCE on -;; network streams, which can return without reading to the end of the -;; sequence when it has to wait for data. It confuses the end-of-file -;; condition with no-more-data-currently-available. This workaround is -;; thanks to Wayne Iba. -#+cmu -(defun read-bytes (connection howmany) - (declare (type fixnum howmany)) - (let ((v (make-array howmany :element-type '(unsigned-byte 8))) - (s (pgcon-stream connection))) - (do ((continue-at (read-sequence v s :start 0 :end howmany) - (read-sequence v s :start continue-at :end howmany))) - ((= continue-at howmany)) - ) - v)) - -(defun read-chars (connection howmany) - (declare (type fixnum howmany)) - (let ((bytes (read-bytes connection howmany)) - (str (make-string howmany))) - (dotimes (i howmany) - (setf (aref str i) (code-char (aref bytes i)))) - str)) - -(defun read-cstring (connection maxbytes) - "Read a null-terminated string from CONNECTION." - (declare (type fixnum maxbytes)) - (let ((stream (pgcon-stream connection)) - (chars nil)) - (do ((b (read-byte stream nil nil) (read-byte stream nil nil)) - (i 0 (+ i 1))) - ((or (= i maxbytes) ; reached allowed length - (null b) ; eof - (zerop b)) ; end of string - (concatenate 'string (nreverse chars))) - (push (code-char b) chars)))) - -;; highest order bits first -(defun send-int (connection int bytes) - (declare (type fixnum int bytes)) - (let ((v (make-array bytes :element-type '(unsigned-byte 8))) - (stream (pgcon-stream connection))) - (do ((i (- bytes 1) (- i 1))) - ((< i 0)) - (setf (aref v i) (rem int 256)) - (setq int (floor int 256))) - (write-sequence v stream))) - -(defun send-string (connection str &optional pad-to) - (let* ((stream (pgcon-stream connection)) - (len (length str)) - (v (make-array len :element-type '(unsigned-byte 8)))) - ;; convert the string to a vector of bytes - (dotimes (i len) - (setf (aref v i) (char-code (aref str i)))) - (write-sequence v stream) - ;; pad if necessary - (when pad-to - (write-sequence (make-array (- pad-to len) - :initial-element 0 - :element-type '(unsigned-byte 8)) - stream)))) - -(declaim (inline flush)) -(defun flush (connection) - (force-output (pgcon-stream connection))) ;; EOF Index: pg/v2-protocol.lisp diff -u pg/v2-protocol.lisp:1.1 pg/v2-protocol.lisp:1.2 --- pg/v2-protocol.lisp:1.1 Fri Mar 5 13:08:08 2004 +++ pg/v2-protocol.lisp Mon Mar 8 10:01:53 2004 @@ -1,7 +1,7 @@ ;;; v2-protocol.lisp -- frontend/backend protocol prior to PostgreSQL 7.4 ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> +;;; Time-stamp: <2004-03-08 emarsden> (in-package :postgresql) @@ -26,7 +26,7 @@ (send-int connection 0 2) ; protocol 6.3 minor (send-string connection dbname +SM_DATABASE+) (send-string connection user user-packet-length) - (flush connection) + (%flush connection) #+cmu (ext:finalize connection (lambda () (pg-disconnect connection))) (loop (case (read-byte stream) @@ -34,7 +34,7 @@ ((69) (close stream) (error 'authentication-failure - :reason (read-cstring connection 4096))) + :reason (%read-cstring connection 4096))) ;; Authentication ((82) @@ -52,16 +52,16 @@ (send-int connection (+ 5 (length password)) 4) (send-string connection password) (send-int connection 0 1) - (flush connection)) + (%flush connection)) ((4) ; AuthEncryptedPassword - (let* ((salt (read-chars connection 2)) + (let* ((salt (%read-chars connection 2)) (crypted (crypt password salt))) #+debug (format *debug-io* "Got salt of ~s~%" salt) (send-int connection (+ 5 (length crypted)) 4) (send-string connection crypted) (send-int connection 0 1) - (flush connection))) + (%flush connection))) ((1) ; AuthKerberos4 (error 'authentication-failure :reason "Kerberos4 authentication not supported")) @@ -89,7 +89,7 @@ (write-byte 81 stream) (send-string connection sql) (write-byte 0 stream) - (flush connection) + (%flush connection) (do ((b (read-byte stream nil :eof) (read-byte stream nil :eof))) ((eq b :eof) (error 'protocol-error :reason "unexpected EOF from backend")) @@ -109,7 +109,7 @@ ;; CompletedResponse, #\C ((67) - (let ((status (read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((status (%read-cstring connection +MAX_MESSAGE_LEN+))) (setf (pgresult-status result) status) (setf (pgresult-tuples result) (nreverse tuples)) (setf (pgresult-attributes result) attributes) @@ -124,7 +124,7 @@ ;; ErrorResponse, #\E ((69) - (let ((msg (read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((msg (%read-cstring connection +MAX_MESSAGE_LEN+))) (error 'backend-error :reason msg))) ;; #\G and #\H: start copy in, start copy out @@ -147,7 +147,7 @@ ;; CursorResponse, #\P ((80) - (let ((str (read-cstring connection +MAX_MESSAGE_LEN+))) + (let ((str (%read-cstring connection +MAX_MESSAGE_LEN+))) (declare (ignore str)) ;; (format *debug-io* "Portal name ~a~%" str) )) @@ -190,7 +190,7 @@ (send-string connection arg)) (t (error 'protocol-error :reason (format nil "Unknown fastpath type ~s" arg))))) - (flush connection) + (%flush connection) (loop :with result = nil :with ready = nil :for b = (read-byte (pgcon-stream connection) nil :eof) :do @@ -204,13 +204,13 @@ (let ((len (read-net-int connection 4))) (if integer-result (setq result (read-net-int connection len)) - (setq result (read-chars connection len))))) + (setq result (%read-chars connection len))))) (t (error 'protocol-error :reason "wierd FunctionResultResponse"))))) ;; end of FunctionResult ((48) (return-from fn result)) - ((69) (error 'backend-error :reason (read-cstring connection 4096))) + ((69) (error 'backend-error :reason (%read-cstring connection 4096))) ;; NoticeResponse ((78) @@ -226,7 +226,7 @@ (defmethod pg-disconnect ((connection pgcon-v2)) (write-byte 88 (pgcon-stream connection)) - (flush connection) + (%flush connection) (close (pgcon-stream connection)) (values)) @@ -240,7 +240,7 @@ (attributes '())) (do ((i attribute-count (- i 1))) ((zerop i) (nreverse attributes)) - (let ((type-name (read-cstring connection +MAX_MESSAGE_LEN+)) + (let ((type-name (%read-cstring connection +MAX_MESSAGE_LEN+)) (type-id (read-net-int connection 4)) (type-len (read-net-int connection 2)) ;; this doesn't exist in the 6.3 protocol !! @@ -266,7 +266,7 @@ (defun read-tuple/v2 (connection attributes) (let* ((num-attributes (length attributes)) (num-bytes (ceiling (/ num-attributes 8))) - (bitmap (read-bytes connection num-bytes)) + (bitmap (%read-bytes connection num-bytes)) (correction (if (pgcon-binary-p connection) 0 -4)) (tuples '())) (do ((i 0 (+ i 1)) @@ -276,13 +276,13 @@ (push nil tuples)) (t (let* ((len (+ (read-net-int connection 4) correction)) - (raw (read-chars connection (max 0 len))) + (raw (%read-chars connection (max 0 len))) (parsed (parse raw (car type-ids)))) (push parsed tuples))))))) ;; FIXME could signal a postgresql-notification condition (defun handle-notice (connection) - (push (read-cstring connection +MAX_MESSAGE_LEN+) + (push (%read-cstring connection +MAX_MESSAGE_LEN+) (pgcon-notices connection))) Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.2 pg/v3-protocol.lisp:1.3 --- pg/v3-protocol.lisp:1.2 Mon Mar 8 09:37:31 2004 +++ pg/v3-protocol.lisp Mon Mar 8 10:01:53 2004 @@ -1,7 +1,7 @@ ;;; v3-protocol.lisp -- frontend/backend protocol from PostgreSQL v7.4 ;;; ;;; Author: Peter Van Eynde <pvaneynd(a)debian.org> -;;; Time-stamp: <2004-03-05 emarsden> +;;; Time-stamp: <2004-03-08 emarsden> (in-package :postgresql) @@ -87,72 +87,6 @@ (and (slot-boundp object 'position) (slot-value object 'position))))) -;; first some help functions: - -;; read an integer in network byte order -(defun %read-net-int8 (stream) - "Reads an integer BYTES bytes long from the STREAM. -The signed integer is presumed to be in network order. -Returns the integer." - (let ((result (read-byte stream))) - (when (= 1 (ldb (byte 1 7) result)) - ;; negative - (setf result (- - (1+ (logxor result - #xFF))))) - result)) - -(defun %read-net-int16 (stream) - "Reads an integer BYTES bytes long from the STREAM. -The signed integer is presumed to be in network order. -Returns the integer." - (let ((result (+ (* 256 (read-byte stream)) - (read-byte stream)))) - (when (= 1 (ldb (byte 1 15) result)) - ;; negative - (setf result (- - (1+ (logxor result - #xFFFF))))) - result)) - -(defun %read-net-int32 (stream) - "Reads an integer BYTES bytes long from the STREAM. -The signed integer is presumed to be in network order. -Returns the integer." - (let ((result (+ (* 256 256 256 (read-byte stream)) - (* 256 256 (read-byte stream)) - (* 256 (read-byte stream)) - (read-byte stream)))) - (when (= 1 (ldb (byte 1 31) result)) - ;; negative - (setf result (- - (1+ (logxor result - #xFFFFFFFF))))) - result)) - -#-cmu -(defun %read-bytes (stream howmany) - "Reads HOWMANY bytes from the STREAM. -Returns the array of " - (let ((v (make-array howmany :element-type '(unsigned-byte 8)))) - (read-sequence v stream) - v)) - -;; There is a bug in CMUCL's implementation of READ-SEQUENCE on -;; network streams, which can return without reading to the end of the -;; sequence when it has to wait for data. It confuses the end-of-file -;; condition with no-more-data-currently-available. This workaround is -;; thanks to Wayne Iba. -#+cmu -(defun %read-bytes (stream howmany) - "Reads HOWMANY bytes from the STREAM. -Returns the array of " - (let ((v (make-array howmany :element-type '(unsigned-byte 8)))) - (do ((continue-at (read-sequence v stream :start 0 :end howmany) - (read-sequence v stream :start continue-at :end howmany))) - ((= continue-at howmany)) - ) - v)) ;; the error and notice functions: @@ -329,33 +263,6 @@ (incf position length) result)))) - -;; now sending data: - -(defun %send-net-int (stream int bytes) - (let ((v (make-array bytes :element-type '(unsigned-byte 8)))) - (loop for offset from (* 8 (1- bytes)) downto 0 by 8 - for data = (ldb (byte 8 offset) int) - for i from 0 - do - (setf (elt v i) data)) - #+debug - (format t "~&writing: ~S~%" v) - (write-sequence v stream))) - -(defun %send-cstring (stream str) - "Sends a null-terminated string to CONNECTION" - (let* ((len (length str)) - (v (make-array len :element-type '(unsigned-byte 8)))) - ;; convert the string to a vector of bytes - (dotimes (i len) - (setf (elt v i) (char-code (elt str i)))) - (write-sequence v stream) - (write-byte 0 stream))) - -(declaim (inline %flush)) -(defun %flush (connection) - (force-output (pgcon-stream connection))) (defun send-packet (connection code description)

1 0