← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/libpgjava/gutsy

« back to all changes in this revision

Viewing changes to src/interfaces/libpgtcl/pgtclId.c

  • Committer: Bazaar Package Importer
  • Author(s): Arnaud Vandyck
  • Date: 2005-04-21 14:25:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20050421142511-wibh5vc31fkrorx7
Tags: 7.4.7-3
Built with sources...

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/interfaces/libpgtcl/pgtclId.c
 
1
/*-------------------------------------------------------------------------
 
2
 *
 
3
 * pgtclId.c
 
4
 *
 
5
 *      Contains Tcl "channel" interface routines, plus useful routines
 
6
 *      to convert between strings and pointers.  These are needed because
 
7
 *      everything in Tcl is a string, but in C, pointers to data structures
 
8
 *      are needed.
 
9
 *
 
10
 *      ASSUMPTION:  sizeof(long) >= sizeof(void*)
 
11
 *
 
12
 * Portions Copyright (c) 1996-2003, PostgreSQL Global Development Group
 
13
 * Portions Copyright (c) 1994, Regents of the University of California
 
14
 *
 
15
 * IDENTIFICATION
 
16
 *        $Header: /cvsroot/pgsql/src/interfaces/libpgtcl/Attic/pgtclId.c,v 1.43 2003/08/04 02:40:16 momjian Exp $
 
17
 *
 
18
 *-------------------------------------------------------------------------
 
19
 */
 
20
#include "postgres_fe.h"
 
21
 
 
22
#include <errno.h>
 
23
 
 
24
#include "pgtclCmds.h"
 
25
#include "pgtclId.h"
 
26
 
 
27
 
 
28
static int
 
29
PgEndCopy(Pg_ConnectionId * connid, int *errorCodePtr)
 
30
{
 
31
        connid->res_copyStatus = RES_COPY_NONE;
 
32
        if (PQendcopy(connid->conn))
 
33
        {
 
34
                PQclear(connid->results[connid->res_copy]);
 
35
                connid->results[connid->res_copy] =
 
36
                        PQmakeEmptyPGresult(connid->conn, PGRES_BAD_RESPONSE);
 
37
                connid->res_copy = -1;
 
38
                *errorCodePtr = EIO;
 
39
                return -1;
 
40
        }
 
41
        else
 
42
        {
 
43
                PQclear(connid->results[connid->res_copy]);
 
44
                connid->results[connid->res_copy] =
 
45
                        PQmakeEmptyPGresult(connid->conn, PGRES_COMMAND_OK);
 
46
                connid->res_copy = -1;
 
47
                return 0;
 
48
        }
 
49
}
 
50
 
 
51
/*
 
52
 *      Called when reading data (via gets) for a copy <rel> to stdout.
 
53
 */
 
54
int
 
55
PgInputProc(DRIVER_INPUT_PROTO)
 
56
{
 
57
        Pg_ConnectionId *connid;
 
58
        PGconn     *conn;
 
59
        int                     avail;
 
60
 
 
61
        connid = (Pg_ConnectionId *) cData;
 
62
        conn = connid->conn;
 
63
 
 
64
        if (connid->res_copy < 0 ||
 
65
         PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_OUT)
 
66
        {
 
67
                *errorCodePtr = EBUSY;
 
68
                return -1;
 
69
        }
 
70
 
 
71
        /*
 
72
         * Read any newly arrived data into libpq's buffer, thereby clearing
 
73
         * the socket's read-ready condition.
 
74
         */
 
75
        if (!PQconsumeInput(conn))
 
76
        {
 
77
                *errorCodePtr = EIO;
 
78
                return -1;
 
79
        }
 
80
 
 
81
        /* Move data from libpq's buffer to Tcl's. */
 
82
 
 
83
        avail = PQgetlineAsync(conn, buf, bufSize);
 
84
 
 
85
        if (avail < 0)
 
86
        {
 
87
                /* Endmarker detected, change state and return 0 */
 
88
                return PgEndCopy(connid, errorCodePtr);
 
89
        }
 
90
 
 
91
        return avail;
 
92
}
 
93
 
 
94
/*
 
95
 *      Called when writing data (via puts) for a copy <rel> from stdin
 
96
 */
 
97
int
 
98
PgOutputProc(DRIVER_OUTPUT_PROTO)
 
