bug in libpgtcl listen

Hi,

I found a bug in the notify handler of the libpgtcl interface.
If I have setup a notify handler and the backend dies, the tcl interpreter
will not remove the handler and loop forever with a bad fd in select().
I tested the bug with Tcl7.5 and the following code:

$ wish
% set tcl_version
7.5
% set tk_version
4.1
% source pg_test.tcl
% connect dz
pgsql4
% sql select 123
123
% listen
% notify
% --> callback test

# From another shell kill the backend:
$ kill 3937

# Now the wish shell is looping forever in the following syscall:
$ strace -p 3934
select(5, [0 3 4], [], [], NULL) = -1 EBADF (Bad file number)
select(5, [0 3 4], [], [], NULL) = -1 EBADF (Bad file number)
select(5, [0 3 4], [], [], NULL) = -1 EBADF (Bad file number)
select(5, [0 3 4], [], [], NULL) = -1 EBADF (Bad file number)
select(5, [0 3 4], [], [], NULL) = -1 EBADF (Bad file number)
...

# The fd 4 doesn't exists anymore because it has been closed by pqReadData.
$ ls -l /proc/3934/fd
total 0
lrwx------ 1 dz users 64 Jan 8 16:00 0 -> [0801]:2081
lrwx------ 1 dz users 64 Jan 8 16:00 1 -> [0801]:2081
lrwx------ 1 dz users 64 Jan 8 16:00 2 -> [0801]:2081
lrwx------ 1 dz users 64 Jan 8 16:00 3 -> [0000]:12617

This is the test file loaded in the above example:

# pg_test.tcl --
#
# Test libpgtcl interface

load libpgtcl.so.2

proc connect {{db dz}} {
global conn
set conn [pg_connect $db]
}

proc sql {args} {
global conn
if {$args != {}} {
set cmd $args
} else {
set cmd "select 1"
}
set res [pg_exec $conn $cmd]
switch [pg_result $res -status] {
PGRES_TUPLES_OK {
for {set n 0} {$n < [pg_result $res -numTuples]} {incr n} {
puts [pg_result $res -getTuple $n]
}
}
PGRES_COMMAND_OK {
}
default {
puts [pg_result $res -status]
}
}
pg_result $res -clear
}

proc disconnect {} {
global conn
pg_disconnect $conn
set conn {}
}

proc listen {{relname test}} {
global conn
pg_listen $conn $relname "callback $relname"
}

proc unlisten {{relname test}} {
global conn
pg_listen $conn $relname {}
}

proc notify {{relname test}} {
global conn
sql notify $relname
}

proc callback {args} {
puts "--> callback $args"
}

# end of file

The following patch seems to fix the problem:

*** src/interfaces/libpgtcl/pgtclId.c.orig Mon Sep 21 03:02:03 1998
--- src/interfaces/libpgtcl/pgtclId.c Fri Jan 8 16:27:51 1999
***************
*** 638,649 ****
Pg_Notify_FileHandler (ClientData clientData, int mask)
{
Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;

/*
* Consume any data available from the SQL server (this just buffers
* it internally to libpq; but it will clear the read-ready condition).
*/
! PQconsumeInput(connid->conn);

/* Transfer notify events from libpq to Tcl event queue. */
PgNotifyTransferEvents(connid);
--- 638,656 ----
Pg_Notify_FileHandler (ClientData clientData, int mask)
{
Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
+ int status;

/*
* Consume any data available from the SQL server (this just buffers
* it internally to libpq; but it will clear the read-ready condition).
+ *
+ * Must check the connection status and stop the event source for
+ * closed connection. -- dz
*/
! status = PQconsumeInput(connid->conn);
! if (status == 0) {
! PgStopNotifyEventSource(connid);
! }

/* Transfer notify events from libpq to Tcl event queue. */
PgNotifyTransferEvents(connid);

--
Massimo Dal Zotto

+----------------------------------------------------------------------+
| Massimo Dal Zotto email: dz(at)cs(dot)unitn(dot)it |
| Via Marconi, 141 phone: ++39-0461534251 |
| 38057 Pergine Valsugana (TN) www: http://www.cs.unitn.it/~dz/ |
| Italy pgp: finger dz(at)tango(dot)cs(dot)unitn(dot)it |
+----------------------------------------------------------------------+