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@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@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@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@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@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@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@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@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)