99
{
 
100
        Pg_ConnectionId *connid;
 
101
        PGconn     *conn;
 
102
 
 
103
        connid = (Pg_ConnectionId *) cData;
 
104
        conn = connid->conn;
 
105
 
 
106
        if (connid->res_copy < 0 ||
 
107
          PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_IN)
 
108
        {
 
109
                *errorCodePtr = EBUSY;
 
110
                return -1;
 
111
        }
 
112
 
 
113
        if (PQputnbytes(conn, buf, bufSize))
 
114
        {
 
115
                *errorCodePtr = EIO;
 
116
                return -1;
 
117
        }
 
118
 
 
119
        /*
 
120
         * This assumes Tcl script will write the terminator line in a single
 
121
         * operation; maybe not such a good assumption?
 
122
         */
 
123
        if (bufSize >= 3 && strncmp(&buf[bufSize - 3], "\\.\n", 3) == 0)
 
124
        {
 
125
                if (PgEndCopy(connid, errorCodePtr) == -1)
 
126
                        return -1;
 
127
        }
 
128
        return bufSize;
 
129
}
 
130
 
 
131
#if HAVE_TCL_GETFILEPROC
 
132
 
 
133
Tcl_File
 
134
PgGetFileProc(ClientData cData, int direction)
 
135
{
 
136
        return (Tcl_File) NULL;
 
137
}
 
138
#endif
 
139
 
 
140
/*
 
141
 * The WatchProc and GetHandleProc are no-ops but must be present.
 
142
 */
 
143
static void
 
144
PgWatchProc(ClientData instanceData, int mask)
 
145
{
 
146
}
 
147
 
 
148
static int
 
149
PgGetHandleProc(ClientData instanceData, int direction,
 
150
                                ClientData *handlePtr)
 
151
{
 
152
        return TCL_ERROR;
 
153
}
 
154
 
 
155
Tcl_ChannelType Pg_ConnType = {
 
156
        "pgsql",                                        /* channel type */
 
157
        NULL,                                           /* blockmodeproc */
 
158
        PgDelConnectionId,                      /* closeproc */
 
159
        PgInputProc,                            /* inputproc */
 
160
        PgOutputProc,                           /* outputproc */
 
161
        NULL,                                           /* SeekProc, Not used */
 
162
        NULL,                                           /* SetOptionProc, Not used */
 
163
        NULL,                                           /* GetOptionProc, Not used */
 
164
        PgWatchProc,                            /* WatchProc, must be defined */
 
165
        PgGetHandleProc,                        /* GetHandleProc, must be defined */
 
166
        NULL                                            /* Close2Proc, Not used */
 
167
};
 
168
 
 
169
/*
 
170
 * Create and register a new channel for the connection
 
171
 */
 
172
void
 
173
PgSetConnectionId(Tcl_Interp *interp, PGconn *conn)
 
174
{
 
175
        Tcl_Channel conn_chan;
 
176
        Pg_ConnectionId *connid;
 
177
        int                     i;
 
178
 
 
179
        connid = (Pg_ConnectionId *) ckalloc(sizeof(Pg_ConnectionId));
 
180
        connid->conn = conn;
 
181
        connid->res_count = 0;
 
182
        connid->res_last = -1;
 
183
        connid->res_max = RES_START;
 
184
        connid->res_hardmax = RES_HARD_MAX;
 
185
        connid->res_copy = -1;
 
186
        connid->res_copyStatus = RES_COPY_NONE;
 
187
        connid->results = (PGresult **) ckalloc(sizeof(PGresult *) * RES_START);
 
188
        for (i = 0; i < RES_START; i++)
 
189
                connid->results[i] = NULL;
 
190
        connid->notify_list = NULL;
 
191
        connid->notifier_running = 0;
 
192
 
 
193
        sprintf(connid->id, "pgsql%d", PQsocket(conn));
 
194
 
 
195
#if TCL_MAJOR_VERSION >= 8
 
196
        connid->notifier_channel = Tcl_MakeTcpClientChannel((ClientData) PQsocket(conn));
 
197
        Tcl_RegisterChannel(NULL, connid->notifier_channel);
 
198
#else
 
199
        connid->notifier_socket = -1;
 
200
#endif
 
201
 
 
202
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION == 5
 
203
        /* Original signature (only seen in Tcl 7.5) */
 
204
        conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, NULL, NULL, (ClientData) connid);
 
205
#else
 
206
        /* Tcl 7.6 and later use this */
 
