Commit 03286113 authored by Eric Marsden's avatar Eric Marsden

More factorization of lowlevel functions between v2 and v3 protocols.

parent b55b938c
......@@ -4,3 +4,10 @@ Eric Marsden:
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.
=== 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
......
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 @@ pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp
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 @@ pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp
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
......@@ -262,13 +255,3 @@ 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*.
;;; lowlevel.lisp -- lowlevel network
;;;
;;; Author: Eric Marsden <emarsden>
;;; Time-stamp: <2004-03-08 emarsden>
(in-package :postgresql)
;; 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))
(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))))
;; read an integer in network byte order
(defun read-net-int (connection bytes)
(do ((i bytes (- i 1))
(stream (pgcon-stream connection))
(accum 0))
((zerop i) accum)
(setq accum (+ (* 256 accum) (read-byte 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))))
;; 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-net-int (stream int bytes)
(declare (type stream stream)
(type fixnum 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 (aref 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 (aref v i) (char-code (aref str i))))
(write-sequence v stream)
(write-byte 0 stream)))
(declaim (inline %flush))
(defun %flush (connection)
(force-output (pgcon-stream connection)))
;; EOF
;;; 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)
......
......@@ -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"))
......
;;; 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
......@@ -277,105 +277,4 @@ and WHAT should be one of
(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
;;; 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 @@ to connect to the database using a Unix socket."
(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 @@ to connect to the database using a Unix socket."
((69)
(close stream)
(error 'authentication-failure
:reason (read-cstring connection 4096)))
:reason (%read-cstring connection 4096)))
;; Authentication
((82)
......@@ -52,16 +52,16 @@ to connect to the database using a Unix socket."
(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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
;; 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 @@ a result structure which can be decoded using `pg-result'."
;; 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 @@ a result structure which can be decoded using `pg-result'."
;; 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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
(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 @@ a result structure which can be decoded using `pg-result'."
(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)))
......
;;; 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:
......@@ -330,33 +264,6 @@ but will still return them"
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)
"Sends a packet to the connection. CODE is the
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment