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-2004, PostgreSQL Global Development Group
13 * Portions Copyright (c) 1994, Regents of the University of California
14 *
15 * IDENTIFICATION
16 * $Id: pgtclId.c 304 2011-09-19 00:55:15Z lbayuk $
17 *
18 *-------------------------------------------------------------------------
19 */
20
21 #include <string.h>
22 #include <errno.h>
23
24 #include "pgtclCmds.h"
25 #include "pgtclId.h"
26
27 /*
28 * Post-COPY cleanup, common to COPY FROM and COPY TO.
29 */
30 static int
PgEndCopy(Pg_ConnectionId * connid)31 PgEndCopy(Pg_ConnectionId * connid)
32 {
33 connid->res_copyStatus = RES_COPY_NONE;
34 PQclear(connid->results[connid->res_copy]);
35 connid->results[connid->res_copy] = PQgetResult(connid->conn);
36 connid->res_copy = -1;
37 return 0;
38 }
39
40 /*
41 * Called when reading data (via gets) for a copy <rel> to stdout.
42 */
43 int
PgInputProc(DRIVER_INPUT_PROTO)44 PgInputProc(DRIVER_INPUT_PROTO)
45 {
46 Pg_ConnectionId *connid;
47 PGconn *conn;
48 int nread;
49 char *pqbufp;
50
51 connid = (Pg_ConnectionId *) cData;
52 conn = connid->conn;
53
54 if (connid->res_copy < 0 ||
55 PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_OUT)
56 {
57 *errorCodePtr = EBUSY;
58 return -1;
59 }
60
61 /*
62 * Before reading more data from libpq, see if anything was left
63 * over from a previous PQgetCopyData() which was too big to fit
64 * in Tcl's buffer.
65 */
66 if (connid->copyBuf != NULL)
67 {
68 /* How much to return? */
69 if (connid->copyBufLeft <= bufSize)
70 {
71 /* All of it */
72 nread = connid->copyBufLeft;
73 memcpy(buf, connid->copyBufNext, nread);
74 PQfreemem(connid->copyBuf);
75 connid->copyBuf = NULL;
76 }
77 else
78 {
79 /* Not all of it - just the next bufSize bytes */
80 nread = bufSize;
81 memcpy(buf, connid->copyBufNext, nread);
82 connid->copyBufNext += nread;
83 connid->copyBufLeft -= nread;
84 }
85 return nread;
86 }
87
88 /*
89 * Read data in sync mode (async=0).
90 * Note libpq allocates the buffer, which will always contain a whole
91 * record, but it may be bigger than Tcl's buffer.
92 */
93 nread = PQgetCopyData(conn, &pqbufp, 0);
94 if (nread == -2)
95 {
96 /* Error case. No way to get libpq's error message over to Tcl? */
97 *errorCodePtr = EBUSY;
98 return -1;
99 }
100 if (nread == -1)
101 {
102 /* All done. No need to call anything like PQendcopy() any more. */
103 return PgEndCopy(connid);
104 }
105 if (nread == 0) /* Should not happen in sync mode */
106 return 0;
107
108 /* If it fits, send the whole thing to Tcl */
109 if (nread <= bufSize)
110 {
111 memcpy(buf, pqbufp, nread);
112 PQfreemem(pqbufp);
113 return nread;
114 }
115
116 /*
117 * If it doesn't fit, give Tcl a full buffer-full and save
118 * the rest for the next call. We must give Tcl a full buffer,
119 * or it will just ask for the remaining bytes.
120 */
121 memcpy(buf, pqbufp, bufSize);
122 connid->copyBuf = pqbufp;
123 connid->copyBufNext = pqbufp + bufSize;
124 connid->copyBufLeft = nread - bufSize;
125 return bufSize;
126 }
127
128 /*
129 * Called when writing data (via puts) for a copy <rel> from stdin
130 */
131 int
PgOutputProc(DRIVER_OUTPUT_PROTO)132 PgOutputProc(DRIVER_OUTPUT_PROTO)
133 {
134 Pg_ConnectionId *connid;
135 PGconn *conn;
136
137 connid = (Pg_ConnectionId *) cData;
138 conn = connid->conn;
139
140 if (connid->res_copy < 0 ||
141 PQresultStatus(connid->results[connid->res_copy]) != PGRES_COPY_IN)
142 {
143 *errorCodePtr = EBUSY;
144 return -1;
145 }
146
147 /*
148 * Look for the end of copy terminator: "\\." followed by end of line.
149 * Only look for this at the start of the buffer - it must be written
150 * in its own 'puts'.
151 * (Previous implementations looked for it at the end of each buffer,
152 * but that falsely triggered on some valid data).
153 */
154 if (bufSize > 2 && buf[0] == '\\' && buf[1] == '.'
155 && (buf[2] == '\n' || buf[2] == '\r'))
156 {
157 /* End copy with no client-side error message */
158 PQputCopyEnd(conn, NULL);
159 PgEndCopy(connid);
160 /*
161 * We didn't actually write bufSize bytes to the output channel, but
162 * as far as Tcl cares, the write was successful.
163 */
164 return bufSize;
165 }
166
167 /* Write the COPY IN data */
168 if (PQputCopyData(conn, buf, bufSize) == -1)
169 {
170 /* No way to pass libpq error message back to Tcl? */
171 *errorCodePtr = EIO;
172 return -1;
173 }
174 return bufSize;
175 }
176
177 /*
178 * The WatchProc and GetHandleProc are no-ops but must be present.
179 */
180 static void
PgWatchProc(ClientData instanceData,int mask)181 PgWatchProc(ClientData instanceData, int mask)
182 {
183 }
184
185 static int
PgGetHandleProc(ClientData instanceData,int direction,ClientData * handlePtr)186 PgGetHandleProc(ClientData instanceData, int direction,
187 ClientData *handlePtr)
188 {
189 return TCL_ERROR;
190 }
191
192 Tcl_ChannelType Pg_ConnType = {
193 "pgsql", /* channel type */
194 NULL, /* blockmodeproc */
195 PgDelConnectionId, /* closeproc */
196 PgInputProc, /* inputproc */
197 PgOutputProc, /* outputproc */
198 NULL, /* SeekProc, Not used */
199 NULL, /* SetOptionProc, Not used */
200 NULL, /* GetOptionProc, Not used */
201 PgWatchProc, /* WatchProc, must be defined */
202 PgGetHandleProc, /* GetHandleProc, must be defined */
203 NULL /* Close2Proc, Not used */
204 };
205
206 /*
207 * Create and register a new channel for the connection
208 */
209 void
PgSetConnectionId(Tcl_Interp * interp,PGconn * conn)210 PgSetConnectionId(Tcl_Interp *interp, PGconn *conn)
211 {
212 Tcl_Channel conn_chan;
213 Pg_ConnectionId *connid;
214 int i;
215
216 connid = (Pg_ConnectionId *) ckalloc(sizeof(Pg_ConnectionId));
217 connid->conn = conn;
218 connid->res_count = 0;
219 connid->res_last = -1;
220 connid->res_max = RES_START;
221 connid->res_hardmax = RES_HARD_MAX;
222 connid->res_copy = -1;
223 connid->res_copyStatus = RES_COPY_NONE;
224 connid->copyBuf = NULL;
225 connid->results = (PGresult **) ckalloc(sizeof(PGresult *) * RES_START);
226 for (i = 0; i < RES_START; i++)
227 connid->results[i] = NULL;
228 connid->null_string = NULL;
229 connid->notify_list = NULL;
230 connid->notifier_running = 0;
231 connid->interp = NULL;
232 connid->notice_command = NULL;
233 connid->callbackPtr = NULL;
234 connid->callbackInterp = NULL;
235
236 sprintf(connid->id, "pgsql%d", PQsocket(conn));
237
238 connid->notifier_channel = Tcl_MakeTcpClientChannel((ClientData) PQsocket(conn));
239 /* Code executing outside of any Tcl interpreter can call
240 Tcl_RegisterChannel with interp as NULL, to indicate that
241 it wishes to hold a reference to this channel. Subse-
242 quently, the channel can be registered in a Tcl inter-
243 preter and it will only be closed when the matching number
244 of calls to Tcl_UnregisterChannel have been made. This
245 allows code executing outside of any interpreter to safely
246 hold a reference to a channel that is also registered in a
247 Tcl interpreter.
248 */
249 Tcl_RegisterChannel(NULL, connid->notifier_channel);
250
251 conn_chan = Tcl_CreateChannel(&Pg_ConnType, connid->id, (ClientData) connid,
252 TCL_READABLE | TCL_WRITABLE);
253
254 Tcl_SetChannelOption(interp, conn_chan, "-buffering", "line");
255 Tcl_SetChannelOption(interp, conn_chan, "-encoding", "utf-8");
256 Tcl_SetResult(interp, connid->id, TCL_VOLATILE);
257 Tcl_RegisterChannel(interp, conn_chan);
258 }
259
260
261 /*
262 * Get back the connection from the Id
263 */
264 PGconn *
PgGetConnectionId(Tcl_Interp * interp,CONST84 char * id,Pg_ConnectionId ** connid_p)265 PgGetConnectionId(Tcl_Interp *interp, CONST84 char *id,
266 Pg_ConnectionId ** connid_p)
267 {
268 Tcl_Channel conn_chan;
269 Pg_ConnectionId *connid;
270
271 conn_chan = Tcl_GetChannel(interp, id, 0);
272 if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
273 {
274 Tcl_ResetResult(interp);
275 Tcl_AppendResult(interp, id, " is not a valid postgresql connection", 0);
276 if (connid_p)
277 *connid_p = NULL;
278 return (PGconn *) NULL;
279 }
280
281 connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
282 if (connid_p)
283 *connid_p = connid;
284 return connid->conn;
285 }
286
287
288 /*
289 * Remove a connection Id from the hash table and
290 * close all portals the user forgot.
291 */
292 int
PgDelConnectionId(DRIVER_DEL_PROTO)293 PgDelConnectionId(DRIVER_DEL_PROTO)
294 {
295 Tcl_HashEntry *entry;
296 Tcl_HashSearch hsearch;
297 Pg_ConnectionId *connid;
298 Pg_TclNotifies *notifies;
299 Pg_notify_command *notifCmd;
300 int i;
301
302 connid = (Pg_ConnectionId *) cData;
303
304 for (i = 0; i < connid->res_max; i++)
305 {
306 if (connid->results[i])
307 PQclear(connid->results[i]);
308 }
309 ckfree((void *) connid->results);
310 if (connid->null_string)
311 ckfree(connid->null_string);
312 if (connid->notice_command)
313 Tcl_DecrRefCount(connid->notice_command);
314 if (connid->copyBuf)
315 PQfreemem(connid->copyBuf);
316
317 /* Release associated notify info */
318 while ((notifies = connid->notify_list) != NULL)
319 {
320 connid->notify_list = notifies->next;
321 for (entry = Tcl_FirstHashEntry(¬ifies->notify_hash, &hsearch);
322 entry != NULL;
323 entry = Tcl_NextHashEntry(&hsearch))
324 {
325 notifCmd = (Pg_notify_command *)Tcl_GetHashValue(entry);
326 if (notifCmd->callback) ckfree(notifCmd->callback);
327 ckfree((char *)notifCmd);
328 }
329 Tcl_DeleteHashTable(¬ifies->notify_hash);
330 if (notifies->conn_loss_cmd)
331 ckfree((void *) notifies->conn_loss_cmd);
332 if (notifies->interp)
333 Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
334 (ClientData) notifies);
335 ckfree((void *) notifies);
336 }
337
338 /*
339 * Turn off the Tcl event source for this connection, and delete any
340 * pending notify and connection-loss events.
341 */
342 PgStopNotifyEventSource(connid, TRUE);
343
344 /* Close the libpq connection too */
345 PQfinish(connid->conn);
346 connid->conn = NULL;
347
348 /*
349 * Kill the notifier channel, too. We must not do this until after
350 * we've closed the libpq connection, because Tcl will try to close
351 * the socket itself!
352 *
353 * XXX Unfortunately, while this works fine if we are closing due to
354 * explicit pg_disconnect, all Tcl versions through 8.4.1 dump core if
355 * we try to do it during interpreter shutdown. Not clear why. For
356 * now, we kill the channel during pg_disconnect, but during interp
357 * shutdown we just accept leakage of the (fairly small) amount of
358 * memory taken for the channel state representation. (Note we are not
359 * leaking a socket, since libpq closed that already.) We tell the
360 * difference between pg_disconnect and interpreter shutdown by
361 * testing for interp != NULL, which is an undocumented but apparently
362 * safe way to tell.
363 */
364 if (connid->notifier_channel != NULL && interp != NULL)
365 Tcl_UnregisterChannel(NULL, connid->notifier_channel);
366
367 /*
368 * Clear any async result callback, if present.
369 */
370 PgClearResultCallback(connid);
371
372 /*
373 * We must use Tcl_EventuallyFree because we don't want the connid
374 * struct to vanish instantly if Pg_Notify_EventProc is active for it.
375 * (Otherwise, closing the connection from inside a pg_listen callback
376 * could lead to coredump.) Pg_Notify_EventProc can detect that the
377 * connection has been deleted from under it by checking connid->conn.
378 */
379 Tcl_EventuallyFree((ClientData) connid, TCL_DYNAMIC);
380
381 return 0;
382 }
383
384
385 /*
386 * Find a slot for a new result id. If the table is full, expand it by
387 * a factor of 2. However, do not expand past the hard max, as the client
388 * is probably just not clearing result handles like they should.
389 * Returns the result id slot number, or -1 on error.
390 */
391 int
PgSetResultId(Tcl_Interp * interp,CONST84 char * connid_c,PGresult * res)392 PgSetResultId(Tcl_Interp *interp, CONST84 char *connid_c, PGresult *res)
393 {
394 Tcl_Channel conn_chan;
395 Pg_ConnectionId *connid;
396 int resid,
397 i;
398 char buf[32];
399
400
401 conn_chan = Tcl_GetChannel(interp, connid_c, 0);
402 if (conn_chan == NULL)
403 return -1;
404 connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
405
406 /* search, starting at slot after the last one used */
407 resid = connid->res_last;
408 for (;;)
409 {
410 /* advance, with wraparound */
411 if (++resid >= connid->res_max)
412 resid = 0;
413 /* this slot empty? */
414 if (!connid->results[resid])
415 {
416 connid->res_last = resid;
417 break; /* success exit */
418 }
419 /* checked all slots? */
420 if (resid == connid->res_last)
421 break; /* failure exit */
422 }
423
424 if (connid->results[resid])
425 {
426 /* no free slot found, so try to enlarge array */
427 if (connid->res_max >= connid->res_hardmax)
428 {
429 Tcl_SetResult(interp, "hard limit on result handles reached",
430 TCL_STATIC);
431 return -1;
432 }
433 connid->res_last = resid = connid->res_max;
434 connid->res_max *= 2;
435 if (connid->res_max > connid->res_hardmax)
436 connid->res_max = connid->res_hardmax;
437 connid->results = (PGresult **) ckrealloc((void *) connid->results,
438 sizeof(PGresult *) * connid->res_max);
439 for (i = connid->res_last; i < connid->res_max; i++)
440 connid->results[i] = NULL;
441 }
442
443 connid->results[resid] = res;
444 sprintf(buf, "%s.%d", connid_c, resid);
445 Tcl_SetResult(interp, buf, TCL_VOLATILE);
446 return resid;
447 }
448
449 static int
getresid(Tcl_Interp * interp,CONST84 char * id,Pg_ConnectionId ** connid_p)450 getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
451 {
452 Tcl_Channel conn_chan;
453 char *mark;
454 int resid;
455 Pg_ConnectionId *connid;
456
457 if (!(mark = strchr(id, '.')))
458 return -1;
459 *mark = '\0';
460 conn_chan = Tcl_GetChannel(interp, id, 0);
461 *mark = '.';
462 if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
463 {
464 Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
465 return -1;
466 }
467
468 if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
469 {
470 Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
471 return -1;
472 }
473
474 connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
475
476 if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
477 {
478 Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
479 return -1;
480 }
481
482 *connid_p = connid;
483
484 return resid;
485 }
486
487
488 /*
489 * Get back the result pointer from the Id
490 */
491 PGresult *
PgGetResultId(Tcl_Interp * interp,CONST84 char * id)492 PgGetResultId(Tcl_Interp *interp, CONST84 char *id)
493 {
494 Pg_ConnectionId *connid;
495 int resid;
496
497 if (!id)
498 return NULL;
499 resid = getresid(interp, id, &connid);
500 if (resid == -1)
501 return NULL;
502 return connid->results[resid];
503 }
504
505
506 /*
507 * Remove a result Id from the hash tables
508 */
509 void
PgDelResultId(Tcl_Interp * interp,CONST84 char * id)510 PgDelResultId(Tcl_Interp *interp, CONST84 char *id)
511 {
512 Pg_ConnectionId *connid;
513 int resid;
514
515 resid = getresid(interp, id, &connid);
516 if (resid == -1)
517 return;
518 connid->results[resid] = 0;
519 }
520
521
522 /*
523 * Get the connection Id from the result Id
524 */
525 int
PgGetConnByResultId(Tcl_Interp * interp,CONST84 char * resid_c)526 PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid_c)
527 {
528 char *mark;
529 Tcl_Channel conn_chan;
530
531 if (!(mark = strchr(resid_c, '.')))
532 goto error_out;
533 *mark = '\0';
534 conn_chan = Tcl_GetChannel(interp, resid_c, 0);
535 *mark = '.';
536 if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
537 {
538 Tcl_SetResult(interp, (char *) Tcl_GetChannelName(conn_chan),
539 TCL_VOLATILE);
540 return TCL_OK;
541 }
542
543 error_out:
544 Tcl_ResetResult(interp);
545 Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
546 return TCL_ERROR;
547 }
548
549
550
551
552 /*-------------------------------------------
553 Notify event source
554
555 These functions allow asynchronous notify messages arriving from
556 the SQL server to be dispatched as Tcl events. See the Tcl
557 Notifier(3) man page for more info.
558
559 The main trick in this code is that we have to cope with status changes
560 between the queueing and the execution of a Tcl event. For example,
561 if the user changes or cancels the pg_listen callback command, we should
562 use the new setting; we do that by not resolving the notify relation
563 name until the last possible moment.
564 We also have to handle closure of the channel or deletion of the interpreter
565 to be used for the callback (note that with multiple interpreters,
566 the channel can outlive the interpreter it was created by!)
567 Upon closure of the channel, we immediately delete the file event handler
568 for it, which has the effect of disabling any file-ready events that might
569 be hanging about in the Tcl event queue. But for interpreter deletion,
570 we just set any matching interp pointers in the Pg_TclNotifies list to NULL.
571 The list item stays around until the connection is deleted. (This avoids
572 trouble with walking through a list whose members may get deleted under us.)
573
574 In the current design, Pg_Notify_FileHandler is a file handler that
575 we establish by calling Tcl_CreateFileHandler(). It gets invoked from
576 the Tcl event loop whenever the underlying PGconn's socket is read-ready.
577 We suck up any available data (to clear the OS-level read-ready condition)
578 and then transfer any available PGnotify events into the Tcl event queue.
579 Eventually these events will be dispatched to Pg_Notify_EventProc. When
580 we do an ordinary PQexec, we must also transfer PGnotify events into Tcl's
581 event queue, since libpq might have read them when we weren't looking.
582 ------------------------------------------*/
583
584 typedef struct
585 {
586 Tcl_Event header; /* Standard Tcl event info */
587 PGnotify *notify; /* Notify event from libpq, or NULL */
588 /* We use a NULL notify pointer to denote a connection-loss event */
589 Pg_ConnectionId *connid; /* Connection for server */
590 } NotifyEvent;
591
592 /* Dispatch a NotifyEvent that has reached the front of the event queue */
593
594 static int
Pg_Notify_EventProc(Tcl_Event * evPtr,int flags)595 Pg_Notify_EventProc(Tcl_Event *evPtr, int flags)
596 {
597 NotifyEvent *event = (NotifyEvent *) evPtr;
598 Pg_TclNotifies *notifies;
599 char *callback;
600 Tcl_Obj *callbackobj;
601 Pg_notify_command *notifCmd = NULL; /* Init to avoid gcc warning */
602
603 /* We classify SQL notifies as Tcl file events. */
604 if (!(flags & TCL_FILE_EVENTS))
605 return 0;
606
607 /* If connection's been closed, just forget the whole thing. */
608 if (event->connid == NULL)
609 {
610 if (event->notify)
611 PQfreemem(event->notify);
612 return 1;
613 }
614
615 /*
616 * Preserve/Release to ensure the connection struct doesn't disappear
617 * underneath us.
618 */
619 Tcl_Preserve((ClientData) event->connid);
620
621 /*
622 * Loop for each interpreter that has ever registered on the
623 * connection. Each one can get a callback.
624 */
625
626 for (notifies = event->connid->notify_list;
627 notifies != NULL;
628 notifies = notifies->next)
629 {
630 Tcl_Interp *interp = notifies->interp;
631
632 if (interp == NULL)
633 continue; /* ignore deleted interpreter */
634
635 /*
636 * Find the callback to be executed for this interpreter, if any.
637 */
638 if (event->notify)
639 {
640 /* Ordinary NOTIFY event */
641 Tcl_HashEntry *entry;
642
643 entry = Tcl_FindHashEntry(¬ifies->notify_hash,
644 event->notify->relname);
645 if (entry == NULL)
646 continue; /* no pg_listen in this interpreter */
647 notifCmd = (Pg_notify_command *) Tcl_GetHashValue(entry);
648 callback = notifCmd->callback;
649 }
650 else
651 {
652 /* Connection-loss event */
653 callback = notifies->conn_loss_cmd;
654 }
655
656 if (callback == NULL)
657 continue; /* nothing to do for this interpreter */
658
659 /*
660 * We have to copy the callback string in case the user executes a
661 * new pg_listen or pg_on_connection_loss during the callback.
662 *
663 * If there is a payload (PostgreSQL >= 9.0) with the notification
664 * event, pass it as an additional argument. Note that the callback
665 * string may contain multiple arguments. Like all Tcl scripts, it
666 * must be a proper list. The payload is appended to it as a single
667 * list element, but only if it is not empty. The callback proc must
668 * accept an optional argument if handles payloads. (This is an
669 * attempt to remain compatible with PostgreSQL < 9.0 before there
670 * was a notification payload.)
671 */
672
673 /* Copy the callback string as a Tcl object */
674 callbackobj = Tcl_NewStringObj(callback, -1);
675 Tcl_IncrRefCount(callbackobj);
676
677 /*
678 * If a notification event was requested with PID (pg_listen -pid),
679 * append the PID to the command string.
680 * Note this (or the next block) will convert the command to a list.
681 */
682 if (event->notify && notifCmd->use_pid)
683 {
684 Tcl_Obj *pid_obj = Tcl_NewIntObj(event->notify->be_pid);
685 Tcl_IncrRefCount(pid_obj);
686 Tcl_ListObjAppendElement(interp, callbackobj, pid_obj);
687 Tcl_DecrRefCount(pid_obj);
688 }
689
690 /*
691 * If a notification event came with a non-empty payload, append it
692 * to the command string, as a single argument. Note an empty
693 * payload is not passed to the command, for compatibility with
694 * older PostgreSQL versions that do not support the payload.
695 */
696 if (event->notify && event->notify->extra && *event->notify->extra)
697 {
698 Tcl_Obj *payload = Tcl_NewStringObj(event->notify->extra, -1);
699 Tcl_IncrRefCount(payload);
700 Tcl_ListObjAppendElement(interp, callbackobj, payload);
701 Tcl_DecrRefCount(payload);
702 }
703
704 /*
705 * Execute the callback.
706 */
707 Tcl_Preserve((ClientData) interp);
708 if (Tcl_EvalObjEx(interp, callbackobj,
709 TCL_EVAL_GLOBAL+TCL_EVAL_DIRECT) != TCL_OK)
710 {
711 if (event->notify)
712 Tcl_AddErrorInfo(interp, "\n (\"pg_listen\" script)");
713 else
714 Tcl_AddErrorInfo(interp, "\n (\"pg_on_connection_loss\" script)");
715 Tcl_BackgroundError(interp);
716 }
717 Tcl_DecrRefCount(callbackobj);
718 Tcl_Release((ClientData) interp);
719
720 /*
721 * Check for the possibility that the callback closed the
722 * connection.
723 */
724 if (event->connid->conn == NULL)
725 break;
726 }
727
728 Tcl_Release((ClientData) event->connid);
729
730 if (event->notify)
731 PQfreemem(event->notify);
732
733 return 1;
734 }
735
736 /*
737 * Transfer any notify events available from libpq into the Tcl event queue.
738 * Note that this must be called after each PQexec (to capture notifies
739 * that arrive during command execution) as well as in Pg_Notify_FileHandler
740 * (to capture notifies that arrive when we're idle).
741 */
742
743 void
PgNotifyTransferEvents(Pg_ConnectionId * connid)744 PgNotifyTransferEvents(Pg_ConnectionId * connid)
745 {
746 PGnotify *notify;
747
748 while ((notify = PQnotifies(connid->conn)) != NULL)
749 {
750 NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
751
752 event->header.proc = Pg_Notify_EventProc;
753 event->notify = notify;
754 event->connid = connid;
755 Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
756 }
757
758 /*
759 * This is also a good place to check for unexpected closure of the
760 * connection (ie, backend crash), in which case we must shut down the
761 * notify event source to keep Tcl from trying to select() on the now-
762 * closed socket descriptor. But don't kill on-connection-loss
763 * events; in fact, register one.
764 */
765 if (PQsocket(connid->conn) < 0)
766 PgConnLossTransferEvents(connid);
767 }
768
769 /*
770 * Handle a connection-loss event
771 */
772 void
PgConnLossTransferEvents(Pg_ConnectionId * connid)773 PgConnLossTransferEvents(Pg_ConnectionId * connid)
774 {
775 if (connid->notifier_running)
776 {
777 /* Put the on-connection-loss event in the Tcl queue */
778 NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
779
780 event->header.proc = Pg_Notify_EventProc;
781 event->notify = NULL;
782 event->connid = connid;
783 Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
784 }
785
786 /*
787 * Shut down the notify event source to keep Tcl from trying to
788 * select() on the now-closed socket descriptor. And zap any
789 * unprocessed notify events ... but not, of course, the
790 * connection-loss event.
791 */
792 PgStopNotifyEventSource(connid, FALSE);
793 }
794
795 /*
796 * Cleanup code for coping when an interpreter or a channel is deleted.
797 *
798 * PgNotifyInterpDelete is registered as an interpreter deletion callback
799 * for each extant Pg_TclNotifies structure.
800 * NotifyEventDeleteProc is used by PgStopNotifyEventSource to cancel
801 * pending Tcl NotifyEvents that reference a dying connection.
802 */
803
804 void
PgNotifyInterpDelete(ClientData clientData,Tcl_Interp * interp)805 PgNotifyInterpDelete(ClientData clientData, Tcl_Interp *interp)
806 {
807 /* Mark the interpreter dead, but don't do anything else yet */
808 Pg_TclNotifies *notifies = (Pg_TclNotifies *) clientData;
809
810 notifies->interp = NULL;
811 }
812
813 /*
814 * Comparison routines for detecting events to be removed by Tcl_DeleteEvents.
815 * NB: In (at least) Tcl versions 7.6 through 8.0.3, there is a serious
816 * bug in Tcl_DeleteEvents: if there are multiple events on the queue and
817 * you tell it to delete the last one, the event list pointers get corrupted,
818 * with the result that events queued immediately thereafter get lost.
819 * Therefore we daren't tell Tcl_DeleteEvents to actually delete anything!
820 * We simply use it as a way of scanning the event queue. Events matching
821 * the about-to-be-deleted connid are marked dead by setting their connid
822 * fields to NULL. Then Pg_Notify_EventProc will do nothing when those
823 * events are executed.
824 */
825 static int
NotifyEventDeleteProc(Tcl_Event * evPtr,ClientData clientData)826 NotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
827 {
828 Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
829
830 if (evPtr->proc == Pg_Notify_EventProc)
831 {
832 NotifyEvent *event = (NotifyEvent *) evPtr;
833
834 if (event->connid == connid && event->notify != NULL)
835 event->connid = NULL;
836 }
837 return 0;
838 }
839
840 /* This version deletes on-connection-loss events too */
841 static int
AllNotifyEventDeleteProc(Tcl_Event * evPtr,ClientData clientData)842 AllNotifyEventDeleteProc(Tcl_Event *evPtr, ClientData clientData)
843 {
844 Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
845
846 if (evPtr->proc == Pg_Notify_EventProc)
847 {
848 NotifyEvent *event = (NotifyEvent *) evPtr;
849
850 if (event->connid == connid)
851 event->connid = NULL;
852 }
853 return 0;
854 }
855
856 /*
857 * Clear asynchronous query result callback.
858 */
859 void
PgClearResultCallback(Pg_ConnectionId * conn)860 PgClearResultCallback(Pg_ConnectionId *conn)
861 {
862 if (conn->callbackPtr) {
863 Tcl_DecrRefCount(conn->callbackPtr);
864 conn->callbackPtr = NULL;
865 }
866 if (conn->callbackInterp) {
867 Tcl_Release((ClientData) conn->callbackInterp);
868 conn->callbackInterp = NULL;
869 }
870 }
871
872 /*
873 * Asynchronous query result callback: called on asynchronous query completion
874 * if an event is registered for callback on query completion.
875 * This feature was originally implemented by msofer.
876 */
877
878 static int
Pg_Result_EventProc(Tcl_Event * evPtr,int flags)879 Pg_Result_EventProc(Tcl_Event *evPtr, int flags)
880 {
881 NotifyEvent *event = (NotifyEvent *) evPtr;
882
883 /* Results can only come from file events. */
884 if (!(flags & TCL_FILE_EVENTS))
885 return 0;
886
887 /* Only process if the connection is still open. */
888 if (event->connid) {
889 Pg_ConnectionId *connid = event->connid;
890 Tcl_Obj *callbackPtr = connid->callbackPtr;
891 Tcl_Interp *interp = connid->callbackInterp;
892
893 /*
894 * Clear the result callback for this connection, so that the callback
895 * script may safely establish a new one.
896 */
897 connid->callbackPtr = NULL;
898 connid->callbackInterp = NULL;
899
900 if (callbackPtr && interp) {
901 if (Tcl_EvalObjEx(interp, callbackPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
902 Tcl_BackgroundError(interp);
903 }
904 Tcl_DecrRefCount(callbackPtr);
905 Tcl_Release((ClientData) interp);
906 }
907 }
908 /* never deliver this event twice */
909 return 1;
910 }
911
912 /*
913 * File handler callback: called when Tcl has detected read-ready on socket.
914 * The clientData is a pointer to the associated connection.
915 * We can ignore the condition mask since we only ever ask about read-ready.
916 */
917
918 static void
Pg_Notify_FileHandler(ClientData clientData,int mask)919 Pg_Notify_FileHandler(ClientData clientData, int mask)
920 {
921 Pg_ConnectionId *connid = (Pg_ConnectionId *) clientData;
922
923 /*
924 * Consume any data available from the SQL server (this just buffers
925 * it internally to libpq; but it will clear the read-ready
926 * condition).
927 */
928 if (PQconsumeInput(connid->conn))
929 {
930 /* Transfer notify events from libpq to Tcl event queue. */
931 PgNotifyTransferEvents(connid);
932
933 /*
934 * If the connection is still alive, and if there is a
935 * callback for results, check if a result is ready. If it is,
936 * transfer the event to the Tcl event queue.
937 */
938 if ((PQsocket(connid->conn) >= 0)
939 && connid->callbackPtr
940 && !PQisBusy(connid->conn)) {
941
942 NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
943
944 event->header.proc = Pg_Result_EventProc;
945 event->notify = NULL;
946 event->connid = connid;
947 Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
948 }
949 }
950 else
951 {
952 /*
953 * If there is no input but we have read-ready, assume this means
954 * we lost the connection.
955 */
956 PgConnLossTransferEvents(connid);
957 }
958 }
959
960 /*
961 * Start and stop the notify event source for a connection.
962 *
963 * We do not bother to run the notifier unless at least one pg_listen
964 * or pg_on_connection_loss has been executed on the connection. Currently,
965 * once started the notifier is run until the connection is closed.
966 *
967 * FIXME: if PQreset is executed on the underlying PGconn, the active
968 * socket number could change. How and when should we test for this
969 * and update the Tcl file handler linkage? (For that matter, we'd
970 * also have to reissue LISTEN commands for active LISTENs, since the
971 * new backend won't know about 'em. I'm leaving this problem for
972 * another day.)
973 */
974
975 void
PgStartNotifyEventSource(Pg_ConnectionId * connid)976 PgStartNotifyEventSource(Pg_ConnectionId * connid)
977 {
978 /* Start the notify event source if it isn't already running */
979 if (!connid->notifier_running)
980 {
981 int pqsock = PQsocket(connid->conn);
982
983 if (pqsock >= 0)
984 {
985 Tcl_CreateChannelHandler(connid->notifier_channel,
986 TCL_READABLE,
987 Pg_Notify_FileHandler,
988 (ClientData) connid);
989 connid->notifier_running = 1;
990 }
991 }
992 }
993
994 void
PgStopNotifyEventSource(Pg_ConnectionId * connid,char allevents)995 PgStopNotifyEventSource(Pg_ConnectionId * connid, char allevents)
996 {
997 /* Remove the event source */
998 if (connid->notifier_running)
999 {
1000 Tcl_DeleteChannelHandler(connid->notifier_channel,
1001 Pg_Notify_FileHandler,
1002 (ClientData) connid);
1003 connid->notifier_running = 0;
1004 }
1005
1006 /* Kill queued Tcl events that reference this channel */
1007 if (allevents)
1008 Tcl_DeleteEvents(AllNotifyEventDeleteProc, (ClientData) connid);
1009 else
1010 Tcl_DeleteEvents(NotifyEventDeleteProc, (ClientData) connid);
1011 }
1012