207
        conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData) connid,
 
208
                                                                  TCL_READABLE | TCL_WRITABLE);
 
209
#endif
 
210
 
 
211
        Tcl_SetChannelOption(interp, conn_chan, "-buffering", "line");
 
212
        Tcl_SetResult(interp, connid->id, TCL_VOLATILE);
 
213
        Tcl_RegisterChannel(interp, conn_chan);
 
214
}
 
215
 
 
216
 
 
217
/*
 
218
 * Get back the connection from the Id
 
219
 */
 
220
PGconn *
 
221
PgGetConnectionId(Tcl_Interp *interp, CONST84 char *id,
 
222
                                  Pg_ConnectionId ** connid_p)
 
223
{
 
224
        Tcl_Channel conn_chan;
 
225
        Pg_ConnectionId *connid;
 
226
 
 
227
        conn_chan = Tcl_GetChannel(interp, id, 0);
 
228
        if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
 
229
        {
 
230
                Tcl_ResetResult(interp);
 
231
                Tcl_AppendResult(interp, id, " is not a valid postgresql connection", 0);
 
232
                if (connid_p)
 
233
                        *connid_p = NULL;
 
234
                return (PGconn *) NULL;
 
235
        }
 
236
 
 
237
        connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
 
238
        if (connid_p)
 
239
                *connid_p = connid;
 
240
        return connid->conn;
 
241
}
 
242
 
 
243
 
 
244
/*
 
245
 * Remove a connection Id from the hash table and
 
246
 * close all portals the user forgot.
 
247
 */
 
248
int
 
249
PgDelConnectionId(DRIVER_DEL_PROTO)
 
250
{
 
251
        Tcl_HashEntry *entry;
 
252
        Tcl_HashSearch hsearch;
 
253
        Pg_ConnectionId *connid;
 
254
        Pg_TclNotifies *notifies;
 
255
        int                     i;
 
256
 
 
257
        connid = (Pg_ConnectionId *) cData;
 
258
 
 
259
        for (i = 0; i < connid->res_max; i++)
 
260
        {
 
261
                if (connid->results[i])
 
262
                        PQclear(connid->results[i]);
 
263
        }
 
264
        ckfree((void *) connid->results);
 
265
 
 
266
        /* Release associated notify info */
 
267
        while ((notifies = connid->notify_list) != NULL)
 
268
        {
 
269
                connid->notify_list = notifies->next;
 
270
                for (entry = Tcl_FirstHashEntry(&notifies->notify_hash, &hsearch);
 
271
                         entry != NULL;
 
272
                         entry = Tcl_NextHashEntry(&hsearch))
 
273
                        ckfree((char *) Tcl_GetHashValue(entry));
 
274
                Tcl_DeleteHashTable(&notifies->notify_hash);
 
275
                if (notifies->conn_loss_cmd)
 
276
                        ckfree((void *) notifies->conn_loss_cmd);
 
277
                if (notifies->interp)
 
278
                        Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
 
279
                                                                        (ClientData) notifies);
 
280
                ckfree((void *) notifies);
 
281
        }
 
282
 
 
283
        /*
 
284
         * Turn off the Tcl event source for this connection, and delete any
 
285
         * pending notify and connection-loss events.
 
286
         */
 
287
        PgStopNotifyEventSource(connid, true);
 
288
 
 
289
        /* Close the libpq connection too */
 
290
        PQfinish(connid->conn);
 
291
        connid->conn = NULL;
 
292
 
 
293
        /*
 
294
         * Kill the notifier channel, too.      We must not do this until after
 
295
         * we've closed the libpq connection, because Tcl will try to close
 
296
         * the socket itself!
 
297
         *
 
298
         * XXX Unfortunately, while this works fine if we are closing due to
 
299
         * explicit pg_disconnect, all Tcl versions through 8.4.1 dump core if
 
300
         * we try to do it during interpreter shutdown.  Not clear why. For
 
301
         * now, we kill the channel during pg_disconnect, but during interp
 
302
         * shutdown we just accept leakage of the (fairly small) amount of
 
303
         * memory taken for the channel state representation. (Note we are not
 
304
         * leaking a socket, since libpq closed that already.) We tell the
 
305
         * difference between pg_disconnect and interpreter shutdown by
 
306
         * testing for interp != NULL, which is an undocumented but apparently
 
307
         * safe way to tell.
 
308
         */
 
