[pg-devel] pg-disconnect and abnormal exits

[Robert J. Macomber]

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