[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
Eric Marsden
emarsden at common-lisp.net
Mon Mar 8 15:01:55 UTC 2004
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 at 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 at 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 at 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 at 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 at 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 at 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 at 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 at 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)
More information about the Pg-cvs
mailing list