309
#if TCL_MAJOR_VERSION >= 8
 
310
        if (connid->notifier_channel != NULL && interp != NULL)
 
311
                Tcl_UnregisterChannel(NULL, connid->notifier_channel);
 
312
#endif
 
313
 
 
314
        /*
 
315
         * We must use Tcl_EventuallyFree because we don't want the connid
 
316
         * struct to vanish instantly if Pg_Notify_EventProc is active for it.
 
317
         * (Otherwise, closing the connection from inside a pg_listen callback
 
318
         * could lead to coredump.)  Pg_Notify_EventProc can detect that the
 
319
         * connection has been deleted from under it by checking connid->conn.
 
320
         */
 
321
        Tcl_EventuallyFree((ClientData) connid, TCL_DYNAMIC);
 
322
 
 
323
        return 0;
 
324
}
 
325
 
 
326
 
 
327
/*
 
328
 * Find a slot for a new result id.  If the table is full, expand it by
 
329
 * a factor of 2.  However, do not expand past the hard max, as the client
 
330
 * is probably just not clearing result handles like they should.
 
331
 */
 
332
int
 
333
PgSetResultId(Tcl_Interp *interp, CONST84 char *connid_c, PGresult *res)
 
334
{
 
335
        Tcl_Channel conn_chan;
 
336
        Pg_ConnectionId *connid;
 
337
        int                     resid,
 
338
                                i;
 
339
        char            buf[32];
 
340
 
 
341
 
 
342
        conn_chan = Tcl_GetChannel(interp, connid_c, 0);
 
343
        if (conn_chan == NULL)
 
344
                return TCL_ERROR;
 
345
        connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
 
346
 
 
347
        /* search, starting at slot after the last one used */
 
348
        resid = connid->res_last;
 
349
        for (;;)
 
350
        {
 
351
                /* advance, with wraparound */
 
352
                if (++resid >= connid->res_max)
 
353
                        resid = 0;
 
354
                /* this slot empty? */
 
355
                if (!connid->results[resid])
 
356
                {
 
357
                        connid->res_last = resid;
 
358
                        break;                          /* success exit */
 
359
                }
 
360
                /* checked all slots? */
 
361
                if (resid == connid->res_last)
 
362
                        break;                          /* failure exit */
 
363
        }
 
364
 
 
365
        if (connid->results[resid])
 
366
        {
 
367
                /* no free slot found, so try to enlarge array */
 
368
                if (connid->res_max >= connid->res_hardmax)
 
369
                {
 
370
                        Tcl_SetResult(interp, "hard limit on result handles reached",
 
371
                                                  TCL_STATIC);
 
372
                        return TCL_ERROR;
 
373
                }
 
374
                connid->res_last = resid = connid->res_max;
 
375
                connid->res_max *= 2;
 
376
                if (connid->res_max > connid->res_hardmax)
 
377
                        connid->res_max = connid->res_hardmax;
 
378
                connid->results = (PGresult **) ckrealloc((void *) connid->results,
 
379
                                                                   sizeof(PGresult *) * connid->res_max);
 
380
                for (i = connid->res_last; i < connid->res_max; i++)
 
381
                        connid->results[i] = NULL;
 
382
        }
 
383
 
 
384
        connid->results[resid] = res;
 
385
        sprintf(buf, "%s.%d", connid_c, resid);
 
386
        Tcl_SetResult(interp, buf, TCL_VOLATILE);
 
387
        return resid;
 
388
}
 
389
 
 
390
static int
 
391
getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
 
392
{
 
393
        Tcl_Channel conn_chan;
 
394
        char       *mark;
 
395
        int                     resid;
 
396
        Pg_ConnectionId *connid;
 
397
 
 
398
        if (!(mark = strchr(id, '.')))
 
399
                return -1;
 
400
        *mark = '\0';
 
401
        conn_chan = Tcl_GetChannel(interp, id, 0);
 
402
        *mark = '.';
 
403
        if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
 
404
        {
 
405
                Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
 
406
                return -1;
 
407
        }
 
408
 
 
409
        if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
 
410
        {
 
411
                Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
 
412
                return -1;
 
413
        }
 
414
 
 
415
        connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
 
416
 
 
417
        if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
 
418
        {
 
419
                Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
 
420
                return -1;
 
421
        }
 
422
 
 
423
        *connid_p = connid;
 
424
 
 
425
        return resid;
 
426
}
 
