pg-cvs November 2006

pg-cvs@common-lisp.net

1 participants
3 discussions

[pg-cvs] CVS pg
by emarsden 26 Nov '06

26 Nov '06

Update of /project/pg/cvsroot/pg In directory clnet:/tmp/cvs-serv5864 Modified Files: v3-protocol.lisp Log Message: Make sure we consume the ReadyForQuery packet that is generated when closing a prepared statement or portal, or the packet can be misinterpreted by a later query, leading to data loss. Fix from Robert J. Macomber. --- /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/20 20:50:36 1.29 +++ /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/26 18:05:11 1.30 @@ -485,8 +485,8 @@ (defun do-followup-query (connection) "Does the followup of a query" - (let ((tuples '()) - (attributes '()) + (let ((tuples (list)) + (attributes (list)) (result (make-pgresult :connection connection))) (loop :for packet = (read-packet connection) @@ -592,6 +592,7 @@ ((#\Z) ;; ReadyForQuery (let ((status (read-from-packet packet :byte))) + (declare (ignore status)) (when got-data-p (return-from do-followup-query result)))) @@ -613,12 +614,11 @@ ((#\2 #\1 #\3) (return-from do-followup-query result)) - ((#\n) + ((#\n) ;; NoData (setf got-data-p t)) ;; error messages will already have been handled in READ-PACKET ((#\E) - (error "not reached!") (setq got-data-p t)) ;; notice messages will already have been handled in READ-PACKET @@ -929,7 +929,9 @@ (loop :for packet = (read-packet connection) :do (case (pg-packet-type packet) - ((#\3 #\Z) ;; CloseComplete or ReadyForQuery + ((#\3) + t) + ((#\Z) ;; CloseComplete or ReadyForQuery (return)) (t (warn "Got unexpected packet in PG-CLOSE: ~S, resetting connection" packet)

1 0

[pg-cvs] CVS pg
by emarsden 20 Nov '06

20 Nov '06

Update of /project/pg/cvsroot/pg In directory clnet:/tmp/cvs-serv3853 Modified Files: README pg.lisp utility.lisp v2-protocol.lisp v3-protocol.lisp Log Message: Add an ABORT keyword argument to PG-DISCONNECT (from Robert J. Macomber <pgsql(a)rojoma.com>), as per CL:CLOSE. "I've run into a problem with pg-disconnect if something abnormal happens to the database connection -- if the database goes away for a restart while pg has a connection open, for example. When this happens, pg-disconnect fails, and the socket file descriptor is left open (presumably for a finalizer to clean up), also raising a new error from the unwind-protect in with-pg-connection. To guard against the possibility, I've added an :abort parameter to pg-disconnect, like cl:close has, and made with-pg-connection call it with :abort t if the body exits abnormally, in the same way that with-open-file operates. When :abort is true, the modified pg-disconnect closes the database connection ungracefully, including making the close call abort (otherwise, sbcl at keast tries to flush the stream, raising another error if the database isn't there anymore)." --- /project/pg/cvsroot/pg/README 2006/09/23 12:24:28 1.9 +++ /project/pg/cvsroot/pg/README 2006/11/20 20:50:36 1.10 @@ -102,8 +102,11 @@ you have a large amount of data to handle, this usage is more efficient than fetching all the tuples in one go. - (pg-disconnect connection) -> nil - Close the database connection. + (pg-disconnect connection &key abort) -> nil + Close the database connection. If the keyword argument ABORT is + non-NIL, the database connection is closed immediately, without + first attempting to send a disconnect packet to the PostgreSQL + backend. === Support for prepared statements ==================================== --- /project/pg/cvsroot/pg/pg.lisp 2006/11/19 18:47:58 1.10 +++ /project/pg/cvsroot/pg/pg.lisp 2006/11/20 20:50:36 1.11 @@ -174,7 +174,7 @@ element in the pg_proc table, and otherwise it is a string which we look up in the alist *lo-functions* to find the corresponding OID.")) -(defgeneric pg-disconnect (connection) +(defgeneric pg-disconnect (connection &key abort) (:documentation "Disconnects from the DB")) --- /project/pg/cvsroot/pg/utility.lisp 2006/10/22 19:22:39 1.2 +++ /project/pg/cvsroot/pg/utility.lisp 2006/11/20 20:50:36 1.3 @@ -36,10 +36,14 @@ CONNECTION. If the connection is unsuccessful, the forms are not evaluated. Otherwise, the BODY forms are executed, and upon termination, normal or otherwise, the database connection is closed." - `(let ((,con (pg-connect ,@open-args))) - (unwind-protect - (progn ,@body) - (when ,con (pg-disconnect ,con))))) + (let ((ok (gensym))) + `(let ((,con (pg-connect ,@open-args)) + (,ok nil)) + (unwind-protect + (multiple-value-prog1 + (progn ,@body) + (setf ,ok t)) + (when ,con (pg-disconnect ,con :abort (not ,ok))))))) ;; this is the old version #+(or) --- /project/pg/cvsroot/pg/v2-protocol.lisp 2006/11/19 18:47:59 1.6 +++ /project/pg/cvsroot/pg/v2-protocol.lisp 2006/11/20 20:50:36 1.7 @@ -237,10 +237,14 @@ :reason (format nil "Unexpected byte ~s" b))))))) -(defmethod pg-disconnect ((connection pgcon-v2)) - (write-byte 88 (pgcon-stream connection)) - (%flush connection) - (close (pgcon-stream connection)) +(defmethod pg-disconnect ((connection pgcon-v2) &key abort) + (cond + (abort + (close (pgcon-stream connection) :abort t)) + (t + (write-byte 88 (pgcon-stream connection)) + (%flush connection) + (close (pgcon-stream connection)))) (values)) --- /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/19 18:47:59 1.28 +++ /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/20 20:50:36 1.29 @@ -641,10 +641,14 @@ (do-followup-query connection))) -(defmethod pg-disconnect ((connection pgcon-v3)) - (send-packet connection #\X nil) - (%flush connection) - (close (pgcon-stream connection)) +(defmethod pg-disconnect ((connection pgcon-v3) &key abort) + (cond + (abort + (close (pgcon-stream connection) :abort t)) + (t + (send-packet connection #\X nil) + (%flush connection) + (close (pgcon-stream connection)))) (values))

1 0

[pg-cvs] CVS pg
by emarsden 19 Nov '06

19 Nov '06

Update of /project/pg/cvsroot/pg In directory clnet:/tmp/cvs-serv29766 Modified Files: pg-tests.lisp pg.lisp sysdep.lisp v2-protocol.lisp v3-protocol.lisp Log Message: Allow encoding used for socket communication with the backend to be specified as a keyword argument to PG-CONNECT, for cases where rebinding *PG-CLIENT-ENCODING* is inconvenient. Add a simple test for encoding support. (From Attila Lendvai <attila.lendvai(a)gmail.com>) --- /project/pg/cvsroot/pg/pg-tests.lisp 2006/09/24 21:19:30 1.12 +++ /project/pg/cvsroot/pg/pg-tests.lisp 2006/11/19 18:47:58 1.13 @@ -21,16 +21,17 @@ (when ,con (pg-disconnect ,con))))) ;; !!! CHANGE THE VALUES HERE !!! -(defun call-with-test-connection (function) - (with-pg-connection (conn "test" "pgdotlisp" - :host "localhost" - ;; :host "/var/run/postgresql/" - ) - (funcall function conn))) - -(defmacro with-test-connection ((conn) &body body) - `(call-with-test-connection - (lambda (,conn) ,@body))) +(defmacro with-test-connection ((conn &key (database "test") + (user-name "pgdotlisp") + (password "secret") + (host "localhost") ;; or "/var/run/postgresql/" + (port 5432) + (encoding *pg-client-encoding*)) + &body body) + `(with-pg-connection (,conn ,database ,user-name :password ,password + :host ,host :port ,port :encoding ,encoding) + ,@body)) + (defun check-single-return (conn sql expected &key (test #'eql)) (let ((res (pg-exec conn sql))) @@ -40,8 +41,7 @@ (defun test-insert () (format *debug-io* "Testing INSERT & SELECT on integers ...~%") (with-test-connection (conn) - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -65,8 +65,7 @@ (defun test-insert/float () (format *debug-io* "Testing INSERT & SELECT on floats ...~%") (with-test-connection (conn) - (let ((res nil) - (sum 0.0) + (let ((sum 0.0) (created nil)) (flet ((float-eql (a b) (< (/ (abs (- a b)) b) 1e-5))) @@ -110,7 +109,7 @@ (pg-for-each conn "SELECT val FROM count_test_numeric" (lambda (tuple) (incf sum (first tuple)))) (assert (eql 500500 sum))) - (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN) + ;; (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN) (check-single-return conn "SELECT 1 / (!! 2)" 1/2) (when created (pg-exec conn "DROP TABLE count_test_numeric")))))) @@ -384,6 +383,20 @@ ;; (format t "stat(\"/tmp\"): ~S~%" (pg-result res :tuples))))) +(defun test-encoding () + (let ((octets (coerce '(105 97 122 115 124) '(vector (unsigned-byte 8))))) + (dolist (encoding '("UTF8" "LATIN1" "LATIN2")) + (let ((encoded (pg::convert-string-from-bytes octets encoding))) + (with-test-connection (conn :encoding encoding) + (ignore-errors + (pg-exec conn "DROP TABLE encoding_test")) + (pg-exec conn "CREATE TABLE encoding_test (a VARCHAR(40))") + (pg-exec conn "INSERT INTO encoding_test VALUES ('" encoded "')") + (check-single-return conn "SELECT * FROM encoding_test" encoded :test #'string=) + (pg-exec conn "DROP TABLE encoding_test")))))) + + + ;; Fibonnaci numbers with memoization via a database table (defun fib (n) (declare (type integer n)) @@ -532,7 +545,7 @@ (with-test-connection (con) (dotimes (i 5000) (if (= (mod i 1000) 0) (format dio "~s connected over ~S producing ~a~%" - sb-thread:*current-thread* mycony i)) + sb-thread:*current-thread* con i)) (pg-exec con (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i)) (when (zerop (mod i 100)) (pg-exec con "COMMIT WORK"))))) @@ -556,8 +569,7 @@ (with-test-connection (conn) (when (pg-supports-pbe conn) (format *debug-io* "~&Testing PBE/int4 ...") - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -574,11 +586,8 @@ (:int32 ,(* i i)))) (pg-execute conn "ct_portal") (pg-close-portal conn "ct_portal")) - (format *debug-io* "~&data inserted") - (setq res (pg-exec conn "SELECT count(val) FROM count_test")) - (assert (eql 100 (first (pg-result res :tuple 0)))) - (setq res (pg-exec conn "SELECT sum(key) FROM count_test")) - (assert (eql 5050 (first (pg-result res :tuple 0)))) + (check-single-return conn "SELECT count(val) FROM count_test" 100) + (check-single-return conn "SELECT sum(key) FROM count_test" 5050) ;; this iterator does the equivalent of the sum(key) SQL statement ;; above, but on the client side. (pg-for-each conn "SELECT key FROM count_test" @@ -591,8 +600,7 @@ (with-test-connection (conn) (when (pg-supports-pbe conn) (format *debug-io* "~&Testing PBE/text...") - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -609,11 +617,8 @@ (:string ,(format nil "~a" (* i i))))) (pg-execute conn "ct_portal/text") (pg-close-portal conn "ct_portal/text")) - (format *debug-io* "~&data inserted") - (setq res (pg-exec conn "SELECT count(val) FROM pbe_text_test")) - (assert (eql 100 (first (pg-result res :tuple 0)))) - (setq res (pg-exec conn "SELECT sum(key) FROM pbe_text_test")) - (assert (eql 5050 (first (pg-result res :tuple 0)))) + (check-single-return conn "SELECT count(val) FROM pbe_text_test" 100) + (check-single-return conn "SELECT sum(key) FROM pbe_text_test" 5050) ;; this iterator does the equivalent of the sum(key) SQL statement ;; above, but on the client side. (pg-for-each conn "SELECT key FROM pbe_text_test" --- /project/pg/cvsroot/pg/pg.lisp 2006/09/18 19:10:38 1.9 +++ /project/pg/cvsroot/pg/pg.lisp 2006/11/19 18:47:58 1.10 @@ -1,7 +1,7 @@ ;;; pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp ;; ;; Author: Eric Marsden <eric.marsden(a)free.fr> -;; Time-stamp: <2006-09-15 emarsden> +;; Time-stamp: <2006-11-19 emarsden> ;; Version: 0.22 ;; ;; Copyright (C) 1999,2000,2001,2002,2003,2004,2005 Eric Marsden @@ -121,7 +121,8 @@ (defconstant +MAX_MESSAGE_LEN+ 8192) ; libpq-fe.h (defvar *pg-client-encoding* "LATIN1" - "The encoding to use for text data, for example \"LATIN1\", \"UTF8\", \"EUC_JP\". + "The encoding that will be used for communication with the PostgreSQL backend, +for example \"LATIN1\", \"UTF8\", \"EUC_JP\". See <http://www.postgresql.org/docs/7.3/static/multibyte.html>.") (defvar *pg-date-style* "ISO") @@ -142,7 +143,9 @@ (notices :accessor pgcon-notices :initform (list)) (binary-p :accessor pgcon-binary-p - :initform nil))) + :initform nil) + (encoding :accessor pgcon-encoding + :initarg :encoding))) (defmethod print-object ((self pgcon) stream) (print-unreadable-object (self stream :type nil) @@ -217,25 +220,28 @@ ;; the v2 protocol. This allows us to connect to PostgreSQL 7.4 ;; servers using the benefits of the new protocol, but still interact ;; with older servers. -(defun pg-connect (dbname user &key (host "localhost") (port 5432) (password "")) +(defun pg-connect (dbname user &key (host "localhost") (port 5432) (password "") (encoding *pg-client-encoding*)) "Initiate a connection with the PostgreSQL backend. -Connect to the database DBNAME with the username USER, -on PORT of HOST, providing PASSWORD if necessary. Return a -connection to the database (as an opaque type). If HOST is nil, attempt -to connect to the database using a Unix socket. -We first attempt to speak the PostgreSQL 7.4 protocol, and fall back to -the older network protocol if necessary." +Connect to the database DBNAME with the username USER, on PORT of +HOST, providing PASSWORD if necessary. Return a connection to the +database (as an opaque type). If HOST is a pathname or a string +starting with #\/, it designates the directory containing the Unix +socket on which PostgreSQL's backend is waiting for local connections. +We first attempt to speak the PostgreSQL 7.4 protocol, and fall back +to the older network protocol if necessary." (handler-case (pg-connect/v3 dbname user :host host :port port - :password password) + :password password + :encoding encoding) (protocol-error (c) (declare (ignore c)) (warn "reconnecting using protocol version 2") (pg-connect/v2 dbname user :host host :port port - :password password)))) + :password password + :encoding encoding)))) (defun pg-result (result what &rest args) --- /project/pg/cvsroot/pg/sysdep.lisp 2006/10/22 19:22:39 1.18 +++ /project/pg/cvsroot/pg/sysdep.lisp 2006/11/19 18:47:59 1.19 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <eric.marsden(a)free.fr> -;;; Time-stamp: <2006-09-30 emarsden> +;;; Time-stamp: <2006-11-19 emarsden> ;; ;; @@ -333,6 +333,7 @@ #+(and clisp unicode) (cond ((string-equal encoding "SQL_ASCII") charset:ascii) ((string-equal encoding "LATIN1") charset:iso-8859-1) + ((string-equal encoding "LATIN2") charset:iso-8859-2) ((string-equal encoding "LATIN9") charset:iso-8859-9) ((string-equal encoding "UTF8") charset:utf-8) (t (error "unknown encoding ~A" encoding))) @@ -344,14 +345,15 @@ (t (error "unknown encoding ~A" encoding))) #+(and sbcl sb-unicode) (cond ((string-equal encoding "SQL_ASCII") :ascii) - ((string-equal encoding "LATIN1") :latin1) - ((string-equal encoding "LATIN9") :latin9) + ((string-equal encoding "LATIN1") :iso-8859-1) + ((string-equal encoding "LATIN2") :iso-8859-2) + ((string-equal encoding "LATIN9") :iso-8859-9) ((string-equal encoding "UTF8") :utf8) (t (error "unknown encoding ~A" encoding))) #+(or cmu gcl ecl abcl openmcl lispworks) nil)) -(defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*)) +(defun convert-string-to-bytes (string encoding) (declare (type string string)) (%sysdep "convert string to octet-array" #+(and clisp unicode) @@ -368,7 +370,7 @@ (map-into octets #'char-code string)) (error "Can't convert ~A string to octets" encoding)))) -(defun convert-string-from-bytes (bytes &optional (encoding *pg-client-encoding*)) +(defun convert-string-from-bytes (bytes encoding) (declare (type (vector (unsigned-byte 8)) bytes)) (%sysdep "convert octet-array to string" #+(and clisp unicode) --- /project/pg/cvsroot/pg/v2-protocol.lisp 2005/07/17 15:48:06 1.5 +++ /project/pg/cvsroot/pg/v2-protocol.lisp 2006/11/19 18:47:59 1.6 @@ -10,14 +10,15 @@ -(defun pg-connect/v2 (dbname user &key (host "localhost") (port 5432) (password "")) +(defun pg-connect/v2 (dbname user &key (host "localhost") (port 5432) (password "") (encoding *pg-client-encoding*)) "Initiate a connection with the PostgreSQL backend, using protocol v2. -Connect to the database DBNAME with the username USER, -on PORT of HOST, providing PASSWORD if necessary. Return a -connection to the database (as an opaque type). If HOST is nil, attempt -to connect to the database using a Unix socket." +Connect to the database DBNAME with the username USER, on PORT of +HOST, providing PASSWORD if necessary. Return a connection to the +database (as an opaque type). If HOST is a pathname or a string whose +first character is #\/, it designates the directory containing the +Unix socket on which the PostgreSQL backend is listening." (let* ((stream (socket-connect port host)) - (connection (make-instance 'pgcon-v2 :stream stream :host host :port port)) + (connection (make-instance 'pgcon-v2 :stream stream :host host :port port :encoding encoding)) (user-packet-length (+ +SM_USER+ +SM_OPTIONS+ +SM_UNUSED+ +SM_TTY+))) ;; send the startup packet (send-int connection +STARTUP_PACKET_SIZE+ 4) @@ -43,8 +44,8 @@ (initialize-parsers connection)) (when *pg-date-style* (setf (pg-date-style connection) *pg-date-style*)) - (when *pg-client-encoding* - (setf (pg-client-encoding connection) *pg-client-encoding*)) + (when encoding + (setf (pg-client-encoding connection) encoding)) (return connection)) ((3) ; AuthUnencryptedPassword (send-int connection (+ 5 (length password)) 4) --- /project/pg/cvsroot/pg/v3-protocol.lisp 2006/10/22 19:25:51 1.27 +++ /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/19 18:47:59 1.28 @@ -12,8 +12,6 @@ (defclass pgcon-v3 (pgcon) ((parameters :accessor pgcon-parameters :initform (list)) - (encoding :accessor pgcon-encoding - :initform nil) (sql-stream :initform nil :accessor pgcon-sql-stream :type (or null stream)))) @@ -255,7 +253,8 @@ (cond ((pgcon-encoding connection) (let* ((end (position 0 data :start position)) (result (unless (eql end position) - (convert-string-from-bytes (subseq data position end))))) + (convert-string-from-bytes (subseq data position end) + (pgcon-encoding connection))))) (when result (setf position (1+ end))) result)) ;; the encoding has not yet been set, so revert to :ucstring behaviour @@ -275,13 +274,14 @@ (when (< length 0) (error "length cannot be negative. is: ~S" length)) - (let* ((octets (read-octets-from-packet packet length)) - (encoding (if (or (eql #\R (pg-packet-type packet)) - (eql #\E (pg-packet-type packet))) - "LATIN1" - *pg-client-encoding*)) - (string (convert-string-from-bytes octets encoding))) - string))) + (with-slots (connection) packet + (let* ((octets (read-octets-from-packet packet length)) + (encoding (if (or (eql #\R (pg-packet-type packet)) + (eql #\E (pg-packet-type packet))) + "LATIN1" + (pgcon-encoding connection))) + (string (convert-string-from-bytes octets encoding))) + string)))) (defgeneric read-octets-from-packet (packet length)) @@ -310,8 +310,8 @@ ((:int16) 2) ((:int32) 4) ((:rawdata) (length value)) - ((:string) (length (convert-string-to-bytes value))) - ((:cstring) (1+ (length (convert-string-to-bytes value)))) + ((:string) (length (convert-string-to-bytes value (pgcon-encoding connection)))) + ((:cstring) (1+ (length (convert-string-to-bytes value (pgcon-encoding connection))))) ((:ucstring) (1+ (length value))))))) (data (make-array (- length 4) :element-type '(unsigned-byte 8))) @@ -354,7 +354,7 @@ ((:cstring) (check-type value string) - (let ((encoded (convert-string-to-bytes value))) + (let ((encoded (convert-string-to-bytes value (pgcon-encoding connection)))) (declare (type (vector (unsigned-byte 8) *) encoded)) (replace data encoded :start1 position) (incf position (length encoded))) @@ -364,7 +364,7 @@ ;; a string without the trailing NUL character ((:string) (check-type value string) - (let ((encoded (convert-string-to-bytes value))) + (let ((encoded (convert-string-to-bytes value (pgcon-encoding connection)))) (declare (type (vector (unsigned-byte 8) *) encoded)) (replace data encoded :start1 position) (incf position (length encoded)))) @@ -380,14 +380,15 @@ (%flush connection))) -(defun pg-connect/v3 (dbname user &key (host "localhost") (port 5432) (password "")) +(defun pg-connect/v3 (dbname user &key (host "localhost") (port 5432) (password "") (encoding *pg-client-encoding*)) "Initiate a connection with the PostgreSQL backend. -Connect to the database DBNAME with the username USER, -on PORT of HOST, providing PASSWORD if necessary. Return a -connection to the database (as an opaque type). If HOST is nil, attempt -to connect to the database using a Unix socket." +Connect to the database DBNAME with the username USER, on PORT of +HOST, providing PASSWORD if necessary. Return a connection to the +database (as an opaque type). If HOST is a pathname or a string whose +first character is #\/, it designates the directory containing the +Unix socket on which the PostgreSQL backend is listening." (let* ((stream (socket-connect port host)) - (connection (make-instance 'pgcon-v3 :stream stream :host host :port port)) + (connection (make-instance 'pgcon-v3 :stream stream :host host :port port :encoding encoding)) (connect-options `("user" ,user "database" ,dbname)) (user-packet-length (+ 4 4 (loop :for item :in connect-options :sum (1+ (length item))) 1))) @@ -441,7 +442,7 @@ (t (error 'authentication-failure :reason "unknown authentication type"))))) - (( #\K) + ((#\K) ;; Cancelation (let* ((pid (read-from-packet packet :int32)) (secret (read-from-packet packet :int32))) @@ -462,8 +463,8 @@ (let* ((status (read-from-packet packet :byte))) (unless (= status (char-code #\I)) (warn "~&Got status ~S but wanted I~%" (code-char status))) - (when *pg-client-encoding* - (setf (pg-client-encoding connection) *pg-client-encoding*)) + (when encoding + (setf (pg-client-encoding connection) encoding)) (and (not *pg-disable-type-coercion*) (null *parsers*) (initialize-parsers connection))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

pg-cvs November 2006