From attila.lendvai at gmail.com Fri Nov 10 22:45:24 2006 From: attila.lendvai at gmail.com (Attila Lendvai) Date: Fri, 10 Nov 2006 23:45:24 +0100 Subject: [pg-devel] one more on board Message-ID: hi! we started to play with pg and it usually means that we'll have some patches soon. to avoid trouble with cvs text patches i've converted the repo to darcs with the help of tailor and set up a branch at http://common-lisp.net/project/cl-wdim/darcs/ which i hope you don't mind. i'll keep this mirror in sync and it'll contain our changes. if you prefer cvs i'll send the patches as cvs diffs, but i wouldn't mind if you copied the already converted darcs repo and use that... (hint hint ;) it'll also available at the cl.net darcsweb page once the script takes it up: http://common-lisp.net/cgi-bin/darcsweb/darcsweb.cgi hoping you'll get some useful patches soon, -- - attila "- The truth is that I've been too considerate, and so became unintentionally cruel... - I understand. - No, you don't understand! We don't speak the same language!" (Ingmar Bergman - Smultronst?llet) From attila.lendvai at gmail.com Sat Nov 11 12:44:33 2006 From: attila.lendvai at gmail.com (Attila Lendvai) Date: Sat, 11 Nov 2006 13:44:33 +0100 Subject: [pg-devel] Re: one more on board In-Reply-To: References: Message-ID: > i'll keep this mirror in sync and it'll contain our changes. if you > prefer cvs i'll send the patches as cvs diffs, but i wouldn't mind if > you copied the already converted darcs repo and use that... (hint hint > ;) unfortunately tailor had trouble with the pg repo when converting from INITIAL to preserve the cvs history (some files were missing from the result), so the darcs repo starts from the current head unfortunately. i've pushed a small cleanup that uses *pg-client-encoding* only to initialize the connection's encoding slot and later on that is used everywhere. also gave a :encoding keyword param to the connection creation. this helps in situations where rebinding is not that easy (when used as a backend plugin in an rdbms abstraction layer). also added an encoding test with some latin2 chars. pg is great, small and lightweight, thanks for making it opensource! -- - attila "- The truth is that I've been too considerate, and so became unintentionally cruel... - I understand. - No, you don't understand! We don't speak the same language!" (Ingmar Bergman - Smultronst?llet) -------------- next part -------------- Index: pg-tests.lisp =================================================================== RCS file: /project/pg/cvsroot/pg/pg-tests.lisp,v retrieving revision 1.12 diff -u -r1.12 pg-tests.lisp --- pg-tests.lisp 24 Sep 2006 21:19:30 -0000 1.12 +++ pg-tests.lisp 11 Nov 2006 12:36:24 -0000 @@ -21,16 +21,14 @@ (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) , at body))) +;; :host "/var/run/postgresql/" +(defmacro with-test-connection ((conn &key (database "dwim") (user-name "root") + (password "admin123") (host "localhost") (port 5432) + (encoding *pg-client-encoding*)) + &body body) + `(with-pg-connection (,conn ,database ,user-name :password ,password + :host ,host :port ,port :encoding ,encoding) + , at body)) (defun check-single-return (conn sql expected &key (test #'eql)) (let ((res (pg-exec conn sql))) @@ -670,6 +668,20 @@ (pg-exec conn "INSERT INTO pg_trigger_table VALUES (3, 4)") (pg-exec conn "DROP TABLE pg_trigger_table"))) +;; assumes that the lisp source file is processed as utf-8 +(defun test-encoding () + (let ((value "??????????????") ; some chars in the :iso-8859-2 encoding + (result)) + (with-test-connection (conn :encoding "UTF8") ; LATIN2 is the hungarian encoding, that should work, too + (ignore-errors + (pg-exec conn "DROP TABLE encoding_test")) + (pg-exec conn "CREATE TABLE encoding_test (a varchar(40))") + (pg-exec conn (concatenate 'string "INSERT INTO encoding_test VALUES ('" value "')")) + (setf result (first (first (pg-result (pg-exec conn "SELECT * FROM encoding_test") + :tuples)))) + (assert (string= result value)) + (pg-exec conn "DROP TABLE encoding_test") + result))) (defun test () (let (#+nil(*pg-client-encoding* "UTF8")) @@ -703,6 +715,7 @@ (test-notifications) (test-lo) (test-lo-read) + (test-encoding) #+cmu (test-lo-import) (test-pbe) (test-pbe-text) Index: pg.lisp =================================================================== RCS file: /project/pg/cvsroot/pg/pg.lisp,v retrieving revision 1.9 diff -u -r1.9 pg.lisp --- pg.lisp 18 Sep 2006 19:10:38 -0000 1.9 +++ pg.lisp 11 Nov 2006 12:36:24 -0000 @@ -121,8 +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\". -See .") + "The encoding that will be used on the socket while comminucating with the server. +(\"LATIN1\", \"UTF8\", \"EUC_JP\", etc). See .") (defvar *pg-date-style* "ISO") @@ -142,7 +142,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,7 +219,8 @@ ;; 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 @@ -228,14 +231,16 @@ (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) Index: sysdep.lisp =================================================================== RCS file: /project/pg/cvsroot/pg/sysdep.lisp,v retrieving revision 1.18 diff -u -r1.18 sysdep.lisp --- sysdep.lisp 22 Oct 2006 19:22:39 -0000 1.18 +++ sysdep.lisp 11 Nov 2006 12:36:24 -0000 @@ -344,14 +344,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 +369,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) Index: v2-protocol.lisp =================================================================== RCS file: /project/pg/cvsroot/pg/v2-protocol.lisp,v retrieving revision 1.5 diff -u -r1.5 v2-protocol.lisp --- v2-protocol.lisp 17 Jul 2005 15:48:06 -0000 1.5 +++ v2-protocol.lisp 11 Nov 2006 12:36:25 -0000 @@ -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." (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) Index: v3-protocol.lisp =================================================================== RCS file: /project/pg/cvsroot/pg/v3-protocol.lisp,v retrieving revision 1.27 diff -u -r1.27 v3-protocol.lisp --- v3-protocol.lisp 22 Oct 2006 19:25:51 -0000 1.27 +++ v3-protocol.lisp 11 Nov 2006 12:36:25 -0000 @@ -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)))) @@ -252,15 +250,12 @@ ;; its prefered encoding (:method ((packet pg-packet) (type (eql :cstring))) (with-slots (data position connection) packet - (cond ((pgcon-encoding connection) - (let* ((end (position 0 data :start position)) - (result (unless (eql end position) - (convert-string-from-bytes (subseq data position end))))) - (when result (setf position (1+ end))) - result)) - ;; the encoding has not yet been set, so revert to :ucstring behaviour - (t - (read-from-packet packet :ucstring)))))) + (let* ((end (position 0 data :start position)) + (result (unless (eql end position) + (convert-string-from-bytes (subseq data position end) + (pgcon-encoding connection))))) + (when result (setf position (1+ end))) + result)))) ;; FIXME need to check all callers of this function to distinguish @@ -275,13 +270,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 +306,10 @@ ((: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 +352,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 +362,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 +378,14 @@ (%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." (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 +439,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 +460,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)) From travis at travislists.com Sat Nov 11 22:19:25 2006 From: travis at travislists.com (Travis Cross) Date: Sat, 11 Nov 2006 17:19:25 -0500 Subject: [pg-devel] Move pg repos to darcs? (was: Re: one more on board) In-Reply-To: References: Message-ID: <45564C6D.4000703@travislists.com> Attila Lendvai wrote: >> i'll keep this mirror in sync and it'll contain our changes. if you >> prefer cvs i'll send the patches as cvs diffs, but i wouldn't mind if >> you copied the already converted darcs repo and use that... (hint hint >> ;) > > unfortunately tailor had trouble with the pg repo when converting from > INITIAL to preserve the cvs history (some files were missing from the > result), so the darcs repo starts from the current head unfortunately. Something must have changed in the CVS repos recently to cause this, as, starting from scratch, I wasn't able to make a clean conversion of the CVS repos either. Fortunately I've been tracking the pg repos for some time, and I believe my darcs repos is complete and accurate back to the initial CVS import: http://darcs.tcross.org/pg/ Eric - you are more than welcome to use this as a base for moving the pg project on cl.net to darcs from CVS. I believe this would enable and encourage more contributions to the project, as it would become easier to track the latest version and integrate one's own changes. Cheers, -- Travis From attila.lendvai at gmail.com Mon Nov 13 01:21:13 2006 From: attila.lendvai at gmail.com (Attila Lendvai) Date: Mon, 13 Nov 2006 02:21:13 +0100 Subject: [pg-devel] Re: Move pg repos to darcs? (was: Re: one more on board) In-Reply-To: <45564C6D.4000703@travislists.com> References: <45564C6D.4000703@travislists.com> Message-ID: > Fortunately I've been tracking the pg repos for some time, and I > believe my darcs repos is complete and accurate back to the initial > CVS import: > > http://darcs.tcross.org/pg/ fyi, i've made a copy of this darcs repo and pushed my patch to: http://common-lisp.net/cgi-bin/darcsweb/darcsweb.cgi?r=cl-wdim-pg;a=summary darcs pull --no-set-default http://www.common-lisp.net/project/cl-wdim/darcs/pg/ -- - attila "- The truth is that I've been too considerate, and so became unintentionally cruel... - I understand. - No, you don't understand! We don't speak the same language!" (Ingmar Bergman - Smultronst?llet) From eric.marsden at free.fr Sun Nov 19 18:50:05 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 19 Nov 2006 19:50:05 +0100 Subject: [pg-devel] Re: one more on board In-Reply-To: (Attila Lendvai's message of "Sat, 11 Nov 2006 13:44:33 +0100") References: Message-ID: <87slgfe0f6.fsf@free.fr> >>>>> "al" == Attila Lendvai writes: al> i've pushed a small cleanup that uses *pg-client-encoding* only to al> initialize the connection's encoding slot and later on that is used al> everywhere. also gave a :encoding keyword param to the connection al> creation. this helps in situations where rebinding is not that easy al> (when used as a backend plugin in an rdbms abstraction layer). al> al> also added an encoding test with some latin2 chars. thanks, I've committed a slightly modified version of the :encoding keyword and of the test. -- Eric Marsden From eric.marsden at free.fr Sun Nov 19 18:54:22 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 19 Nov 2006 19:54:22 +0100 Subject: [pg-devel] Move pg repos to darcs? In-Reply-To: <45564C6D.4000703@travislists.com> (Travis Cross's message of "Sat, 11 Nov 2006 17:19:25 -0500") References: <45564C6D.4000703@travislists.com> Message-ID: <87odr3e081.fsf@free.fr> >>>>> "tc" == Travis Cross writes: tc> http://darcs.tcross.org/pg/ tc> tc> Eric - you are more than welcome to use this as a base for moving tc> the pg project on cl.net to darcs from CVS. I believe this would tc> enable and encourage more contributions to the project, as it would tc> become easier to track the latest version and integrate one's own tc> changes. I'm surprised that with such a small code base the use of CVS is really an obstacle to contributors. Unless multiple contributors ask for this, my current inclination is to be conservative and not move the repository. -- Eric Marsden From attila.lendvai at gmail.com Mon Nov 20 15:07:44 2006 From: attila.lendvai at gmail.com (Attila Lendvai) Date: Mon, 20 Nov 2006 16:07:44 +0100 Subject: [pg-devel] Move pg repos to darcs? In-Reply-To: <87odr3e081.fsf@free.fr> References: <45564C6D.4000703@travislists.com> <87odr3e081.fsf@free.fr> Message-ID: > tc> http://darcs.tcross.org/pg/ > tc> > tc> Eric - you are more than welcome to use this as a base for moving > tc> the pg project on cl.net to darcs from CVS. I believe this would > tc> enable and encourage more contributions to the project, as it would > tc> become easier to track the latest version and integrate one's own > tc> changes. > > I'm surprised that with such a small code base the use of CVS is > really an obstacle to contributors. Unless multiple contributors ask well, it's not an obstacle, it's the other way around: it's much more convenient to use darcs then cvs. > for this, my current inclination is to be conservative and not > move the repository. there are only two of us for now and while darcs is much more convenient i don't think that using cvs is a showstopper. but there's some problem/wierdness with the pg cvs repo, though. (which is not really a problem as long as it only surfaces while you try to convert the repo with tailor) anyway, i just wanted to let you know that there's a +1 here, and thanks for committing the :encoding changes, -- - attila "- The truth is that I've been too considerate, and so became unintentionally cruel... - I understand. - No, you don't understand! We don't speak the same language!" (Ingmar Bergman - Smultronst?llet) From pgsql at rojoma.com Mon Nov 20 19:35:01 2006 From: pgsql at rojoma.com (Robert J. Macomber) Date: Mon, 20 Nov 2006 12:35:01 -0700 Subject: [pg-devel] pg-disconnect and abnormal exits Message-ID: <20061120193500.GA22491@oja.no> 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). The patch: ---------------------------------------------- diff -ur pg.orig/pg.lisp pg.new/pg.lisp --- pg.orig/pg.lisp 2006-11-20 08:09:35.000000000 -0700 +++ pg.new/pg.lisp 2006-11-20 09:59:53.000000000 -0700 @@ -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")) diff -ur pg.orig/utility.lisp pg.new/utility.lisp --- pg.orig/utility.lisp 2006-10-30 18:33:33.000000000 -0700 +++ pg.new/utility.lisp 2006-11-20 09:59:44.000000000 -0700 @@ -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 , at open-args))) - (unwind-protect - (progn , at body) - (when ,con (pg-disconnect ,con))))) + (let ((ok (gensym))) + `(let ((,con (pg-connect , at open-args)) + (,ok nil)) + (unwind-protect + (multiple-value-prog1 + (progn , at body) + (setf ,ok t)) + (when ,con (pg-disconnect ,con :abort (not ,ok))))))) ;; this is the old version #+(or) diff -ur pg.orig/v2-protocol.lisp pg.new/v2-protocol.lisp --- pg.orig/v2-protocol.lisp 2006-11-20 08:09:35.000000000 -0700 +++ pg.new/v2-protocol.lisp 2006-11-20 10:00:30.000000000 -0700 @@ -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)) diff -ur pg.orig/v3-protocol.lisp pg.new/v3-protocol.lisp --- pg.orig/v3-protocol.lisp 2006-11-20 08:09:35.000000000 -0700 +++ pg.new/v3-protocol.lisp 2006-11-20 10:01:02.000000000 -0700 @@ -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)) ---------------------------------------------- -- Robert Macomber pgsql at rojoma.com From eric.marsden at free.fr Mon Nov 20 20:51:54 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Mon, 20 Nov 2006 21:51:54 +0100 Subject: [pg-devel] pg-disconnect and abnormal exits In-Reply-To: <20061120193500.GA22491@oja.no> (Robert J. Macomber's message of "Mon, 20 Nov 2006 12:35:01 -0700") References: <20061120193500.GA22491@oja.no> Message-ID: <87k61p6dud.fsf@free.fr> >>>>> "rjm" == Robert J Macomber writes: rjm> error from the unwind-protect in with-pg-connection. To guard against rjm> the possibility, I've added an :abort parameter to pg-disconnect, like rjm> cl:close has, and made with-pg-connection call it with :abort t if the rjm> body exits abnormally, in the same way that with-open-file operates. rjm> When :abort is true, the modified pg-disconnect closes the database rjm> connection ungracefully, including making the close call abort rjm> (otherwise, sbcl at keast tries to flush the stream, raising another rjm> error if the database isn't there anymore). thanks, committed. -- Eric Marsden From svg at surnet.ru Thu Nov 23 14:00:40 2006 From: svg at surnet.ru (Vladimir Sekissov) Date: Thu, 23 Nov 2006 19:00:40 +0500 (YEKT) Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <20061123.162754.15675140.svg@surnet.ru> References: <20061123.162754.15675140.svg@surnet.ru> Message-ID: <20061123.190040.128593640.svg@surnet.ru> Good day, The patch in the attachment contains some changes to Pg you could find useful: - "hand-made" float parser; - support most PostgreSQL client encodings on unicode platforms; - allow any PostgreSQL unibyte client encoding on 8-bit platforms; - use CFFI interface to "crypt"; - preliminary CLSQL support. All CLSQL tests are passed except one because driver currently supports only two types of result type conversions - nil and :auto. Patch was tested on CMUCL-19c and SBCL-0.9.18 (unicode and 8-bit). Best Regards, Vladimir Sekissov -------------- next part -------------- diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/clsql/clsql-postgresql-pg.asd pg/clsql/clsql-postgresql-pg.asd --- pg.orig/clsql/clsql-postgresql-pg.asd 1970-01-01 05:00:00.000000000 +0500 +++ pg/clsql/clsql-postgresql-pg.asd 2006-11-23 15:54:57.000000000 +0500 @@ -0,0 +1,22 @@ +;;;; clsql-postgresql-pg.lisp -- Pg support for CLSQL +;;;; Authors: Vladimir Sekissov +;;;; $Id$ +;;;; + +(defpackage #:clsql-postgresql-pg-system (:use #:asdf #:cl)) +(in-package #:clsql-postgresql-pg-system) + +;;; System definition + +(defsystem clsql-postgresql-pg + :name "cl-sql-postgresql-pg" + :author "Vladimir Sekissov " + :licence "Lessor Lisp General Public License" + :description "Common Lisp SQL PostgreSQL Socket Driver" + :depends-on (:clsql :pg) + :components + ((:file "postgresql-pg-package") + (:file "postgresql-pg-api") + (:file "postgresql-pg-sql") + (:file "postgresql-pg-objects")) + :serial t) diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/clsql/postgresql-pg-api.lisp pg/clsql/postgresql-pg-api.lisp --- pg.orig/clsql/postgresql-pg-api.lisp 1970-01-01 05:00:00.000000000 +0500 +++ pg/clsql/postgresql-pg-api.lisp 2006-11-23 15:18:07.000000000 +0500 @@ -0,0 +1,32 @@ +;;;; postgresql-pg-api.lisp -- Pg support for CLSQL +;;;; Authors: Vladimir Sekissov +;;;; $Id$ +;;;; + +(in-package #:postgresql-pg) + +(defmethod clsql-sys:database-type-library-loaded ((database-type (eql :postgresql-pg))) + "T if foreign library was able to be loaded successfully. Always true for +socket interface" + t) + +(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-pg))) + t) + +(defconstant +postgresql-server-default-port+ 5432 + "Default port of PostgreSQL server.") + +;; TODO - add encoding argument +(defun open-postgresql-connection (&key (host (cmucl-compat:required-argument)) + (port +postgresql-server-default-port+) + (database (cmucl-compat:required-argument)) + (user (cmucl-compat:required-argument)) + password) + (pg:pg-connect database user + :host host + :port port + :password (or password ""))) + + +(defun close-postgresql-connection (connection) + (pg:pg-disconnect connection)) diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/clsql/postgresql-pg-objects.lisp pg/clsql/postgresql-pg-objects.lisp --- pg.orig/clsql/postgresql-pg-objects.lisp 1970-01-01 05:00:00.000000000 +0500 +++ pg/clsql/postgresql-pg-objects.lisp 2006-11-23 15:16:58.000000000 +0500 @@ -0,0 +1,24 @@ +;;;; postgresql-pg-objects.lisp -- Pg support for CLSQL +;;;; Authors: Vladimir Sekissov +;;;; $Id$ +;;;; + +(in-package #:clsql-sys) + +(defmethod read-sql-value (val (type (eql 'boolean)) (database clsql-postgresql-pg:postgresql-pg-database) db-type) + (declare (ignore db-type)) + (typecase val + (string (call-next-method)) + (t val))) + +(defmethod read-sql-value (val (type (eql 'generalized-boolean)) (database clsql-postgresql-pg:postgresql-pg-database) db-type) + (declare (ignore db-type)) + (typecase val + (string (call-next-method)) + (t val))) + +(defmethod read-sql-value (val (type (eql 'wall-time)) (database clsql-postgresql-pg:postgresql-pg-database) db-type) + (declare (ignore db-type)) + (typecase val + (integer (clsql:utime->time val)) + (t (call-next-method)))) \ ? ????? ????? ??? ????? ?????? diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/clsql/postgresql-pg-package.lisp pg/clsql/postgresql-pg-package.lisp --- pg.orig/clsql/postgresql-pg-package.lisp 1970-01-01 05:00:00.000000000 +0500 +++ pg/clsql/postgresql-pg-package.lisp 2006-11-23 15:17:29.000000000 +0500 @@ -0,0 +1,13 @@ +;;;; postgresql-pg-package.lisp -- Pg support for CLSQL +;;;; Authors: Vladimir Sekissov +;;;; $Id$ +;;;; + +(in-package #:cl-user) + +(defpackage #:postgresql-pg + (:use #:cl #:pg) + (:export #:+postgresql-server-default-port+ + #:open-postgresql-connection + #:close-postgresql-connection)) + diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/clsql/postgresql-pg-sql.lisp pg/clsql/postgresql-pg-sql.lisp --- pg.orig/clsql/postgresql-pg-sql.lisp 1970-01-01 05:00:00.000000000 +0500 +++ pg/clsql/postgresql-pg-sql.lisp 2006-11-23 15:17:58.000000000 +0500 @@ -0,0 +1,192 @@ +;;;; postgresql-pg-sql.lisp -- Pg support for CLSQL +;;;; Authors: Vladimir Sekissov +;;;; $Id$ +;;;; + +(in-package #:cl-user) + +(defpackage :clsql-postgresql-pg + (:use #:common-lisp #:clsql-sys #:postgresql-pg) + (:export #:postgresql-pg-database) + (:documentation "This is the CLSQL socket interface to PostgreSQL.")) + +(in-package #:clsql-postgresql-pg) + +;; interface foreign library loading routines + +(clsql-sys:database-type-load-foreign :postgresql-pg) + +(defun convert-to-clsql-error (database expression condition) + (error 'sql-database-data-error + :database database + :expression expression + :error-id (type-of condition) + :message (format nil "~a" condition))) + +(defmacro with-postgresql-handlers + ((database &optional expression) + &body body) + (let ((database-var (gensym)) + (expression-var (gensym))) + `(let ((,database-var ,database) + (,expression-var ,expression)) + (handler-bind ((pg:postgresql-error + (lambda (c) + (convert-to-clsql-error + ,database-var ,expression-var c)))) + , at body)))) + +(defmethod database-initialize-database-type ((database-type + (eql :postgresql-pg))) + t) + +(defclass postgresql-pg-database (generic-postgresql-database) + ((connection :accessor database-connection + :initarg :connection + :type pg::pgcon))) + +(defmethod database-type ((database postgresql-pg-database)) + :postgresql-pg) + +(defmethod database-name-from-spec (connection-spec + (database-type (eql :postgresql-pg))) + (check-connection-spec connection-spec database-type + (host db user password &optional port options tty)) + (destructuring-bind (host db user password &optional port options tty) + connection-spec + (declare (ignore password options tty)) + (concatenate 'string + (etypecase host + (null + "localhost") + (pathname (namestring host)) + (string host)) + (when port + (concatenate 'string + ":" + (etypecase port + (integer (write-to-string port)) + (string port)))) + "/" db "/" user))) + +(defmethod database-connect (connection-spec + (database-type (eql :postgresql-pg))) + (check-connection-spec connection-spec database-type + (host db user password &optional port)) + (destructuring-bind (host db user password &optional + (port +postgresql-server-default-port+)) + connection-spec + (handler-case + (handler-bind ((warning + (lambda (c) + (warn 'sql-warning + :format-control "~A" + :format-arguments + (list (princ-to-string c)))))) + (open-postgresql-connection :host host :port port + :database db :user user + :password password)) + (pg:postgresql-error (c) + ;; Connect failed + (error 'sql-connection-error + :database-type database-type + :connection-spec connection-spec + :error-id (type-of c) + :message (format nil "~a" c))) + (:no-error (connection) + ;; Success, make instance + (make-instance 'postgresql-pg-database + :name (database-name-from-spec connection-spec + database-type) + :database-type :postgresql-pg + :connection-spec connection-spec + :connection connection))))) + +(defmethod database-disconnect ((database postgresql-pg-database)) + (close-postgresql-connection (database-connection database)) + t) + +(defmethod database-query (expression (database postgresql-pg-database) result-types field-names) + (let ((connection (database-connection database))) + (with-postgresql-handlers (database expression) + (let* ((pg:*pg-coerce-result-types* result-types) + (result (pg:pg-exec connection (string expression)))) + (values (pg:pg-result result :tuples) + (when field-names + (mapcar #'car (pg:pg-result result :attributes)))))))) + +(defmethod database-execute-command (expression (database postgresql-pg-database)) + (let ((connection (database-connection database))) + (with-postgresql-handlers (database expression) + (pg:pg-exec connection (string expression))))) + +(defstruct postgresql-pg-result-set + (tuples nil)) + +(defmethod database-query-result-set ((expression string) + (database postgresql-pg-database) + &key full-set result-types) + (declare (ignore full-set)) + (let ((connection (database-connection database))) + (with-postgresql-handlers (database expression) + (let* ((pg:*pg-coerce-result-types* result-types) + (result (pg:pg-exec connection (string expression)))) + (values (make-postgresql-pg-result-set :tuples (pg:pg-result result :tuples)) + (length (pg:pg-result result :attributes))))))) + +(defmethod database-dump-result-set (result-set + (database postgresql-pg-database)) + (declare (ignore result-set database)) + t) + +(defmethod database-store-next-row (result-set + (database postgresql-pg-database) + list) + (with-postgresql-handlers (database) + (when (postgresql-pg-result-set-tuples result-set) + (loop + with row = (pop (postgresql-pg-result-set-tuples result-set)) + for rest on list + do + (setf (car rest) (pop row))) + list))) + +(defmethod database-create (connection-spec (type (eql :postgresql-pg))) + (destructuring-bind (host name user password) connection-spec + (let ((database (database-connect (list host "template1" user password) + type))) + (unwind-protect + (execute-command (format nil "create database ~A" name)) + (database-disconnect database))))) + +(defmethod database-destroy (connection-spec (type (eql :postgresql-pg))) + (destructuring-bind (host name user password) connection-spec + (let ((database (database-connect (list host "template1" user password) + type))) + (unwind-protect + (execute-command (format nil "drop database ~A" name)) + (database-disconnect database))))) + + +(defmethod database-probe (connection-spec (type (eql :postgresql-pg))) + (when (find (second connection-spec) (database-list connection-spec type) + :test #'string-equal) + t)) + + +;; Database capabilities + +(defmethod db-backend-has-create/destroy-db? ((db-type (eql :postgresql-pg))) + nil) + +(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql-pg))) + t) + +(defmethod db-type-default-case ((db-type (eql :postgresql-pg))) + :lower) + +(defmethod database-underlying-type ((database postgresql-pg-database)) + :postgresql) + +(when (clsql-sys:database-type-library-loaded :postgresql-pg) + (clsql-sys:initialize-database-type :database-type :postgresql-pg)) diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/defpackage.lisp pg/defpackage.lisp --- pg.orig/defpackage.lisp 2005-07-17 21:44:48.000000000 +0600 +++ pg/defpackage.lisp 2006-11-22 17:00:37.000000000 +0500 @@ -9,6 +9,7 @@ (:export #:pg-connect #:pg-exec #:pg-result #:pg-disconnect #:pgcon-sql-stream #:*pg-disable-type-coercion* + #:*pg-coerce-result-types* #:*pg-client-encoding* #:pg-databases #:pg-tables #:pg-columns #:pg-backend-version diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/parsers.lisp pg/parsers.lisp --- pg.orig/parsers.lisp 2006-10-23 01:29:47.000000000 +0600 +++ pg/parsers.lisp 2006-11-23 14:44:23.000000000 +0500 @@ -135,11 +135,58 @@ (setq decimal-part (/ (parse-integer decimal-str) (expt 10 dec-str-len)))))) (+ integer-part decimal-part))) -;; FIXME switch to a specialized float parser that conses less (defun float-parser (str) (declare (type simple-string str)) - (let ((*read-eval* nil)) - (read-from-string str))) + + (let ((idx 0) + (str-len (length str))) + (labels ((nxt-char () + (when (< idx str-len) + (prog1 (char str idx) + (incf idx)))) + (cur-char () + (when (< idx str-len) + (char str idx))) + (read-integer () + (multiple-value-bind (int int-idx) + (parse-integer str :start idx :junk-allowed t) + (multiple-value-prog1 (values int (- int-idx idx)) + (setf idx int-idx)))) + (read-sign () + (case (cur-char) + (#\- (nxt-char) + -1) + (#\+ (nxt-char) + 1) + (otherwise 1))) + (read-fractional-part () + (case (cur-char) + (#\. (nxt-char) + (multiple-value-bind (int count) + (read-integer) + (when int + (* int (expt 10 (- count)))))) + (otherwise nil))) + (read-exponent () + (case (cur-char) + ((#\e #\E) (nxt-char) + (read-integer)) + (otherwise 0)))) + (let ((sign (read-sign)) + (int-part (read-integer)) + (fractional-part (read-fractional-part)) + (exponent (read-exponent))) + + (unless (and (or int-part fractional-part) + (= idx str-len)) + (error "Unknown float format or not a float ~a" str)) + + (unless int-part + (setf int-part 0)) + (* (+ (coerce int-part 'double-float) + (or fractional-part 0)) + (expt 10 exponent) + sign))))) ;; here we are assuming that the value of *PG-CLIENT-ENCODING* is ;; compatible with the encoding that the CL implementation uses for diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/pg.asd pg/pg.asd --- pg.orig/pg.asd 2006-09-30 22:51:12.000000000 +0600 +++ pg/pg.asd 2006-11-22 11:46:25.000000000 +0500 @@ -8,12 +8,6 @@ (defclass pg-component (cl-source-file) ()) -;; For CMUCL, ensure that the crypt library is loaded before -;; attempting to load the code. -#+cmu -(defmethod perform :before ((o load-op) (c pg-component)) - (ext:load-foreign "/usr/lib/libcrypt.so")) - (defsystem :pg :name "Socket-level PostgreSQL interface" :author "Eric Marsden" @@ -23,7 +17,8 @@ #+cormanlisp :sockets #+sbcl :sb-bsd-sockets #+sbcl :sb-rotate-byte - #+(and mcl (not openmcl)) "OPENTRANSPORT") + #+(and mcl (not openmcl)) "OPENTRANSPORT" + :cffi) :components ((:file "md5") (:file "defpackage" :depends-on ("md5")) (:pg-component "sysdep" :depends-on ("defpackage" "md5")) diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/pg.lisp pg/pg.lisp --- pg.orig/pg.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/pg.lisp 2006-11-23 16:02:32.000000000 +0500 @@ -127,6 +127,8 @@ (defvar *pg-date-style* "ISO") +(defvar *pg-coerce-result-types* t + "Convert query results to types declared by backend database.") (defclass pgcon () ((stream :accessor pgcon-stream diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/sysdep.lisp pg/sysdep.lisp --- pg.orig/sysdep.lisp 2006-11-19 23:47:59.000000000 +0500 +++ pg/sysdep.lisp 2006-11-22 11:59:17.000000000 +0500 @@ -18,26 +18,16 @@ (error "No system dependent code to ~A" desc)) (car forms)) - -#+(and cmu glibc2) (eval-when (:compile-toplevel :load-toplevel) - (format t ";; Loading libcrypt~%") - ;; (ext:load-foreign "/lib/libcrypt.so.1") - (sys::load-object-file "/usr/lib/libcrypt.so")) - -#+(and cmu glibc2) -(defun crypt (key salt) - (declare (type string key salt)) - (alien:alien-funcall - (alien:extern-alien "crypt" - (function c-call:c-string c-call:c-string c-call:c-string)) - key salt)) - -#-(and cmu glibc2) -(defun crypt (key salt) - (declare (ignore salt)) - key) - + (cffi:define-foreign-library libcrypt + (:unix (:default "libcrypt")) + (t (:default "libcrypt"))) + + (cffi:use-foreign-library libcrypt)) + +(cffi:defcfun ("crypt" crypt) :string + (key :string) + (salt :string)) (defun md5-digest (string &rest strings) (declare (type simple-string string)) @@ -323,68 +313,184 @@ ;; (declare (ignore elements bytes)) ;; (fli:convert-from-foreign-string ptr :external-format to))) - -;;; character encoding support - -(defvar *pg-client-encoding*) +(defvar *pg-multibyte-encodings* + '("BIG5" + "EUC_CN" + "EUC_JP" + "EUC_KR" + "EUC_TW" + "GB18030" + "GBK" + "JOHAB" + "MULE_INTERNAL" + "SJIS" + "UHC" + "UTF8")) + +(defvar *pg-implementation-encodings* + (let ((tbl (make-hash-table :test #'equalp))) + (mapc + #'(lambda (kv) + (when (cdr kv) + (setf (gethash (car kv) tbl) (cadr kv)))) + '(("ISO_8859_5" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-5 + #+(and clisp unicode) charset:iso-8859-5) + ("ISO_8859_6" + #+(and sbcl sb-unicode) :iso-8859-6 + #+(and allegro ics) :iso8859-6 + #+(and clisp unicode) charset:iso-8859-6 + ) + ("ISO_8859_7" + #+(and sbcl sb-unicode) :iso-8859-7 + #+(and allegro ics) :iso8859-7 + #+(and clisp unicode) charset:iso-8859-7 + ) + ("ISO_8859_8" + #+(and sbcl sb-unicode) :iso-8859-8 + #+(and allegro ics) :iso8859-8 + #+(and clisp unicode) charset:iso-8859-8 + ) + ("KOI8" + #+(or (and sbcl sb-unicode) (and allegro ics)) :koi8-r + #+(and clisp unicode) charset:koi8-r + ) + ("LATIN1" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-1 + #+(and clisp unicode) charset:iso-8859-1) + ("LATIN2" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-2 + #+(and clisp unicode) charset:iso-8859-2) + ("LATIN3" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-3 + #+(and clisp unicode) charset:iso-8859-3) + ("LATIN4" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-4 + #+(and clisp unicode) charset:iso-8859-4) + ("LATIN5" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-5 + #+(and clisp unicode) charset:iso-8859-9) + ("LATIN6" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-6 + #+(and clisp unicode) charset:iso-8859-10) + ("LATIN7" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-7 + #+(and clisp unicode) charset:iso-8859-13) + ("LATIN8" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-8 + #+(and clisp unicode) charset:iso-8859-14) + ("LATIN9" + #+(or (and sbcl sb-unicode) (and allegro ics)) :latin-9 + #+(and clisp unicode) charset:iso-8859-15) + ("LATIN10" + #+(and clisp unicode) charset:iso-8859-16) + ("SQL_ASCII" + #+(or (and sbcl sb-unicode) (and allegro ics)) :ascii + #+(and clisp unicode) charset:ascii) + ("UTF8" + #+(or (and sbcl sb-unicode) (and allegro ics)) :utf-8 + #+(and clisp unicode) charset:utf-8) + ("EUC_JP" + #+(and sbcl sb-unicode) :eucjp + #+(and allegro ics) :euc + #+(and clisp unicode) charset:eucjp) + ("WIN866" + #+(and sbcl sb-unicode) :cp866 + #+(and clisp unicode) charset:cp866) + ("WIN874" + #+(and sbcl sb-unicode) :cp874 + #+(and allegro ics) :874 + #+(and clisp unicode) charset:cp874) + ("WIN1250" + #+(and sbcl sb-unicode) :windows-1250 + #+(and allegro ics) :1250 + #+(and clisp unicode) charset:windows-1250) + ("WIN1251" + #+(and sbcl sb-unicode) :windows-1251 + #+(and allegro ics) :1251 + #+(and clisp unicode) charset:windows-1251) + ("WIN1252" + #+(and sbcl sb-unicode) :windows-1252 + #+(and allegro ics) :1252 + #+(and clisp unicode) charset:windows-1252) + ("WIN1253" + #+(and sbcl sb-unicode) :windows-1253 + #+(and allegro ics) :1253 + #+(and clisp unicode) charset:windows-1253) + ("WIN1254" + #+(and sbcl sb-unicode) :windows-1254 + #+(and allegro ics) :1254 + #+(and clisp unicode) charset:windows-1254) + ("WIN1255" + #+(and sbcl sb-unicode) :windows-1255 + #+(and allegro ics) :1255 + #+(and clisp unicode) charset:windows-1255) + ("WIN1256" + #+(and sbcl sb-unicode) :windows-1256 + #+(and allegro ics) :1256 + #+(and clisp unicode) charset:windows-1256) + ("WIN1257" + #+(and sbcl sb-unicode) :windows-1257 + #+(and allegro ics) :1257 + #+(and clisp unicode) charset:windows-1257) + ("WIN1258" + #+(and sbcl sb-unicode) :windows-1258 + #+(and allegro ics) :1258 + #+(and clisp unicode) charset:windows-1258))) + tbl)) (defun implementation-name-for-encoding (encoding) (%sysdep "convert from client encoding to external format name" - #+(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))) - #+(and allegro ics) - (cond ((string-equal encoding "SQL_ASCII") :ascii) - ((string-equal encoding "LATIN1") :latin1) - ((string-equal encoding "LATIN9") :latin9) - ((string-equal encoding "UTF8") :utf8) - (t (error "unknown encoding ~A" encoding))) - #+(and sbcl sb-unicode) - (cond ((string-equal encoding "SQL_ASCII") :ascii) - ((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)) + #+(or (and sbcl (not sb-unicode)) (and clisp (not unicode)) (and allegro (not ics)) cmu gcl ecl abcl openmcl lispworks) + (if (not (member encoding *pg-multibyte-encodings* :test #'equalp)) + nil + (error "Unsupported multibyte encoding in unibyte environment ~a" + encoding)) + #+(or (and sbcl sb-unicode) (and clisp unicode) (and allegro ics)) + (let ((impl-enc (gethash encoding *pg-implementation-encodings*))) + (if impl-enc + impl-enc + (error "Unknown or unsupported encoding ~a" encoding))) + )) (defun convert-string-to-bytes (string encoding) (declare (type string string)) - (%sysdep "convert string to octet-array" - #+(and clisp unicode) - (ext:convert-string-to-bytes string (implementation-name-for-encoding encoding)) - #+(and allegro ics) - (excl:string-to-octets string :null-terminate nil - :external-format (implementation-name-for-encoding encoding)) - #+(and :sbcl :sb-unicode) - (sb-ext:string-to-octets string - :external-format (implementation-name-for-encoding encoding)) - #+(or cmu gcl ecl abcl openmcl lispworks) - (if (member encoding '("SQL_ASCII" "LATIN1" "LATIN9") :test #'string-equal) - (let ((octets (make-array (length string) :element-type '(unsigned-byte 8)))) - (map-into octets #'char-code string)) - (error "Can't convert ~A string to octets" encoding)))) + + (let ((imp-enc (implementation-name-for-encoding encoding))) + (declare (ignorable imp-enc)) + (%sysdep "convert string to octet-array" + #+(and clisp unicode) + (ext:convert-string-to-bytes string imp-enc) + #+(and allegro ics) + (excl:string-to-octets string :null-terminate nil :external-format imp-enc) + #+(and sbcl sb-unicode) + (sb-ext:string-to-octets string :external-format imp-enc) + #+(and sbcl (not sb-unicode)) + (sb-ext:string-to-octets string) + #+(or (and clisp (not unicode)) (and allegro (not ics)) cmu gcl ecl abcl openmcl lispworks) + (let ((octets (make-array (length string) :element-type '(unsigned-byte 8)))) + (map-into octets #'char-code string))))) (defun convert-string-from-bytes (bytes encoding) (declare (type (vector (unsigned-byte 8)) bytes)) - (%sysdep "convert octet-array to string" - #+(and clisp unicode) - (ext:convert-string-from-bytes bytes (implementation-name-for-encoding encoding)) - #+(and allegro ics) - (excl:octets-to-string bytes :external-format (implementation-name-for-encoding encoding)) - #+(and :sbcl :sb-unicode) - (sb-ext:octets-to-string bytes :external-format (implementation-name-for-encoding encoding)) - ;; for implementations that have no support for character - ;; encoding, we assume that the encoding is an octet-for-octet - ;; encoding, and convert directly - #+(or cmu (and sbcl (not :sb-unicode)) gcl ecl abcl openmcl lispworks) - (let ((string (make-string (length bytes)))) - (map-into string #'code-char bytes)))) + + (let ((imp-enc (implementation-name-for-encoding encoding))) + (declare (ignorable imp-enc)) + (%sysdep "convert octet-array to string" + #+(and clisp unicode) + (ext:convert-string-from-bytes bytes imp-enc) + #+(and allegro ics) + (excl:octets-to-string bytes :external-format imp-enc) + #+(and :sbcl :sb-unicode) + (sb-ext:octets-to-string bytes :external-format imp-enc) + #+(and sbcl (not sb-unicode)) + (sb-ext:octets-to-string bytes) + ;; for implementations that have no support for character + ;; encoding, we assume that the encoding is an octet-for-octet + ;; encoding, and convert directly + #+(or cmu gcl ecl abcl openmcl lispworks) + (let ((string (make-string (length bytes)))) + (map-into string #'code-char bytes))))) ;; EOF diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/v2-protocol.lisp pg/v2-protocol.lisp --- pg.orig/v2-protocol.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/v2-protocol.lisp 2006-11-23 16:02:35.000000000 +0500 @@ -294,7 +294,9 @@ (t (let* ((len (+ (read-net-int connection 4) correction)) (raw (%read-chars (pgcon-stream connection) (max 0 len))) - (parsed (parse raw (car type-ids)))) + (parsed (if *pg-coerce-result-types* + (parse raw (car type-ids)) + raw))) (push parsed tuples))))))) ;; FIXME could signal a postgresql-notification condition diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/v3-protocol.lisp pg/v3-protocol.lisp --- pg.orig/v3-protocol.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/v3-protocol.lisp 2006-11-23 16:02:36.000000000 +0500 @@ -685,7 +685,10 @@ (raw (unless (= length -1) (read-string-from-packet packet length)))) (if raw - (push (parse raw (car type-ids)) tuples) + (push (if *pg-coerce-result-types* + (parse raw (car type-ids)) + raw) + tuples) (push nil tuples)))))) ;; Execute one of the large-object functions (lo_open, lo_close etc). From eric.marsden at free.fr Thu Nov 23 20:22:20 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Thu, 23 Nov 2006 21:22:20 +0100 Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <20061123.190040.128593640.svg@surnet.ru> (Vladimir Sekissov's message of "Thu, 23 Nov 2006 19:00:40 +0500 (YEKT)") References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> Message-ID: <87ejrtj4lf.fsf@free.fr> >>>>> "vs" == Vladimir Sekissov writes: vs> The patch in the attachment contains some changes to Pg you could find vs> useful: vs> vs> - "hand-made" float parser; thanks, this looks good. vs> - support most PostgreSQL client encodings on unicode platforms; vs> vs> - allow any PostgreSQL unibyte client encoding on 8-bit platforms; this also looks good. It would be nice to have this functionality in a library, since other applications probably have similar needs. vs> - use CFFI interface to "crypt"; I might put this into a separate system, so that CFFI isn't a pg-dot-lisp dependency. vs> - preliminary CLSQL support. All CLSQL tests are passed vs> except one because driver currently supports only two types of result vs> type conversions - nil and :auto. I'm not very familiar with CLSQL. Can you tell me what advantages your code has over the pg-socket backend that is already implemented in CLSQL? Your variable *PG-COERCE-RESULT-TYPES* seems to be redundant given the existing variable *PG-DISABLE-TYPE-COERCION*. -- Eric Marsden From eric.marsden at free.fr Thu Nov 23 22:34:10 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Thu, 23 Nov 2006 23:34:10 +0100 Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <20061123.190040.128593640.svg@surnet.ru> (Vladimir Sekissov's message of "Thu, 23 Nov 2006 19:00:40 +0500 (YEKT)") References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> Message-ID: <878xi1iyhp.fsf@free.fr> >>>>> "vs" == Vladimir Sekissov writes: vs> The patch in the attachment contains some changes to Pg you could find vs> useful: vs> vs> - "hand-made" float parser; looking at this in more detail, I'm afraid that your float parser does not respect read/print consistency. For example, CL-USER> (float-parser ".1347626e3") 134.76260000000002d0 The current float parser (using READ-FROM-STRING) does respect this. -- Eric Marsden From svg at surnet.ru Fri Nov 24 07:10:32 2006 From: svg at surnet.ru (Vladimir Sekissov) Date: Fri, 24 Nov 2006 12:10:32 +0500 (YEKT) Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <87ejrtj4lf.fsf@free.fr> References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <87ejrtj4lf.fsf@free.fr> Message-ID: <20061124.121032.04704875.svg@surnet.ru> Good day, eric.marsden> vs> - preliminary CLSQL support. All CLSQL tests are passed eric.marsden> vs> except one because driver currently supports only two types of result eric.marsden> vs> type conversions - nil and :auto. eric.marsden> eric.marsden> I'm not very familiar with CLSQL. Can you tell me what advantages eric.marsden> your code has over the pg-socket backend that is already implemented eric.marsden> in CLSQL? CLSQL pg-socket driver doesn't implement v3 protocol, encodings and supports result type conversion for numbers only. I thought it would be better to support CLSQL in Pg than merge its code into pg-socket. eric.marsden> Your variable *PG-COERCE-RESULT-TYPES* seems to be redundant given eric.marsden> the existing variable *PG-DISABLE-TYPE-COERCION*. *PG-DISABLE-TYPE-COERCION* disable/enable type coercion at connection time for all following queries, *PG-COERCE-RESULT-TYPES* allow to disable it for some of them only (when *PG-DISABLE-TYPE-COERCION* is NIL of cause). Best Regards, Vladimir Sekissov From svg at surnet.ru Fri Nov 24 08:20:03 2006 From: svg at surnet.ru (Vladimir Sekissov) Date: Fri, 24 Nov 2006 13:20:03 +0500 (YEKT) Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <878xi1iyhp.fsf@free.fr> References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <878xi1iyhp.fsf@free.fr> Message-ID: <20061124.132003.178763817.svg@surnet.ru> Good day, eric.marsden> CL-USER> (float-parser ".1347626e3") eric.marsden> 134.76260000000002d0 eric.marsden> eric.marsden> The current float parser (using READ-FROM-STRING) does eric.marsden> respect this. Here is READ-FROM-STRING compatible version: CL-USER> (pg::float-parser ".1347626e3") 134.7626 CL-USER> (read-from-string ".1347626e3") 134.7626 10 CL-USER> (let ((*read-default-float-format* 'double-float)) (pg::float-parser ".1347626e3")) 134.76260000000002d0 CL-USER> (let ((*read-default-float-format* 'double-float)) (read-from-string ".1347626e3")) 134.7626d0 10 (defun float-parser (str) (declare (type simple-string str)) (let ((idx 0) (str-len (length str))) (labels ((nxt-char () (when (< idx str-len) (prog1 (char str idx) (incf idx)))) (cur-char () (when (< idx str-len) (char str idx))) (read-integer () (multiple-value-bind (int int-idx) (parse-integer str :start idx :junk-allowed t) (multiple-value-prog1 (values int (- int-idx idx)) (setf idx int-idx)))) (read-sign () (case (cur-char) (#\- (nxt-char) -1) (#\+ (nxt-char) 1) (otherwise 1))) (read-fractional-part () (case (cur-char) (#\. (nxt-char) (multiple-value-bind (int count) (read-integer) (when int (* int (expt 10 (- count)))))) (otherwise nil))) (read-exponent () (case (cur-char) ((#\e #\E) (nxt-char) (read-integer)) (otherwise 0)))) (let ((sign (read-sign)) (int-part (read-integer)) (fractional-part (read-fractional-part)) (exponent (read-exponent))) (unless (and (or int-part fractional-part) (= idx str-len)) (error "Unknown float format or not a float ~a" str)) (unless int-part (setf int-part 0)) (* (+ (coerce int-part *read-default-float-format*) (or fractional-part 0)) (expt 10 exponent) sign))))) Best Regards, Vladimir Sekissov From svg at surnet.ru Fri Nov 24 10:31:53 2006 From: svg at surnet.ru (Vladimir Sekissov) Date: Fri, 24 Nov 2006 15:31:53 +0500 (YEKT) Subject: [pg-devel] [PATCH] pg-disconnect and abnormal exits In-Reply-To: <87ejrtj4lf.fsf@free.fr> References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <87ejrtj4lf.fsf@free.fr> Message-ID: <20061124.153153.160242227.svg@surnet.ru> Good day, Current implementation of WITH-PG-CONNECTION forces abnormal connection aborting on any programming error. What about to move stream handling to PG-DISCONNECT? Here is a possible patch. In this version PG-DISCONNECT is trying to close connection according to protocol and only in case of failure or ABORT = T forces stream closing. Best Regards, Vladimir Sekissov diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/utility.lisp pg/utility.lisp --- pg.orig/utility.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/utility.lisp 2006-11-24 15:16:00.000000000 +0500 @@ -36,14 +36,10 @@ 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 ((ok (gensym))) - `(let ((,con (pg-connect , at open-args)) - (,ok nil)) - (unwind-protect - (multiple-value-prog1 - (progn , at body) - (setf ,ok t)) - (when ,con (pg-disconnect ,con :abort (not ,ok))))))) + `(let ((,con (pg-connect , at open-args))) + (unwind-protect + (progn , at body) + (when ,con (pg-disconnect ,con :abort nil))))) ;; this is the old version #+(or) @@ -101,4 +97,28 @@ :do (funcall callback (first res))) (pg-exec conn "CLOSE " cursor)))))) +(defun close-stream (stream &key force) + "Close STREAM, if failed and FORCE is T try to close harder. +Returns T,NIL on success and NIL,ERROR on failer." + (let (err) + (mapc + #'(lambda (attempt) + (multiple-value-bind (r e) (ignore-errors (funcall attempt) t) + (if r + (return-from close-stream (values t nil)) + (setf err e)))) + (cons + #'(lambda () (close stream)) + (when force + (list + #'(lambda () (close stream :abort t)) + #+cmu + #'(lambda () + (unix:unix-close (sys:fd-stream-fd stream))) + #+sbcl + #'(lambda () + (sb-unix:unix-close (sb-sys:fd-stream-fd stream))) + )))) + (values nil err))) + ;; EOF diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/v2-protocol.lisp pg/v2-protocol.lisp --- pg.orig/v2-protocol.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/v2-protocol.lisp 2006-11-24 15:07:48.000000000 +0500 @@ -238,14 +238,12 @@ (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)) + (close-stream (pgcon-stream connection) + :force (or abort + (not (ignore-errors + (write-byte 88 (pgcon-stream connection)) + (%flush connection) + t))))) ;; Attribute information is as follows diff -Naur --exclude=CVS --exclude='*.fasl' --exclude='*~' pg.orig/v3-protocol.lisp pg/v3-protocol.lisp --- pg.orig/v3-protocol.lisp 2006-11-21 01:50:36.000000000 +0500 +++ pg/v3-protocol.lisp 2006-11-24 15:08:48.000000000 +0500 @@ -642,14 +642,13 @@ (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)) + + (close-stream (pgcon-stream connection) + :force (or abort + (not (ignore-errors + (send-packet connection #\X nil) + (%flush connection) + t))))) ;; Attribute information is as follows From pgsql at rojoma.com Sun Nov 26 13:00:38 2006 From: pgsql at rojoma.com (Robert J. Macomber) Date: Sun, 26 Nov 2006 06:00:38 -0700 Subject: [pg-devel] Prepared statements problem Message-ID: <20061126130038.GA13320@oja.no> I've got a problem involving prepared statements and multiple queries per connection. It seems pg gets out of sync with the database when using them. Sometimes this leads to protocol errors, sometimes to strange results being returned from queries. Here's a test case that shows what I mean: --------------------------------------- (defpackage #:prepared-test (:use #:cl #:pg)) (in-package #:prepared-test) ;; assumes there's a table "test" created with: ;; create table test (id serial, blah varchar not null) (defun test (dbname user) (with-pg-connection (db dbname user :host "/var/run/postgresql/") (list (pg-prepare db "si" "insert into test (blah) values ($1)" '(:|varchar|)) (pg-prepare db "ss" "select currval('test_id_seq')") (pg-bind db "pi" "si" '((:string "test"))) (pg-execute db "pi") (pg-bind db "ps" "ss" '()) (pg-execute db "ps") (pg-close-statement db "ss") (pg-close-statement db "si") (pg-exec db "select id,blah from test") (pg-exec db "select blah,id from test")))) --------------------------------------- When you run the test, after the statements are closed, the selects get "out of sync", the first returning nothing (the :status, :attributes, and :tuples of the result object are all NIL), and the second returning the results of the first. If the portals are explicitly closed as well, it gets two "steps" out of sync. I'm using the latest CVS pg and postgresql 8.1.5. Investigating, but everything I know about postgresql's protocol I've learned while trying to debug this, so I don't know what's causing it exactly yet. -- Robert Macomber pgsql at rojoma.com From pgsql at rojoma.com Sun Nov 26 13:20:08 2006 From: pgsql at rojoma.com (Robert J. Macomber) Date: Sun, 26 Nov 2006 06:20:08 -0700 Subject: [pg-devel] Prepared statements problem In-Reply-To: <20061126130038.GA13320@oja.no> References: <20061126130038.GA13320@oja.no> Message-ID: <20061126132008.GB13320@oja.no> On Sun, Nov 26, 2006 at 06:00:38AM -0700, Robert J. Macomber wrote: > Investigating, but everything I know about postgresql's protocol > I've learned while trying to debug this, so I don't know what's > causing it exactly yet. Of course, seconds after I send, I find that the database server sends _both_ a CloseComplete and ReadyForQuery packet on the statement/portal close -- the pg-close function in v3-protocol.lisp expects _either_. Would a correct patch be one which follows the model in do-followup-query? -- Robert Macomber pgsql at rojoma.com From eric.marsden at free.fr Sun Nov 26 18:07:08 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 26 Nov 2006 19:07:08 +0100 Subject: [pg-devel] Prepared statements problem In-Reply-To: <20061126132008.GB13320@oja.no> (Robert J. Macomber's message of "Sun, 26 Nov 2006 06:20:08 -0700") References: <20061126130038.GA13320@oja.no> <20061126132008.GB13320@oja.no> Message-ID: <878xhy3wvn.fsf@free.fr> >>>>> "rjm" == Robert J Macomber writes: rjm> Of course, seconds after I send, I find that the database rjm> server sends _both_ a CloseComplete and ReadyForQuery packet on rjm> the statement/portal close -- the pg-close function in rjm> v3-protocol.lisp expects _either_. Would a correct patch be one rjm> which follows the model in do-followup-query? indeed, I've just committed a fix that does this. Thanks for pointing out the bug. -- Eric Marsden From eric.marsden at free.fr Sun Nov 26 18:20:31 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 26 Nov 2006 19:20:31 +0100 Subject: [pg-devel] [PATCH] pg-disconnect and abnormal exits In-Reply-To: <20061124.153153.160242227.svg@surnet.ru> (Vladimir Sekissov's message of "Fri, 24 Nov 2006 15:31:53 +0500 (YEKT)") References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <87ejrtj4lf.fsf@free.fr> <20061124.153153.160242227.svg@surnet.ru> Message-ID: <874psm3w9c.fsf@free.fr> >>>>> "vs" == Vladimir Sekissov writes: vs> Current implementation of WITH-PG-CONNECTION forces abnormal vs> connection aborting on any programming error. What about to move vs> stream handling to PG-DISCONNECT? Here is a possible patch. vs> vs> In this version PG-DISCONNECT is trying to close connection according vs> to protocol and only in case of failure or ABORT = T forces stream closing. this looks like a good idea to me. I'm not certain that your code that calls UNIX-CLOSE for CMUCL and SBCL is really useful ; don't these implementations already do this for the :abort t case? -- Eric Marsden From eric.marsden at free.fr Sun Nov 26 18:23:30 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 26 Nov 2006 19:23:30 +0100 Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <20061124.132003.178763817.svg@surnet.ru> (Vladimir Sekissov's message of "Fri, 24 Nov 2006 13:20:03 +0500 (YEKT)") References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <878xi1iyhp.fsf@free.fr> <20061124.132003.178763817.svg@surnet.ru> Message-ID: <87zmae2hjx.fsf@free.fr> >>>>> "vs" == Vladimir Sekissov writes: CL-USER> (let ((*read-default-float-format* 'double-float)) vs> (pg::float-parser ".1347626e3")) vs> 134.76260000000002d0 this is still not respecting read/print consistency! -- Eric Marsden From eric.marsden at free.fr Sun Nov 26 18:27:27 2006 From: eric.marsden at free.fr (Eric Marsden) Date: Sun, 26 Nov 2006 19:27:27 +0100 Subject: [pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc In-Reply-To: <20061124.121032.04704875.svg@surnet.ru> (Vladimir Sekissov's message of "Fri, 24 Nov 2006 12:10:32 +0500 (YEKT)") References: <20061123.162754.15675140.svg@surnet.ru> <20061123.190040.128593640.svg@surnet.ru> <87ejrtj4lf.fsf@free.fr> <20061124.121032.04704875.svg@surnet.ru> Message-ID: <87vel22hdc.fsf@free.fr> >>>>> "vs" == Vladimir Sekissov writes: vs> CLSQL pg-socket driver doesn't implement v3 protocol, encodings and supports vs> result type conversion for numbers only. vs> vs> I thought it would be better to support CLSQL in Pg than merge its vs> code into pg-socket. ok, I will ask the CLSQL maintainers what they think about this. vs> *PG-DISABLE-TYPE-COERCION* disable/enable type coercion at vs> connection time for all following queries, *PG-COERCE-RESULT-TYPES* vs> allow to disable it for some of them only (when vs> *PG-DISABLE-TYPE-COERCION* is NIL of cause). that's true. I would prefer to retain a single variable, which could be bound at connection time to avoid the expensive query to populate the parser table, or at runtime for a specific query to disable parsing for its results. Thanks, -- Eric Marsden From svg at surnet.ru Mon Nov 27 06:37:21 2006 From: svg at surnet.ru (Vladimir Sekissov) Date: Mon, 27 Nov 2006 11:37:21 +0500 (YEKT) Subject: [pg-devel] [PATCH] pg-disconnect and abnormal exits In-Reply-To: <874psm3w9c.fsf@free.fr> References: <87ejrtj4lf.fsf@free.fr> <20061124.153153.160242227.svg@surnet.ru> <874psm3w9c.fsf@free.fr> Message-ID: <20061127.113721.193697199.svg@surnet.ru> Good day, eric.marsden> this looks like a good idea to me. I'm not certain that your code eric.marsden> that calls UNIX-CLOSE for CMUCL and SBCL is really useful ; don't eric.marsden> these implementations already do this for the :abort t case? I'd found this when worked with portable Aserve on Fedora Linux with SBCL and CMUCL. Sometimes :abort = t was not enough and long lived process left hundreds of unclosed file descriptors. Probably authors of TRIVIAL-SOCKETS found this behaviour before me. This code is based on appropriate part of TRIVIAL-SOCKETS. Best Regards, Vladimir Sekissov