427
 
 
428
 
 
429
/*
 
430
 * Get back the result pointer from the Id
 
431
 */
 
432
PGresult *
 
433
PgGetResultId(Tcl_Interp *interp, CONST84 char *id)
 
434
{
 
435
        Pg_ConnectionId *connid;
 
436
        int                     resid;
 
437
 
 
438
        if (!id)
 
439
                return NULL;
 
440
        resid = getresid(interp, id, &connid);
 
441
        if (resid == -1)
 
442
                return NULL;
 
443
        return connid->results[resid];
 
444
}
 
445
 
 
446
 
 
447
/*
 
448
 * Remove a result Id from the hash tables
 
449
 */
 
450
void
 
451
PgDelResultId(Tcl_Interp *interp, CONST84 char *id)
 
452
{
 
453
        Pg_ConnectionId *connid;
 
454
        int                     resid;
 
455
 
 
456
        resid = getresid(interp, id, &connid);
 
457
        if (resid == -1)
 
458
                return;
 
459
        connid->results[resid] = 0;
 
460
}
 
461
 
 
462
 
 
463
/*
 
464
 * Get the connection Id from the result Id
 
465
 */
 
466
int
 
467
PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid_c)
 
468
{
 
469
        char       *mark;
 
470
        Tcl_Channel conn_chan;
 
471
 
 
472
        if (!(mark = strchr(resid_c, '.')))
 
473
                goto error_out;
 
474
        *mark = '\0';
 
475
        conn_chan = Tcl_GetChannel(interp, resid_c, 0);
 
476
        *mark = '.';
 
477
        if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
 
478
        {
 
479
                Tcl_SetResult(interp, (char *) Tcl_GetChannelName(conn_chan),
 
480
                                          TCL_VOLATILE);
 
481
                return TCL_OK;
 
482
        }
 
483
 
 
484
error_out:
 
485
        Tcl_ResetResult(interp);
 
486
        Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
 
487
        return TCL_ERROR;
 
488
}
 
489
 
 
490
 
 
491
 
 
492
 
 
493
/*-------------------------------------------
 
494
  Notify event source
 
495
 
 
496
  These functions allow asynchronous notify messages arriving from
 
497
  the SQL server to be dispatched as Tcl events.  See the Tcl
 
498
  Notifier(3) man page for more info.
 
499
 
 
500
  The main trick in this code is that we have to cope with status changes
 
501
  between the queueing and the execution of a Tcl event.  For example,
 
502
  if the user changes or cancels the pg_listen callback command, we should
 
503
  use the new setting; we do that by not resolving the notify relation
 
504
  name until the last possible moment.
 
505
  We also have to handle closure of the channel or deletion of the interpreter
 
506
  to be used for the callback (note that with multiple interpreters,
 
507
  the channel can outlive the interpreter it was created by!)
 
508
  Upon closure of the channel, we immediately delete the file event handler
 
509
  for it, which has the effect of disabling any file-ready events that might
 
510
  be hanging about in the Tcl event queue.      But for interpreter deletion,
 
511
  we just set any matching interp pointers in the Pg_TclNotifies list to NULL.
 
512
  The list item stays around until the connection is deleted.  (This avoids
 
513
  trouble with walking through a list whose members may get deleted under us.)
 
514
 
 
515
  Another headache is that Ousterhout keeps changing the Tcl I/O interfaces.
 
516
  libpgtcl currently claims to work with Tcl 7.5, 7.6, and 8.0, and each of
 
517
  'em is different.  Worse, the Tcl_File type went away in 8.0, which means
 
518
  there is no longer any platform-independent way of waiting for file ready.
 
519
  So we now have to use a Unix-specific interface.      Grumble.
 
520
 
 
521
  In the current design, Pg_Notify_FileHandler is a file handler that
 
522
  we establish by calling Tcl_CreateFileHandler().      It gets invoked from
 
523
  the Tcl event loop whenever the underlying PGconn's socket is read-ready.
 
524
  We suck up any available data (to clear the OS-level read-ready condition)
 
525
  and then transfer any available PGnotify events into the Tcl event queue.
 
526
  Eventually these events will be dispatched to Pg_Notify_EventProc.  When
 
527
  we do an ordinary PQexec, we must also transfer PGnotify events into Tcl's
 
528
  event queue, since libpq might have read them when we weren't looking.
 
529
  ------------------------------------------*/
 
530
 
 
531
typedef struct
 
532
{
 
533
        Tcl_Event       header;                 /* Standard Tcl event info */
 
534
        PGnotify   *notify;                     /* Notify event from libpq, or NULL */
 
535
        /* We use a NULL notify pointer to denote a connection-loss event */
 
536
        Pg_ConnectionId *connid;        /* Connection for server */
 
537
}       NotifyEvent;
 
538
 
 
539
/* Dispatch a NotifyEvent that has reached the front of the event queue */
 
540
 
 
541
static int
 
542
Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
 
543
{
 
544
        NotifyEvent *event = (NotifyEvent *) evPtr;
 
545
        Pg_TclNotifies *notifies;
 
546
        char       *callback;
 
547
        char       *svcallback;
 
548
 
 
549
        /* We classify SQL notifies as Tcl file events. */
 
550
        if (!(flags & TCL_FILE_EVENTS))
 
551
                return 0;
 
552
 
 
553
        /* If connection's been closed, just forget the whole thing. */
 
554
        if (event->connid == NULL)
 
555
        {
 
556
                if (event->notify)
 
557
                        PQfreemem(event->notify);
 
558
                return 1;
 
559
        }
 
560
 
 
561
        /*
 
562
         * Preserve/Release to ensure the connection struct doesn't disappear
 
563
         * underneath us.
 
564
         */
 
565
        Tcl_Preserve((ClientData) event->connid);
 
566
 
 
567
        /*
 
568
         * Loop for each interpreter that has ever registered on the
 
569
         * connection. Each one can get a callback.
 
570
         */
 
571
 
 
572
        for (notifies = event->connid->notify_list;
 
573
                 notifies != NULL;
 
574
                 notifies = notifies->next)
 
575
        {
 
576
                Tcl_Interp *interp = notifies->interp;
 
577
 
 
578
                if (interp == NULL)
 
579
                        continue;                       /* ignore deleted interpreter */
 
580
 
 
581
                /*
 
582
                 * Find the callback to be executed for this interpreter, if any.
 
583
                 */
 
584
                if (event->notify)
 
585
                {
 
586
                        /* Ordinary NOTIFY event */
 
587
                        Tcl_HashEntry *entry;
 
588
 
 
589
                        entry = Tcl_FindHashEntry(&notifies->notify_hash,
 
590
                                                                          event->notify->relname);
 
591
                        if (entry == NULL)
 
592
                                continue;               /* no pg_listen in this interpreter */
 
593
                        callback = (char *) Tcl_GetHashValue(entry);
 
594
                }
 
595
                else
 
596
                {
 
597
                        /* Connection-loss event */
 
598
                        callback = notifies->conn_loss_cmd;
 
599
                }
 
600
 
 
601
                if (callback == NULL)
 
602
                        continue;                       /* nothing to do for this interpreter */
 
603
 
 
604
                /*
 
605
                 * We have to copy the callback string in case the user executes a
 
606
                 * new pg_listen or pg_on_connection_loss during the callback.
 
607
                 */
 
608
                svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1));
 
609
                strcpy(svcallback, callback);
 
610
 
 
611
                /*
 
612
                 * Execute the callback.
 
613
                 */
 
614
                Tcl_Preserve((ClientData) interp);
 
615
                if (Tcl_GlobalEval(interp, svcallback) != TCL_OK)
 
616
                {
 
617
                        if (event->notify)
 
618
                                Tcl_AddErrorInfo(interp, "\n    (\"pg_listen\" script)");
 
619
                        else
 
620
                                Tcl_AddErrorInfo(interp, "\n    (\"pg_on_connection_loss\" script)");
 
621
                        Tcl_BackgroundError(interp);
 
622
                }
 
623
                Tcl_Release((ClientData) interp);
 
624
                ckfree(svcallback);
 
625
 
 
626
                /*
 
627
                 * Check for the possibility that the callback closed the
 
628
                 * connection.
 
629
                 */
 
630
                if (event->connid->conn == NULL)
 
631
                        break;
 
632
        }
 
633
 
 
634
        Tcl_Release((ClientData) event->connid);
 
635
 
 
636
        if (event->notify)
 
637
                PQfreemem(event->notify);
 
638
 
 
639
        return 1;
 
640
}
 
641
 
 
642
/*
 
643
 * Transfer any notify events available from libpq into the Tcl event queue.
 
644
 * Note that this must be called after each PQexec (to capture notifies
 
645
 * that arrive during command execution) as well as in Pg_Notify_FileHandler
 
646
 * (to capture notifies that arrive when we're idle).
 
647
 */
 
648
 
 
649
void
 
650
PgNotifyTransferEvents(Pg_ConnectionId * connid)
 
651
{
 
652
        PGnotify   *notify;
 
653
 
 
654
        while ((notify = PQnotifies(connid->conn)) != NULL)
 
655
        {
 
656
                NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
 
657
 
 
658
                event->header.proc = Pg_Notify_EventProc;
 
659
                event->notify = notify;
 
660
                event->connid = connid;
 
661
                Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
 
662
        }
 
663
 
 
664
        /*
 
665
         * This is also a good place to check for unexpected closure of the
 
666
         * connection (ie, backend crash), in which case we must shut down the
 
667
         * notify event source to keep Tcl from trying to select() on the now-
 
668
         * closed socket descriptor.  But don't kill on-connection-loss
 
669
         * events; in fact, register one.
 
670
         */
 
671
        if (PQsocket(connid->conn) < 0)
 
672
                PgConnLossTransferEvents(connid);
 
673
}
 
674
 
 
675
/*
 
676
 * Handle a connection-loss event
 
677
 */
 
678
void
 
679
PgConnLossTransferEvents(Pg_ConnectionId * connid)
 
680
{
 
681
        if (connid->notifier_running)
 
682
        {
 
683
                /* Put the on-connection-loss event in the Tcl queue */
 
684
                NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
 
685
 
 
686
                event->header.proc = Pg_Notify_EventProc;
 
687
                event->notify = NULL;
 
688
                event->connid = connid;
 
689
                Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
 
690
        }
 
691
 
 
692
        /*
 
693
         * Shut down the notify event source to keep Tcl from trying to
 
694
         * select() on the now-closed socket descriptor.  And zap any
 
695
         * unprocessed notify events ... but not, of course, the
 
696
         * connection-loss event.
 
697
         */
 
698
        PgStopNotifyEventSource(connid, false);
 
699
}
 
700
 
 
701
/*
 
702
 * Cleanup code for coping when an interpreter or a channel is deleted.
 
703
 *
 
704
 * PgNotifyInterpDelete is registered as an interpreter deletion callback
 
705
 * for each extant Pg_TclNotifies structure.
 
706
 * NotifyEventDeleteProc is used by PgStopNotifyEventSource to cancel
 
707
 * pending Tcl NotifyEvents that reference a dying connection.
 
708
 */
 
709
 
 
710
void
 
711
PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp)
 
712
{
 
713
        /* Mark the interpreter dead, but don't do anything else yet */
 
714
        Pg_TclNotifies *notifies = (Pg_TclNotifies *) clientData;
 
715
 
 
716
        notifies->interp = NULL;
 
717
}
 
718
 
 
719
/*
 
720
 * Comparison routines for detecting events to be removed by Tcl_DeleteEvents.
 
721
 * NB: In (at least) Tcl versions 7.6 through 8.0.3, there is a serious
 
722
 * bug in Tcl_DeleteEvents: if there are multiple events on the queue and
 
723
 * you tell it to delete the last one, the event list pointers get corrupted,
 
724
 * with the result that events queued immediately thereafter get lost.
 
725
 * Therefore we daren't tell Tcl_DeleteEvents to actually delete anything!
 
726
 * We simply use it as a way of scanning the event queue.  Events matching
 
727
 * the about-to-be-deleted connid are marked dead by setting their connid
 
728
 * fields to NULL.      Then Pg_Notify_EventProc will do nothing when those
 
729
 * events are executed.
 
730
 */
 
731
static int
 
732
NotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
 
733
{
 
734
        Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
 
735
 
 
736
        if (evPtr->proc == Pg_Notify_EventProc)
 
737
        {
 
738
                NotifyEvent *event = (NotifyEvent *) evPtr;
 
739
 
 
740
                if (event->connid == connid && event->notify != NULL)
 
741
                        event->connid = NULL;
 
742
        }
 
743
        return 0;
 
744
}
 
745
 
 
746
/* This version deletes on-connection-loss events too */
 
747
static int
 
748
AllNotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
 
749
{
 
750
        Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
 
751
 
 
752
        if (evPtr->proc == Pg_Notify_EventProc)
 
753
        {
 
754
                NotifyEvent *event = (NotifyEvent *) evPtr;
 
755
 
 
756
                if (event->connid == connid)
 
757
                        event->connid = NULL;
 
758
        }
 
759
        return 0;
 
760
}
 
761
 
 
762
/*
 
763
 * File handler callback: called when Tcl has detected read-ready on socket.
 
764
 * The clientData is a pointer to the associated connection.
 
765
 * We can ignore the condition mask since we only ever ask about read-ready.
 
766
 */
 
767
 
 
768
static void
 
769
Pg_Notify_FileHandler(ClientData clientData, int mask)
 
770
{
 
771
        Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
 
772
 
 
773
        /*
 
774
         * Consume any data available from the SQL server (this just buffers
 
775
         * it internally to libpq; but it will clear the read-ready
 
776
         * condition).
 
777
         */
 
778
        if (PQconsumeInput(connid->conn))
 
779
        {
 
780
                /* Transfer notify events from libpq to Tcl event queue. */
 
781
                PgNotifyTransferEvents(connid);
 
782
        }
 
783
        else
 
784
        {
 
785
                /*
 
786
                 * If there is no input but we have read-ready, assume this means
 
787
                 * we lost the connection.
 
788
                 */
 
789
                PgConnLossTransferEvents(connid);
 
790
        }
 
791
}
 
792
 
 
793
 
 
794
/*
 
795
 * Start and stop the notify event source for a connection.
 
796
 *
 
797
 * We do not bother to run the notifier unless at least one pg_listen
 
798
 * or pg_on_connection_loss has been executed on the connection.  Currently,
 
799
 * once started the notifier is run until the connection is closed.
 
800
 *
 
801
 * FIXME: if PQreset is executed on the underlying PGconn, the active
 
802
 * socket number could change.  How and when should we test for this
 
803
 * and update the Tcl file handler linkage?  (For that matter, we'd
 
804
 * also have to reissue LISTEN commands for active LISTENs, since the
 
805
 * new backend won't know about 'em.  I'm leaving this problem for
 
806
 * another day.)
 
807
 */
 
808
 
 
809
void
 
810
PgStartNotifyEventSource(Pg_ConnectionId * connid)
 
811
{
 
812
        /* Start the notify event source if it isn't already running */
 
813
        if (!connid->notifier_running)
 
814
        {
 
815
                int                     pqsock = PQsocket(connid->conn);
 
816
 
 
817
                if (pqsock >= 0)
 
818
                {
 
819
#if TCL_MAJOR_VERSION >= 8
 
820
                        Tcl_CreateChannelHandler(connid->notifier_channel,
 
821
                                                                         TCL_READABLE,
 
822
                                                                         Pg_Notify_FileHandler,
 
823
                                                                         (ClientData) connid);
 
824
#else
 
825
                        /* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
 
826
                        Tcl_File        tclfile = Tcl_GetFile((ClientData) pqsock, TCL_UNIX_FD);
 
827
 
 
828
                        Tcl_CreateFileHandler(tclfile, TCL_READABLE,
 
829
                                                         Pg_Notify_FileHandler, (ClientData) connid);
 
830
                        connid->notifier_socket = pqsock;
 
831
#endif
 
832
                        connid->notifier_running = 1;
 
833
                }
 
834
        }
 
835
}
 
836
 
 
837
void
 
838
PgStopNotifyEventSource(Pg_ConnectionId * connid, bool allevents)
 
839
{
 
840
        /* Remove the event source */
 
841
        if (connid->notifier_running)
 
842
        {
 
843
#if TCL_MAJOR_VERSION >= 8
 
844
                Tcl_DeleteChannelHandler(connid->notifier_channel,
 
845
                                                                 Pg_Notify_FileHandler,
 
846
                                                                 (ClientData) connid);
 
847
#else
 
848
                /* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */
 
849
                Tcl_File        tclfile = Tcl_GetFile((ClientData) connid->notifier_socket,
 
850
                                                                                  TCL_UNIX_FD);
 
851
 
 
852
                Tcl_DeleteFileHandler(tclfile);
 
853
#endif
 
854
                connid->notifier_running = 0;
 
855
        }
 
856
 
 
857
        /* Kill queued Tcl events that reference this channel */
 
858
        if (allevents)
 
859
                Tcl_DeleteEvents(AllNotifyEventDeleteProc, (ClientData) connid);
 
860
        else
 
861
                Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
 
862
}