1 /*
2 * tclIORChan.c --
3 *
4 * This file contains the implementation of Tcl's generic channel
5 * reflection code, which allows the implementation of Tcl channels in
6 * Tcl code.
7 *
8 * Parts of this file are based on code contributed by Jean-Claude
9 * Wippler.
10 *
11 * See TIP #219 for the specification of this functionality.
12 *
13 * Copyright © 2004-2005 ActiveState, a divison of Sophos
14 *
15 * See the file "license.terms" for information on usage and redistribution of
16 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
17 */
18
19 #include "tclInt.h"
20 #include "tclIO.h"
21 #include <assert.h>
22
23 #ifndef EINVAL
24 #define EINVAL 9
25 #endif
26 #ifndef EOK
27 #define EOK 0
28 #endif
29
30 /*
31 * Signatures of all functions used in the C layer of the reflection.
32 */
33
34 static int ReflectClose(ClientData clientData,
35 Tcl_Interp *interp, int flags);
36 static int ReflectInput(ClientData clientData, char *buf,
37 int toRead, int *errorCodePtr);
38 static int ReflectOutput(ClientData clientData, const char *buf,
39 int toWrite, int *errorCodePtr);
40 static void ReflectWatch(ClientData clientData, int mask);
41 static int ReflectBlock(ClientData clientData, int mode);
42 #if TCL_THREADS
43 static void ReflectThread(ClientData clientData, int action);
44 static int ReflectEventRun(Tcl_Event *ev, int flags);
45 static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
46 #endif
47 static long long ReflectSeekWide(ClientData clientData,
48 long long offset, int mode, int *errorCodePtr);
49 #ifndef TCL_NO_DEPRECATED
50 static int ReflectSeek(ClientData clientData, long offset,
51 int mode, int *errorCodePtr);
52 #endif
53 static int ReflectGetOption(ClientData clientData,
54 Tcl_Interp *interp, const char *optionName,
55 Tcl_DString *dsPtr);
56 static int ReflectSetOption(ClientData clientData,
57 Tcl_Interp *interp, const char *optionName,
58 const char *newValue);
59 static int ReflectTruncate(ClientData clientData,
60 long long length);
61 static void TimerRunRead(ClientData clientData);
62 static void TimerRunWrite(ClientData clientData);
63
64 /*
65 * The C layer channel type/driver definition used by the reflection.
66 */
67
68 static const Tcl_ChannelType tclRChannelType = {
69 "tclrchannel", /* Type name. */
70 TCL_CHANNEL_VERSION_5, /* v5 channel */
71 TCL_CLOSE2PROC, /* Close channel, clean instance data */
72 ReflectInput, /* Handle read request */
73 ReflectOutput, /* Handle write request */
74 #ifndef TCL_NO_DEPRECATED
75 ReflectSeek, /* Move location of access point. NULL'able */
76 #else
77 NULL,
78 #endif
79 ReflectSetOption, /* Set options. NULL'able */
80 ReflectGetOption, /* Get options. NULL'able */
81 ReflectWatch, /* Initialize notifier */
82 NULL, /* Get OS handle from the channel. NULL'able */
83 ReflectClose, /* No close2 support. NULL'able */
84 ReflectBlock, /* Set blocking/nonblocking. NULL'able */
85 NULL, /* Flush channel. Not used by core. NULL'able */
86 NULL, /* Handle events. NULL'able */
87 ReflectSeekWide, /* Move access point (64 bit). NULL'able */
88 #if TCL_THREADS
89 ReflectThread, /* thread action, tracking owner */
90 #else
91 NULL, /* thread action */
92 #endif
93 ReflectTruncate /* Truncate. NULL'able */
94 };
95
96 /*
97 * Instance data for a reflected channel. ===========================
98 */
99
100 typedef struct {
101 Tcl_Channel chan; /* Back reference to generic channel
102 * structure. */
103 Tcl_Interp *interp; /* Reference to the interpreter containing the
104 * Tcl level part of the channel. NULL here
105 * signals the channel is dead because the
106 * interpreter/thread containing its Tcl
107 * command is gone.
108 */
109 #if TCL_THREADS
110 Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
111 Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
112 #endif
113 Tcl_Obj *cmd; /* Callback command prefix */
114 Tcl_Obj *methods; /* Methods to append to command prefix */
115 Tcl_Obj *name; /* Name of the channel as created */
116
117 int mode; /* Mask of R/W mode */
118 int interest; /* Mask of events the channel is interested
119 * in. */
120
121 int dead; /* Boolean signal that some operations
122 * should no longer be attempted. */
123
124 Tcl_TimerToken readTimer; /*
125 A token for the timer that is scheduled in
126 order to call Tcl_NotifyChannel when the
127 channel is readable
128 */
129 Tcl_TimerToken writeTimer; /*
130 A token for the timer that is scheduled in
131 order to call Tcl_NotifyChannel when the
132 channel is writable
133 */
134
135 /*
136 * Note regarding the usage of timers.
137 *
138 * Most channel implementations need a timer in the C level to ensure that
139 * data in buffers is flushed out through the generation of fake file
140 * events.
141 *
142 * See 'rechan', 'memchan', etc.
143 *
144 * A timer is used here as well in order to ensure at least on pass through
145 * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
146 * ef28eb1f1516.
147 */
148 } ReflectedChannel;
149
150 /*
151 * Structure of the table maping from channel handles to reflected
152 * channels. Each interpreter which has the handler command for one or more
153 * reflected channels records them in such a table, so that 'chan postevent'
154 * is able to find them even if the actual channel was moved to a different
155 * interpreter and/or thread.
156 *
157 * The table is reachable via the standard interpreter AssocData, the key is
158 * defined below.
159 */
160
161 typedef struct {
162 Tcl_HashTable map;
163 } ReflectedChannelMap;
164
165 #define RCMKEY "ReflectedChannelMap"
166
167 /*
168 * Event literals. ==================================================
169 */
170
171 static const char *const eventOptions[] = {
172 "read", "write", NULL
173 };
174 typedef enum {
175 EVENT_READ, EVENT_WRITE
176 } EventOption;
177
178 /*
179 * Method literals. ==================================================
180 */
181
182 static const char *const methodNames[] = {
183 "blocking", /* OPT */
184 "cget", /* OPT \/ Together or none */
185 "cgetall", /* OPT /\ of these two */
186 "configure", /* OPT */
187 "finalize", /* */
188 "initialize", /* */
189 "read", /* OPT */
190 "seek", /* OPT */
191 "truncate", /* OPT */
192 "watch", /* */
193 "write", /* OPT */
194 NULL
195 };
196 typedef enum {
197 METH_BLOCKING,
198 METH_CGET,
199 METH_CGETALL,
200 METH_CONFIGURE,
201 METH_FINAL,
202 METH_INIT,
203 METH_READ,
204 METH_SEEK,
205 METH_TRUNCATE,
206 METH_WATCH,
207 METH_WRITE
208 } MethodName;
209
210 #define FLAG(m) (1 << (m))
211 #define REQUIRED_METHODS \
212 (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
213 #define NULLABLE_METHODS \
214 (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
215 FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
216 FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE))
217
218 #define RANDW \
219 (TCL_READABLE | TCL_WRITABLE)
220
221 #define IMPLIES(a,b) ((!(a)) || (b))
222 #define NEGIMPL(a,b)
223 #define HAS(x,f) (x & FLAG(f))
224
225 #if TCL_THREADS
226 /*
227 * Thread specific types and structures.
228 *
229 * We are here essentially creating a very specific implementation of 'thread
230 * send'.
231 */
232
233 /*
234 * Enumeration of all operations which can be forwarded.
235 */
236
237 typedef enum {
238 ForwardedClose,
239 ForwardedInput,
240 ForwardedOutput,
241 ForwardedSeek,
242 ForwardedWatch,
243 ForwardedBlock,
244 ForwardedSetOpt,
245 ForwardedGetOpt,
246 ForwardedGetOptAll,
247 ForwardedTruncate
248 } ForwardedOperation;
249
250 /*
251 * Event used to forward driver invocations to the thread actually managing
252 * the channel. We cannot construct the command to execute and forward that.
253 * Because then it will contain a mixture of Tcl_Obj's belonging to both the
254 * command handler thread (CT), and the thread managing the channel (MT),
255 * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
256 * forward an operation code, the argument details, and reference to results.
257 * The command is assembled in the CT and belongs fully to that thread. No
258 * sharing problems.
259 */
260
261 typedef struct {
262 int code; /* O: Ok/Fail of the cmd handler */
263 char *msgStr; /* O: Error message for handler failure */
264 int mustFree; /* O: True if msgStr is allocated, false if
265 * otherwise (static). */
266 } ForwardParamBase;
267
268 /*
269 * Operation specific parameter/result structures. (These are "subtypes" of
270 * ForwardParamBase. Where an operation does not need any special types, it
271 * has no "subtype" and just uses ForwardParamBase, as listed above.)
272 */
273
274 struct ForwardParamInput {
275 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
276 char *buf; /* O: Where to store the read bytes */
277 int toRead; /* I: #bytes to read,
278 * O: #bytes actually read */
279 };
280 struct ForwardParamOutput {
281 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
282 const char *buf; /* I: Where the bytes to write come from */
283 int toWrite; /* I: #bytes to write,
284 * O: #bytes actually written */
285 };
286 struct ForwardParamSeek {
287 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
288 int seekMode; /* I: How to seek */
289 Tcl_WideInt offset; /* I: Where to seek,
290 * O: New location */
291 };
292 struct ForwardParamWatch {
293 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
294 int mask; /* I: What events to watch for */
295 };
296 struct ForwardParamBlock {
297 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
298 int nonblocking; /* I: What mode to activate */
299 };
300 struct ForwardParamSetOpt {
301 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
302 const char *name; /* Name of option to set */
303 const char *value; /* Value to set */
304 };
305 struct ForwardParamGetOpt {
306 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
307 const char *name; /* Name of option to get, maybe NULL */
308 Tcl_DString *value; /* Result */
309 };
310 struct ForwardParamTruncate {
311 ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
312 Tcl_WideInt length; /* I: Length of file. */
313 };
314
315 /*
316 * Now join all these together in a single union for convenience.
317 */
318
319 typedef union ForwardParam {
320 ForwardParamBase base;
321 struct ForwardParamInput input;
322 struct ForwardParamOutput output;
323 struct ForwardParamSeek seek;
324 struct ForwardParamWatch watch;
325 struct ForwardParamBlock block;
326 struct ForwardParamSetOpt setOpt;
327 struct ForwardParamGetOpt getOpt;
328 struct ForwardParamTruncate truncate;
329 } ForwardParam;
330
331 /*
332 * Forward declaration.
333 */
334
335 typedef struct ForwardingResult ForwardingResult;
336
337 /*
338 * General event structure, with reference to operation specific data.
339 */
340
341 typedef struct {
342 Tcl_Event event; /* Basic event data, has to be first item */
343 ForwardingResult *resultPtr;
344 ForwardedOperation op; /* Forwarded driver operation */
345 ReflectedChannel *rcPtr; /* Channel instance */
346 ForwardParam *param; /* Packaged arguments and return values, a
347 * ForwardParam pointer. */
348 } ForwardingEvent;
349
350 /*
351 * Structure to manage the result of the forwarding. This is not the result of
352 * the operation itself, but about the success of the forward event itself.
353 * The event can be successful, even if the operation which was forwarded
354 * failed. It is also there to manage the synchronization between the involved
355 * threads.
356 */
357
358 struct ForwardingResult {
359 Tcl_ThreadId src; /* Originating thread. */
360 Tcl_ThreadId dst; /* Thread the op was forwarded to. */
361 Tcl_Interp *dsti; /* Interpreter in the thread the op was
362 * forwarded to. */
363 /*
364 * Note regarding 'dsti' above: Its information is also available via the
365 * chain evPtr->rcPtr->interp, however, as can be seen, two more
366 * indirections are needed to retrieve it. And the evPtr may be gone,
367 * breaking the chain.
368 */
369 Tcl_Condition done; /* Condition variable the forwarder blocks
370 * on. */
371 int result; /* TCL_OK or TCL_ERROR */
372 ForwardingEvent *evPtr; /* Event the result belongs to. */
373 ForwardingResult *prevPtr, *nextPtr;
374 /* Links into the list of pending forwarded
375 * results. */
376 };
377
378 typedef struct {
379 /*
380 * Table of all reflected channels owned by this thread. This is the
381 * per-thread version of the per-interpreter map.
382 */
383
384 ReflectedChannelMap *rcmPtr;
385 } ThreadSpecificData;
386
387 static Tcl_ThreadDataKey dataKey;
388
389 /*
390 * List of forwarded operations which have not completed yet, plus the mutex
391 * to protect the access to this process global list.
392 */
393
394 static ForwardingResult *forwardList = NULL;
395 TCL_DECLARE_MUTEX(rcForwardMutex)
396
397 /*
398 * Function containing the generic code executing a forward, and wrapper
399 * macros for the actual operations we wish to forward. Uses ForwardProc as
400 * the event function executed by the thread receiving a forwarding event
401 * (which executes the appropriate function and collects the result, if any).
402 *
403 * The ExitProc ensures that things do not deadlock when the sending thread
404 * involved in the forwarding exits. It also clean things up so that we don't
405 * leak resources when threads go away.
406 */
407
408 static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
409 ForwardedOperation op, const void *param);
410 static int ForwardProc(Tcl_Event *evPtr, int mask);
411 static void SrcExitProc(ClientData clientData);
412
413 #define FreeReceivedError(p) \
414 if ((p)->base.mustFree) { \
415 ckfree((p)->base.msgStr); \
416 }
417 #define PassReceivedErrorInterp(i,p) \
418 if ((i) != NULL) { \
419 Tcl_SetChannelErrorInterp((i), \
420 Tcl_NewStringObj((p)->base.msgStr, -1)); \
421 } \
422 FreeReceivedError(p)
423 #define PassReceivedError(c,p) \
424 Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
425 FreeReceivedError(p)
426 #define ForwardSetStaticError(p,emsg) \
427 (p)->base.code = TCL_ERROR; \
428 (p)->base.mustFree = 0; \
429 (p)->base.msgStr = (char *) (emsg)
430 #define ForwardSetDynamicError(p,emsg) \
431 (p)->base.code = TCL_ERROR; \
432 (p)->base.mustFree = 1; \
433 (p)->base.msgStr = (char *) (emsg)
434
435 static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
436
437 static ReflectedChannelMap * GetThreadReflectedChannelMap(void);
438 static Tcl_ExitProc DeleteThreadReflectedChannelMap;
439
440 #endif /* TCL_THREADS */
441
442 #define SetChannelErrorStr(c,msgStr) \
443 Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
444
445 static Tcl_Obj * MarshallError(Tcl_Interp *interp);
446 static void UnmarshallErrorResult(Tcl_Interp *interp,
447 Tcl_Obj *msgObj);
448
449 /*
450 * Static functions for this file:
451 */
452
453 static int EncodeEventMask(Tcl_Interp *interp,
454 const char *objName, Tcl_Obj *obj, int *mask);
455 static Tcl_Obj * DecodeEventMask(int mask);
456 static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
457 Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
458 static Tcl_Obj * NextHandle(void);
459 static void FreeReflectedChannel(ReflectedChannel *rcPtr);
460 static int InvokeTclMethod(ReflectedChannel *rcPtr,
461 MethodName method, Tcl_Obj *argOneObj,
462 Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
463
464 static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
465 static Tcl_InterpDeleteProc DeleteReflectedChannelMap;
466 static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
467 static void MarkDead(ReflectedChannel *rcPtr);
468
469 /*
470 * Global constant strings (messages). ==================
471 * These string are used directly as bypass errors, thus they have to be valid
472 * Tcl lists where the last element is the message itself. Hence the
473 * list-quoting to keep the words of the message together. See also [x].
474 */
475
476 static const char *msg_read_toomuch = "{read delivered more than requested}";
477 static const char *msg_write_toomuch = "{write wrote more than requested}";
478 static const char *msg_write_nothing = "{write wrote nothing}";
479 static const char *msg_seek_beforestart = "{Tried to seek before origin}";
480 #if TCL_THREADS
481 static const char *msg_send_originlost = "{Channel thread lost}";
482 #endif /* TCL_THREADS */
483 static const char *msg_send_dstlost = "{Owner lost}";
484 static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
485
486 /*
487 * Main methods to plug into the 'chan' ensemble'. ==================
488 */
489
490 /*
491 *----------------------------------------------------------------------
492 *
493 * TclChanCreateObjCmd --
494 *
495 * This function is invoked to process the "chan create" Tcl command.
496 * See the user documentation for details on what it does.
497 *
498 * Results:
499 * A standard Tcl result. The handle of the new channel is placed in the
500 * interp result.
501 *
502 * Side effects:
503 * Creates a new channel.
504 *
505 *----------------------------------------------------------------------
506 */
507
508 int
TclChanCreateObjCmd(TCL_UNUSED (ClientData),Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)509 TclChanCreateObjCmd(
510 TCL_UNUSED(ClientData),
511 Tcl_Interp *interp,
512 int objc,
513 Tcl_Obj *const *objv)
514 {
515 ReflectedChannel *rcPtr; /* Instance data of the new channel */
516 Tcl_Obj *rcId; /* Handle of the new channel */
517 int mode; /* R/W mode of new channel. Has to match
518 * abilities of handler commands */
519 Tcl_Obj *cmdObj; /* Command prefix, list of words */
520 Tcl_Obj *cmdNameObj; /* Command name */
521 Tcl_Channel chan; /* Token for the new channel */
522 Tcl_Obj *modeObj; /* mode in obj form for method call */
523 int listc; /* Result of 'initialize', and of */
524 Tcl_Obj **listv; /* its sublist in the 2nd element */
525 int methIndex; /* Encoded method name */
526 int result; /* Result code for 'initialize' */
527 Tcl_Obj *resObj; /* Result data for 'initialize' */
528 int methods; /* Bitmask for supported methods. */
529 Channel *chanPtr; /* 'chan' resolved to internal struct. */
530 Tcl_Obj *err; /* Error message */
531 ReflectedChannelMap *rcmPtr;
532 /* Map of reflected channels with handlers in
533 * this interp. */
534 Tcl_HashEntry *hPtr; /* Entry in the above map */
535 int isNew; /* Placeholder. */
536
537 /*
538 * Syntax: chan create MODE CMDPREFIX
539 * [0] [1] [2] [3]
540 *
541 * Actually: rCreate MODE CMDPREFIX
542 * [0] [1] [2]
543 */
544
545 #define MODE (1)
546 #define CMD (2)
547
548 /*
549 * Number of arguments...
550 */
551
552 if (objc != 3) {
553 Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
554 return TCL_ERROR;
555 }
556
557 /*
558 * First argument is a list of modes. Allowed entries are "read", "write".
559 * Expect at least one list element. Abbreviations are ok.
560 */
561
562 modeObj = objv[MODE];
563 if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
564 return TCL_ERROR;
565 }
566
567 /*
568 * Second argument is command prefix, i.e. list of words, first word is
569 * name of handler command, other words are fixed arguments. Run the
570 * 'initialize' method to get the list of supported methods. Validate
571 * this.
572 */
573
574 cmdObj = objv[CMD];
575
576 /*
577 * Basic check that the command prefix truly is a list.
578 */
579
580 if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
581 return TCL_ERROR;
582 }
583
584 /*
585 * Now create the channel.
586 */
587
588 rcId = NextHandle();
589 rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
590
591 /*
592 * Invoke 'initialize' and validate that the handler is present and ok.
593 * Squash the channel if not.
594 *
595 * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
596 * 'initialize' is invoked with canonical mode names, and no
597 * abbreviations. Using modeObj directly could feed abbreviations into the
598 * handler, and the handler is not specified to handle such.
599 */
600
601 modeObj = DecodeEventMask(mode);
602 /* assert modeObj.refCount == 1 */
603 result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
604 Tcl_DecrRefCount(modeObj);
605
606 if (result != TCL_OK) {
607 UnmarshallErrorResult(interp, resObj);
608 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
609 goto error;
610 }
611
612 /*
613 * Verify the result.
614 * - List, of method names. Convert to mask.
615 * Check for non-optionals through the mask.
616 * Compare open mode against optional r/w.
617 */
618
619 if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
620 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
621 "chan handler \"%s initialize\" returned non-list: %s",
622 TclGetString(cmdObj), TclGetString(resObj)));
623 Tcl_DecrRefCount(resObj);
624 goto error;
625 }
626
627 methods = 0;
628 while (listc > 0) {
629 if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
630 "method", TCL_EXACT, &methIndex) != TCL_OK) {
631 TclNewLiteralStringObj(err, "chan handler \"");
632 Tcl_AppendObjToObj(err, cmdObj);
633 Tcl_AppendToObj(err, " initialize\" returned ", -1);
634 Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
635 Tcl_SetObjResult(interp, err);
636 Tcl_DecrRefCount(resObj);
637 goto error;
638 }
639
640 methods |= FLAG(methIndex);
641 listc--;
642 }
643 Tcl_DecrRefCount(resObj);
644
645 if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
646 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
647 "chan handler \"%s\" does not support all required methods",
648 TclGetString(cmdObj)));
649 goto error;
650 }
651
652 if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
653 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
654 "chan handler \"%s\" lacks a \"read\" method",
655 TclGetString(cmdObj)));
656 goto error;
657 }
658
659 if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
660 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
661 "chan handler \"%s\" lacks a \"write\" method",
662 TclGetString(cmdObj)));
663 goto error;
664 }
665
666 if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
667 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
668 "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
669 TclGetString(cmdObj)));
670 goto error;
671 }
672
673 if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
674 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
675 "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
676 TclGetString(cmdObj)));
677 goto error;
678 }
679
680 Tcl_ResetResult(interp);
681
682 /*
683 * Everything is fine now.
684 */
685
686 chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
687 mode);
688 rcPtr->chan = chan;
689 TclChannelPreserve(chan);
690 chanPtr = (Channel *) chan;
691
692 if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
693 /*
694 * Some of the nullable methods are not supported. We clone the
695 * channel type, null the associated C functions, and use the result
696 * as the actual channel type.
697 */
698
699 Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType));
700
701 memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
702
703 if (!(methods & FLAG(METH_CONFIGURE))) {
704 clonePtr->setOptionProc = NULL;
705 }
706
707 if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) {
708 clonePtr->getOptionProc = NULL;
709 }
710 if (!(methods & FLAG(METH_BLOCKING))) {
711 clonePtr->blockModeProc = NULL;
712 }
713 if (!(methods & FLAG(METH_SEEK))) {
714 #ifndef TCL_NO_DEPRECATED
715 clonePtr->seekProc = NULL;
716 #endif
717 clonePtr->wideSeekProc = NULL;
718 }
719 if (!(methods & FLAG(METH_TRUNCATE))) {
720 clonePtr->truncateProc = NULL;
721 }
722
723 chanPtr->typePtr = clonePtr;
724 }
725
726 /*
727 * Register the channel in the I/O system, and in our our map for 'chan
728 * postevent'.
729 */
730
731 Tcl_RegisterChannel(interp, chan);
732
733 rcmPtr = GetReflectedChannelMap(interp);
734 hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
735 &isNew);
736 if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
737 Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
738 }
739 Tcl_SetHashValue(hPtr, chan);
740 #if TCL_THREADS
741 rcmPtr = GetThreadReflectedChannelMap();
742 hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
743 &isNew);
744 Tcl_SetHashValue(hPtr, chan);
745 #endif
746
747 /*
748 * Return handle as result of command.
749 */
750
751 Tcl_SetObjResult(interp,
752 Tcl_NewStringObj(chanPtr->state->channelName, -1));
753 return TCL_OK;
754
755 error:
756 Tcl_DecrRefCount(rcPtr->name);
757 Tcl_DecrRefCount(rcPtr->methods);
758 Tcl_DecrRefCount(rcPtr->cmd);
759 ckfree(rcPtr);
760 return TCL_ERROR;
761
762 #undef MODE
763 #undef CMD
764 }
765
766 /*
767 *----------------------------------------------------------------------
768 *
769 * TclChanPostEventObjCmd --
770 *
771 * This function is invoked to process the "chan postevent" Tcl command.
772 * See the user documentation for details on what it does.
773 *
774 * Results:
775 * A standard Tcl result.
776 *
777 * Side effects:
778 * Posts events to a reflected channel, invokes event handlers. The
779 * latter implies that arbitrary side effects are possible.
780 *
781 *----------------------------------------------------------------------
782 */
783
784 #if TCL_THREADS
785 typedef struct {
786 Tcl_Event header;
787 ReflectedChannel *rcPtr;
788 int events;
789 } ReflectEvent;
790
791 static int
ReflectEventRun(Tcl_Event * ev,TCL_UNUSED (int))792 ReflectEventRun(
793 Tcl_Event *ev,
794 TCL_UNUSED(int) /*flags*/)
795 {
796 /* OWNER thread
797 *
798 * Note: When the channel is closed any pending events of this type are
799 * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
800 * accomplishing that.
801 */
802
803 ReflectEvent *e = (ReflectEvent *) ev;
804
805 Tcl_NotifyChannel(e->rcPtr->chan, e->events);
806 return 1;
807 }
808
809 static int
ReflectEventDelete(Tcl_Event * ev,ClientData cd)810 ReflectEventDelete(
811 Tcl_Event *ev,
812 ClientData cd)
813 {
814 /* OWNER thread
815 *
816 * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
817 * latter ensures that no pending events of this type are run on an
818 * invalid channel.
819 */
820
821 ReflectEvent *e = (ReflectEvent *) ev;
822
823 if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
824 return 0;
825 }
826 return 1;
827 }
828 #endif
829
830 int
TclChanPostEventObjCmd(TCL_UNUSED (ClientData),Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)831 TclChanPostEventObjCmd(
832 TCL_UNUSED(ClientData),
833 Tcl_Interp *interp,
834 int objc,
835 Tcl_Obj *const *objv)
836 {
837 /*
838 * Ensure -> HANDLER thread
839 *
840 * Syntax: chan postevent CHANNEL EVENTSPEC
841 * [0] [1] [2] [3]
842 *
843 * Actually: rPostevent CHANNEL EVENTSPEC
844 * [0] [1] [2]
845 *
846 * where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
847 */
848
849 #define CHAN (1)
850 #define EVENT (2)
851
852 const char *chanId; /* Tcl level channel handle */
853 Tcl_Channel chan; /* Channel associated to the handle */
854 const Tcl_ChannelType *chanTypePtr;
855 /* Its associated driver structure */
856 ReflectedChannel *rcPtr; /* Associated instance data */
857 int events; /* Mask of events to post */
858 ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
859 * this interp. */
860 Tcl_HashEntry *hPtr; /* Entry in the above map */
861
862 /*
863 * Number of arguments...
864 */
865
866 if (objc != 3) {
867 Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
868 return TCL_ERROR;
869 }
870
871 /*
872 * First argument is a channel, a reflected channel, and the call of this
873 * command is done from the interp defining the channel handler cmd.
874 */
875
876 chanId = TclGetString(objv[CHAN]);
877
878 rcmPtr = GetReflectedChannelMap(interp);
879 hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
880
881 if (hPtr == NULL) {
882 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
883 "can not find reflected channel named \"%s\"", chanId));
884 Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
885 return TCL_ERROR;
886 }
887
888 /*
889 * Note that the search above subsumes several of the older checks,
890 * namely:
891 *
892 * (1) Does the channel handle refer to a reflected channel?
893 * (2) Is the post event issued from the interpreter holding the handler
894 * of the reflected channel?
895 *
896 * A successful search answers yes to both. Because the map holds only
897 * handles of reflected channels, and only of such whose handler is
898 * defined in this interpreter.
899 *
900 * We keep the old checks for both, for paranioa, but abort now instead of
901 * throwing errors, as failure now means that our internal datastructures
902 * have gone seriously haywire.
903 */
904
905 chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
906 chanTypePtr = Tcl_GetChannelType(chan);
907
908 /*
909 * We use a function referenced by the channel type as our cookie to
910 * detect calls to non-reflecting channels. The channel type itself is not
911 * suitable, as it might not be the static definition in this file, but a
912 * clone thereof. And while we have reserved the name of the type nothing
913 * in the core checks against violation, so someone else might have
914 * created a channel type using our name, clashing with ourselves.
915 */
916
917 if (chanTypePtr->watchProc != &ReflectWatch) {
918 Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel");
919 }
920
921 rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
922
923 if (rcPtr->interp != interp) {
924 Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
925 }
926
927 /*
928 * Second argument is a list of events. Allowed entries are "read",
929 * "write". Expect at least one list element. Abbreviations are ok.
930 */
931
932 if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
933 return TCL_ERROR;
934 }
935
936 /*
937 * Check that the channel is actually interested in the provided events.
938 */
939
940 if (events & ~rcPtr->interest) {
941 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
942 "tried to post events channel \"%s\" is not interested in",
943 chanId));
944 return TCL_ERROR;
945 }
946
947 /*
948 * We have the channel and the events to post.
949 */
950
951 #if TCL_THREADS
952 if (rcPtr->owner == rcPtr->thread) {
953 #endif
954 if (events & TCL_READABLE) {
955 if (rcPtr->readTimer == NULL) {
956 rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
957 TimerRunRead, rcPtr);
958 }
959 }
960 if (events & TCL_WRITABLE) {
961 if (rcPtr->writeTimer == NULL) {
962 rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
963 TimerRunWrite, rcPtr);
964 }
965 }
966 #if TCL_THREADS
967 } else {
968 ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent));
969
970 ev->header.proc = ReflectEventRun;
971 ev->events = events;
972 ev->rcPtr = rcPtr;
973
974 /*
975 * We are not preserving the structure here. When the channel is
976 * closed any pending events are deleted, see ReflectClose(), and
977 * ReflectEventDelete(). Trying to preserve and later release when the
978 * event is run may generate a situation where the channel structure
979 * is deleted but not our structure, crashing in
980 * FreeReflectedChannel().
981 *
982 * Force creation of the RCM, for proper cleanup on thread teardown.
983 * The teardown of unprocessed events is currently coupled to the
984 * thread reflected channel map
985 */
986
987 (void) GetThreadReflectedChannelMap();
988
989 /*
990 * XXX Race condition !!
991 * XXX The destination thread may not exist anymore already.
992 * XXX (Delayed postevent executed after channel got removed).
993 * XXX Can we detect this ? (check the validity of the owner threadid ?)
994 * XXX Actually, in that case the channel should be dead also !
995 */
996
997 Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
998 Tcl_ThreadAlert(rcPtr->owner);
999 }
1000 #endif
1001
1002 /*
1003 * Squash interp results left by the event script.
1004 */
1005
1006 Tcl_ResetResult(interp);
1007 return TCL_OK;
1008
1009 #undef CHAN
1010 #undef EVENT
1011 }
1012
1013 static void
TimerRunRead(ClientData clientData)1014 TimerRunRead(
1015 ClientData clientData)
1016 {
1017 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1018 rcPtr->readTimer = NULL;
1019 Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
1020 }
1021
1022 static void
TimerRunWrite(ClientData clientData)1023 TimerRunWrite(
1024 ClientData clientData)
1025 {
1026 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1027 rcPtr->writeTimer = NULL;
1028 Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
1029 }
1030
1031 /*
1032 * Channel error message marshalling utilities.
1033 */
1034
1035 static Tcl_Obj *
MarshallError(Tcl_Interp * interp)1036 MarshallError(
1037 Tcl_Interp *interp)
1038 {
1039 /*
1040 * Capture the result status of the interpreter into a string. => List of
1041 * options and values, followed by the error message. The result has
1042 * refCount 0.
1043 */
1044
1045 Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
1046
1047 /*
1048 * => returnOpt.refCount == 0. We can append directly.
1049 */
1050
1051 Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
1052 return returnOpt;
1053 }
1054
1055 static void
UnmarshallErrorResult(Tcl_Interp * interp,Tcl_Obj * msgObj)1056 UnmarshallErrorResult(
1057 Tcl_Interp *interp,
1058 Tcl_Obj *msgObj)
1059 {
1060 int lc;
1061 Tcl_Obj **lv;
1062 int explicitResult;
1063 int numOptions;
1064
1065 /*
1066 * Process the caught message.
1067 *
1068 * Syntax = (option value)... ?message?
1069 *
1070 * Bad syntax causes a panic. This is OK because the other side uses
1071 * Tcl_GetReturnOptions and list construction functions to marshall the
1072 * information; if we panic here, something has gone badly wrong already.
1073 */
1074
1075 if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
1076 Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
1077 }
1078 if (interp == NULL) {
1079 return;
1080 }
1081
1082 explicitResult = lc & 1; /* Odd number of values? */
1083 numOptions = lc - explicitResult;
1084
1085 if (explicitResult) {
1086 Tcl_SetObjResult(interp, lv[lc-1]);
1087 }
1088
1089 (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
1090 ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
1091 }
1092
1093 int
TclChanCaughtErrorBypass(Tcl_Interp * interp,Tcl_Channel chan)1094 TclChanCaughtErrorBypass(
1095 Tcl_Interp *interp,
1096 Tcl_Channel chan)
1097 {
1098 Tcl_Obj *chanMsgObj = NULL;
1099 Tcl_Obj *interpMsgObj = NULL;
1100 Tcl_Obj *msgObj = NULL;
1101
1102 /*
1103 * Get a bypassed error message from channel and/or interpreter, save the
1104 * reference, then kill the returned objects, if there were any. If there
1105 * are messages in both the channel has preference.
1106 */
1107
1108 if ((chan == NULL) && (interp == NULL)) {
1109 return 0;
1110 }
1111
1112 if (chan != NULL) {
1113 Tcl_GetChannelError(chan, &chanMsgObj);
1114 }
1115 if (interp != NULL) {
1116 Tcl_GetChannelErrorInterp(interp, &interpMsgObj);
1117 }
1118
1119 if (chanMsgObj != NULL) {
1120 msgObj = chanMsgObj;
1121 } else if (interpMsgObj != NULL) {
1122 msgObj = interpMsgObj;
1123 }
1124 if (msgObj != NULL) {
1125 Tcl_IncrRefCount(msgObj);
1126 }
1127
1128 if (chanMsgObj != NULL) {
1129 Tcl_DecrRefCount(chanMsgObj);
1130 }
1131 if (interpMsgObj != NULL) {
1132 Tcl_DecrRefCount(interpMsgObj);
1133 }
1134
1135 /*
1136 * No message returned, nothing caught.
1137 */
1138
1139 if (msgObj == NULL) {
1140 return 0;
1141 }
1142
1143 UnmarshallErrorResult(interp, msgObj);
1144
1145 Tcl_DecrRefCount(msgObj);
1146 return 1;
1147 }
1148
1149 /*
1150 * Driver functions. ================================================
1151 */
1152
1153 /*
1154 *----------------------------------------------------------------------
1155 *
1156 * ReflectClose --
1157 *
1158 * This function is invoked when the channel is closed, to delete the
1159 * driver-specific instance data.
1160 *
1161 * Results:
1162 * A posix error.
1163 *
1164 * Side effects:
1165 * Releases memory. Arbitrary, as it calls upon a script.
1166 *
1167 *----------------------------------------------------------------------
1168 */
1169
1170 static int
ReflectClose(ClientData clientData,Tcl_Interp * interp,int flags)1171 ReflectClose(
1172 ClientData clientData,
1173 Tcl_Interp *interp,
1174 int flags)
1175 {
1176 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1177 int result; /* Result code for 'close' */
1178 Tcl_Obj *resObj; /* Result data for 'close' */
1179 ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
1180 * this interp */
1181 Tcl_HashEntry *hPtr; /* Entry in the above map */
1182 const Tcl_ChannelType *tctPtr;
1183
1184 if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
1185 return EINVAL;
1186 }
1187
1188 if (TclInThreadExit()) {
1189 /*
1190 * This call comes from TclFinalizeIOSystem. There are no
1191 * interpreters, and therefore we cannot call upon the handler command
1192 * anymore. Threading is irrelevant as well. Simply clean up all
1193 * the C level data structures and leave the Tcl level to the other
1194 * finalization functions.
1195 */
1196
1197 /*
1198 * THREADED => Forward this to the origin thread
1199 *
1200 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
1201 * for the origin thread. Use this to clean up the structure? Except
1202 * if lost?
1203 */
1204
1205 #if TCL_THREADS
1206 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1207 ForwardParam p;
1208
1209 ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
1210 result = p.base.code;
1211
1212 /*
1213 * Now squash the pending reflection events for this channel.
1214 */
1215
1216 Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
1217
1218 if (result != TCL_OK) {
1219 FreeReceivedError(&p);
1220 }
1221 }
1222 #endif
1223
1224 tctPtr = ((Channel *)rcPtr->chan)->typePtr;
1225 if (tctPtr && tctPtr != &tclRChannelType) {
1226 ckfree(tctPtr);
1227 ((Channel *)rcPtr->chan)->typePtr = NULL;
1228 }
1229 if (rcPtr->readTimer != NULL) {
1230 Tcl_DeleteTimerHandler(rcPtr->readTimer);
1231 }
1232 if (rcPtr->writeTimer != NULL) {
1233 Tcl_DeleteTimerHandler(rcPtr->writeTimer);
1234 }
1235 Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
1236 return EOK;
1237 }
1238
1239 /*
1240 * Are we in the correct thread?
1241 */
1242
1243 #if TCL_THREADS
1244 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1245 ForwardParam p;
1246
1247 ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
1248 result = p.base.code;
1249
1250 /*
1251 * Now squash the pending reflection events for this channel.
1252 */
1253
1254 Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
1255
1256 if (result != TCL_OK) {
1257 PassReceivedErrorInterp(interp, &p);
1258 }
1259 } else {
1260 #endif
1261 result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
1262 if ((result != TCL_OK) && (interp != NULL)) {
1263 Tcl_SetChannelErrorInterp(interp, resObj);
1264 }
1265
1266 Tcl_DecrRefCount(resObj); /* Remove reference we held from the
1267 * invoke */
1268
1269 /*
1270 * Remove the channel from the map before releasing the memory, to
1271 * prevent future accesses (like by 'postevent') from finding and
1272 * dereferencing a dangling pointer.
1273 *
1274 * NOTE: The channel may not be in the map. This is ok, that happens
1275 * when the channel was created in a different interpreter and/or
1276 * thread and then was moved here.
1277 *
1278 * NOTE: The channel may have been removed from the map already via
1279 * the per-interp DeleteReflectedChannelMap exit-handler.
1280 */
1281
1282 if (!rcPtr->dead) {
1283 rcmPtr = GetReflectedChannelMap(rcPtr->interp);
1284 hPtr = Tcl_FindHashEntry(&rcmPtr->map,
1285 Tcl_GetChannelName(rcPtr->chan));
1286 if (hPtr) {
1287 Tcl_DeleteHashEntry(hPtr);
1288 }
1289 }
1290 #if TCL_THREADS
1291 rcmPtr = GetThreadReflectedChannelMap();
1292 hPtr = Tcl_FindHashEntry(&rcmPtr->map,
1293 Tcl_GetChannelName(rcPtr->chan));
1294 if (hPtr) {
1295 Tcl_DeleteHashEntry(hPtr);
1296 }
1297 }
1298 #endif
1299 tctPtr = ((Channel *)rcPtr->chan)->typePtr;
1300 if (tctPtr && tctPtr != &tclRChannelType) {
1301 ckfree(tctPtr);
1302 ((Channel *)rcPtr->chan)->typePtr = NULL;
1303 }
1304 if (rcPtr->readTimer != NULL) {
1305 Tcl_DeleteTimerHandler(rcPtr->readTimer);
1306 }
1307 if (rcPtr->writeTimer != NULL) {
1308 Tcl_DeleteTimerHandler(rcPtr->writeTimer);
1309 }
1310 Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
1311 return (result == TCL_OK) ? EOK : EINVAL;
1312 }
1313
1314 /*
1315 *----------------------------------------------------------------------
1316 *
1317 * ReflectInput --
1318 *
1319 * This function is invoked when more data is requested from the channel.
1320 *
1321 * Results:
1322 * The number of bytes read.
1323 *
1324 * Side effects:
1325 * Allocates memory. Arbitrary, as it calls upon a script.
1326 *
1327 *----------------------------------------------------------------------
1328 */
1329
1330 static int
ReflectInput(ClientData clientData,char * buf,int toRead,int * errorCodePtr)1331 ReflectInput(
1332 ClientData clientData,
1333 char *buf,
1334 int toRead,
1335 int *errorCodePtr)
1336 {
1337 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1338 Tcl_Obj *toReadObj;
1339 int bytec; /* Number of returned bytes */
1340 unsigned char *bytev; /* Array of returned bytes */
1341 Tcl_Obj *resObj; /* Result data for 'read' */
1342
1343 /*
1344 * Are we in the correct thread?
1345 */
1346
1347 #if TCL_THREADS
1348 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1349 ForwardParam p;
1350
1351 p.input.buf = buf;
1352 p.input.toRead = toRead;
1353
1354 ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
1355
1356 if (p.base.code != TCL_OK) {
1357 if (p.base.code < 0) {
1358 /*
1359 * No error message, this is an errno signal.
1360 */
1361
1362 *errorCodePtr = -p.base.code;
1363 } else {
1364 PassReceivedError(rcPtr->chan, &p);
1365 *errorCodePtr = EINVAL;
1366 }
1367 p.input.toRead = -1;
1368 } else {
1369 *errorCodePtr = EOK;
1370 }
1371
1372 return p.input.toRead;
1373 }
1374 #endif
1375
1376 /* ASSERT: rcPtr->method & FLAG(METH_READ) */
1377 /* ASSERT: rcPtr->mode & TCL_READABLE */
1378
1379 Tcl_Preserve(rcPtr);
1380
1381 TclNewIntObj(toReadObj, toRead);
1382 Tcl_IncrRefCount(toReadObj);
1383
1384 if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
1385 int code = ErrnoReturn(rcPtr, resObj);
1386
1387 if (code < 0) {
1388 *errorCodePtr = -code;
1389 goto error;
1390 }
1391
1392 Tcl_SetChannelError(rcPtr->chan, resObj);
1393 goto invalid;
1394 }
1395
1396 bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
1397
1398 if (toRead < bytec) {
1399 SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
1400 goto invalid;
1401 }
1402
1403 *errorCodePtr = EOK;
1404
1405 if (bytec > 0) {
1406 memcpy(buf, bytev, bytec);
1407 }
1408
1409 stop:
1410 Tcl_DecrRefCount(toReadObj);
1411 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
1412 Tcl_Release(rcPtr);
1413 return bytec;
1414 invalid:
1415 *errorCodePtr = EINVAL;
1416 error:
1417 bytec = -1;
1418 goto stop;
1419 }
1420
1421 /*
1422 *----------------------------------------------------------------------
1423 *
1424 * ReflectOutput --
1425 *
1426 * This function is invoked when data is writen to the channel.
1427 *
1428 * Results:
1429 * The number of bytes actually written.
1430 *
1431 * Side effects:
1432 * Allocates memory. Arbitrary, as it calls upon a script.
1433 *
1434 *----------------------------------------------------------------------
1435 */
1436
1437 static int
ReflectOutput(ClientData clientData,const char * buf,int toWrite,int * errorCodePtr)1438 ReflectOutput(
1439 ClientData clientData,
1440 const char *buf,
1441 int toWrite,
1442 int *errorCodePtr)
1443 {
1444 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1445 Tcl_Obj *bufObj;
1446 Tcl_Obj *resObj; /* Result data for 'write' */
1447 int written;
1448
1449 /*
1450 * Are we in the correct thread?
1451 */
1452
1453 #if TCL_THREADS
1454 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1455 ForwardParam p;
1456
1457 p.output.buf = buf;
1458 p.output.toWrite = toWrite;
1459
1460 ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
1461
1462 if (p.base.code != TCL_OK) {
1463 if (p.base.code < 0) {
1464 /*
1465 * No error message, this is an errno signal.
1466 */
1467
1468 *errorCodePtr = -p.base.code;
1469 } else {
1470 PassReceivedError(rcPtr->chan, &p);
1471 *errorCodePtr = EINVAL;
1472 }
1473 p.output.toWrite = -1;
1474 } else {
1475 *errorCodePtr = EOK;
1476 }
1477
1478 return p.output.toWrite;
1479 }
1480 #endif
1481
1482 /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
1483 /* ASSERT: rcPtr->mode & TCL_WRITABLE */
1484
1485 Tcl_Preserve(rcPtr);
1486 Tcl_Preserve(rcPtr->interp);
1487
1488 bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
1489 Tcl_IncrRefCount(bufObj);
1490
1491 if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
1492 int code = ErrnoReturn(rcPtr, resObj);
1493
1494 if (code < 0) {
1495 *errorCodePtr = -code;
1496 goto error;
1497 }
1498
1499 Tcl_SetChannelError(rcPtr->chan, resObj);
1500 goto invalid;
1501 }
1502
1503 if (Tcl_InterpDeleted(rcPtr->interp)) {
1504 /*
1505 * The interp was destroyed during InvokeTclMethod().
1506 */
1507
1508 SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
1509 goto invalid;
1510 }
1511 if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
1512 Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
1513 goto invalid;
1514 }
1515
1516 if ((written == 0) && (toWrite > 0)) {
1517 /*
1518 * The handler claims to have written nothing of what it was given.
1519 * That is bad.
1520 */
1521
1522 SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
1523 goto invalid;
1524 }
1525 if (toWrite < written) {
1526 /*
1527 * The handler claims to have written more than it was given. That is
1528 * bad. Note that the I/O core would crash if we were to return this
1529 * information, trying to write -nnn bytes in the next iteration.
1530 */
1531
1532 SetChannelErrorStr(rcPtr->chan, msg_write_toomuch);
1533 goto invalid;
1534 }
1535
1536 *errorCodePtr = EOK;
1537 stop:
1538 Tcl_DecrRefCount(bufObj);
1539 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
1540 Tcl_Release(rcPtr->interp);
1541 Tcl_Release(rcPtr);
1542 return written;
1543 invalid:
1544 *errorCodePtr = EINVAL;
1545 error:
1546 written = -1;
1547 goto stop;
1548 }
1549
1550 /*
1551 *----------------------------------------------------------------------
1552 *
1553 * ReflectSeekWide / ReflectSeek --
1554 *
1555 * This function is invoked when the user wishes to seek on the channel.
1556 *
1557 * Results:
1558 * The new location of the access point.
1559 *
1560 * Side effects:
1561 * Allocates memory. Arbitrary, as it calls upon a script.
1562 *
1563 *----------------------------------------------------------------------
1564 */
1565
1566 static long long
ReflectSeekWide(ClientData clientData,long long offset,int seekMode,int * errorCodePtr)1567 ReflectSeekWide(
1568 ClientData clientData,
1569 long long offset,
1570 int seekMode,
1571 int *errorCodePtr)
1572 {
1573 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1574 Tcl_Obj *offObj, *baseObj;
1575 Tcl_Obj *resObj; /* Result for 'seek' */
1576 Tcl_WideInt newLoc;
1577
1578 /*
1579 * Are we in the correct thread?
1580 */
1581
1582 #if TCL_THREADS
1583 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1584 ForwardParam p;
1585
1586 p.seek.seekMode = seekMode;
1587 p.seek.offset = offset;
1588
1589 ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
1590
1591 if (p.base.code != TCL_OK) {
1592 PassReceivedError(rcPtr->chan, &p);
1593 *errorCodePtr = EINVAL;
1594 p.seek.offset = -1;
1595 } else {
1596 *errorCodePtr = EOK;
1597 }
1598
1599 return p.seek.offset;
1600 }
1601 #endif
1602
1603 /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */
1604
1605 Tcl_Preserve(rcPtr);
1606
1607 TclNewIntObj(offObj, offset);
1608 baseObj = Tcl_NewStringObj(
1609 (seekMode == SEEK_SET) ? "start" :
1610 (seekMode == SEEK_CUR) ? "current" : "end", -1);
1611 Tcl_IncrRefCount(offObj);
1612 Tcl_IncrRefCount(baseObj);
1613
1614 if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
1615 Tcl_SetChannelError(rcPtr->chan, resObj);
1616 goto invalid;
1617 }
1618
1619 if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
1620 Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
1621 goto invalid;
1622 }
1623
1624 if (newLoc < 0) {
1625 SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
1626 goto invalid;
1627 }
1628
1629 *errorCodePtr = EOK;
1630 stop:
1631 Tcl_DecrRefCount(offObj);
1632 Tcl_DecrRefCount(baseObj);
1633 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
1634 Tcl_Release(rcPtr);
1635 return newLoc;
1636 invalid:
1637 *errorCodePtr = EINVAL;
1638 newLoc = -1;
1639 goto stop;
1640 }
1641
1642 #ifndef TCL_NO_DEPRECATED
1643 static int
ReflectSeek(ClientData clientData,long offset,int seekMode,int * errorCodePtr)1644 ReflectSeek(
1645 ClientData clientData,
1646 long offset,
1647 int seekMode,
1648 int *errorCodePtr)
1649 {
1650 /*
1651 * This function can be invoked from a transformation which is based on
1652 * standard seeking, i.e. non-wide. Because of this we have to implement
1653 * it, a dummy is not enough. We simply delegate the call to the wide
1654 * routine.
1655 */
1656
1657 return ReflectSeekWide(clientData, offset, seekMode,
1658 errorCodePtr);
1659 }
1660 #endif
1661
1662 /*
1663 *----------------------------------------------------------------------
1664 *
1665 * ReflectWatch --
1666 *
1667 * This function is invoked to tell the channel what events the I/O
1668 * system is interested in.
1669 *
1670 * Results:
1671 * None.
1672 *
1673 * Side effects:
1674 * Allocates memory. Arbitrary, as it calls upon a script.
1675 *
1676 *----------------------------------------------------------------------
1677 */
1678
1679 static void
ReflectWatch(ClientData clientData,int mask)1680 ReflectWatch(
1681 ClientData clientData,
1682 int mask)
1683 {
1684 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1685 Tcl_Obj *maskObj;
1686
1687 /*
1688 * We restrict the interest to what the channel can support. IOW there
1689 * will never be write events for a channel which is not writable.
1690 * Analoguously for read events and non-readable channels.
1691 */
1692
1693 mask &= rcPtr->mode;
1694
1695 if (mask == rcPtr->interest) {
1696 /*
1697 * Same old, same old, why should we do something?
1698 */
1699
1700 return;
1701 }
1702
1703 /*
1704 * Are we in the correct thread?
1705 */
1706
1707 #if TCL_THREADS
1708 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1709 ForwardParam p;
1710
1711 p.watch.mask = mask;
1712 ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
1713
1714 /*
1715 * Any failure from the forward is ignored. We have no place to put
1716 * this.
1717 */
1718
1719 return;
1720 }
1721 #endif
1722
1723 Tcl_Preserve(rcPtr);
1724
1725 rcPtr->interest = mask;
1726 maskObj = DecodeEventMask(mask);
1727 /* assert maskObj.refCount == 1 */
1728 (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
1729 Tcl_DecrRefCount(maskObj);
1730
1731 Tcl_Release(rcPtr);
1732 }
1733
1734 /*
1735 *----------------------------------------------------------------------
1736 *
1737 * ReflectBlock --
1738 *
1739 * This function is invoked to tell the channel which blocking behaviour
1740 * is required of it.
1741 *
1742 * Results:
1743 * A posix error number.
1744 *
1745 * Side effects:
1746 * Allocates memory. Arbitrary, as it calls upon a script.
1747 *
1748 *----------------------------------------------------------------------
1749 */
1750
1751 static int
ReflectBlock(ClientData clientData,int nonblocking)1752 ReflectBlock(
1753 ClientData clientData,
1754 int nonblocking)
1755 {
1756 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1757 Tcl_Obj *blockObj;
1758 int errorNum; /* EINVAL or EOK (success). */
1759 Tcl_Obj *resObj; /* Result data for 'blocking' */
1760
1761 /*
1762 * Are we in the correct thread?
1763 */
1764
1765 #if TCL_THREADS
1766 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1767 ForwardParam p;
1768
1769 p.block.nonblocking = nonblocking;
1770
1771 ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
1772
1773 if (p.base.code != TCL_OK) {
1774 PassReceivedError(rcPtr->chan, &p);
1775 return EINVAL;
1776 }
1777
1778 return EOK;
1779 }
1780 #endif
1781
1782 blockObj = Tcl_NewBooleanObj(!nonblocking);
1783 Tcl_IncrRefCount(blockObj);
1784
1785 Tcl_Preserve(rcPtr);
1786
1787 if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
1788 Tcl_SetChannelError(rcPtr->chan, resObj);
1789 errorNum = EINVAL;
1790 } else {
1791 errorNum = EOK;
1792 }
1793
1794 Tcl_DecrRefCount(blockObj);
1795 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
1796
1797 Tcl_Release(rcPtr);
1798 return errorNum;
1799 }
1800
1801 #if TCL_THREADS
1802 /*
1803 *----------------------------------------------------------------------
1804 *
1805 * ReflectThread --
1806 *
1807 * This function is invoked to tell the channel about thread movements.
1808 *
1809 * Results:
1810 * None.
1811 *
1812 * Side effects:
1813 * Allocates memory. Arbitrary, as it calls upon a script.
1814 *
1815 *----------------------------------------------------------------------
1816 */
1817
1818 static void
ReflectThread(ClientData clientData,int action)1819 ReflectThread(
1820 ClientData clientData,
1821 int action)
1822 {
1823 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1824
1825 switch (action) {
1826 case TCL_CHANNEL_THREAD_INSERT:
1827 rcPtr->owner = Tcl_GetCurrentThread();
1828 break;
1829 case TCL_CHANNEL_THREAD_REMOVE:
1830 rcPtr->owner = NULL;
1831 break;
1832 default:
1833 Tcl_Panic("Unknown thread action code.");
1834 break;
1835 }
1836 }
1837
1838 #endif
1839 /*
1840 *----------------------------------------------------------------------
1841 *
1842 * ReflectSetOption --
1843 *
1844 * This function is invoked to configure a channel option.
1845 *
1846 * Results:
1847 * A standard Tcl result code.
1848 *
1849 * Side effects:
1850 * Arbitrary, as it calls upon a Tcl script.
1851 *
1852 *----------------------------------------------------------------------
1853 */
1854
1855 static int
ReflectSetOption(ClientData clientData,Tcl_Interp * interp,const char * optionName,const char * newValue)1856 ReflectSetOption(
1857 ClientData clientData, /* Channel to query */
1858 Tcl_Interp *interp, /* Interpreter to leave error messages in */
1859 const char *optionName, /* Name of requested option */
1860 const char *newValue) /* The new value */
1861 {
1862 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1863 Tcl_Obj *optionObj, *valueObj;
1864 int result; /* Result code for 'configure' */
1865 Tcl_Obj *resObj; /* Result data for 'configure' */
1866
1867 /*
1868 * Are we in the correct thread?
1869 */
1870
1871 #if TCL_THREADS
1872 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1873 ForwardParam p;
1874
1875 p.setOpt.name = optionName;
1876 p.setOpt.value = newValue;
1877
1878 ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
1879
1880 if (p.base.code != TCL_OK) {
1881 Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
1882
1883 UnmarshallErrorResult(interp, err);
1884 Tcl_DecrRefCount(err);
1885 FreeReceivedError(&p);
1886 }
1887
1888 return p.base.code;
1889 }
1890 #endif
1891 Tcl_Preserve(rcPtr);
1892
1893 optionObj = Tcl_NewStringObj(optionName, -1);
1894 valueObj = Tcl_NewStringObj(newValue, -1);
1895
1896 Tcl_IncrRefCount(optionObj);
1897 Tcl_IncrRefCount(valueObj);
1898
1899 result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
1900 if (result != TCL_OK) {
1901 UnmarshallErrorResult(interp, resObj);
1902 }
1903
1904 Tcl_DecrRefCount(optionObj);
1905 Tcl_DecrRefCount(valueObj);
1906 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
1907 Tcl_Release(rcPtr);
1908 return result;
1909 }
1910
1911 /*
1912 *----------------------------------------------------------------------
1913 *
1914 * ReflectGetOption --
1915 *
1916 * This function is invoked to retrieve all or a channel option.
1917 *
1918 * Results:
1919 * A standard Tcl result code.
1920 *
1921 * Side effects:
1922 * Arbitrary, as it calls upon a Tcl script.
1923 *
1924 *----------------------------------------------------------------------
1925 */
1926
1927 static int
ReflectGetOption(ClientData clientData,Tcl_Interp * interp,const char * optionName,Tcl_DString * dsPtr)1928 ReflectGetOption(
1929 ClientData clientData, /* Channel to query */
1930 Tcl_Interp *interp, /* Interpreter to leave error messages in */
1931 const char *optionName, /* Name of reuqested option */
1932 Tcl_DString *dsPtr) /* String to place the result into */
1933 {
1934 /*
1935 * This code is special. It has regular passing of Tcl result, and errors.
1936 * The bypass functions are not required.
1937 */
1938
1939 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
1940 Tcl_Obj *optionObj;
1941 Tcl_Obj *resObj; /* Result data for 'configure' */
1942 int listc, result = TCL_OK;
1943 Tcl_Obj **listv;
1944 MethodName method;
1945
1946 /*
1947 * Are we in the correct thread?
1948 */
1949
1950 #if TCL_THREADS
1951 if (rcPtr->thread != Tcl_GetCurrentThread()) {
1952 ForwardedOperation opcode;
1953 ForwardParam p;
1954
1955 p.getOpt.name = optionName;
1956 p.getOpt.value = dsPtr;
1957
1958 if (optionName == NULL) {
1959 opcode = ForwardedGetOptAll;
1960 } else {
1961 opcode = ForwardedGetOpt;
1962 }
1963
1964 ForwardOpToHandlerThread(rcPtr, opcode, &p);
1965
1966 if (p.base.code != TCL_OK) {
1967 Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
1968
1969 UnmarshallErrorResult(interp, err);
1970 Tcl_DecrRefCount(err);
1971 FreeReceivedError(&p);
1972 }
1973
1974 return p.base.code;
1975 }
1976 #endif
1977
1978 if (optionName == NULL) {
1979 /*
1980 * Retrieve all options.
1981 */
1982
1983 method = METH_CGETALL;
1984 optionObj = NULL;
1985 } else {
1986 /*
1987 * Retrieve the value of one option.
1988 */
1989
1990 method = METH_CGET;
1991 optionObj = Tcl_NewStringObj(optionName, -1);
1992 Tcl_IncrRefCount(optionObj);
1993 }
1994
1995 Tcl_Preserve(rcPtr);
1996
1997 if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
1998 UnmarshallErrorResult(interp, resObj);
1999 goto error;
2000 }
2001
2002 /*
2003 * The result has to go into the 'dsPtr' for propagation to the caller of
2004 * the driver.
2005 */
2006
2007 if (optionObj != NULL) {
2008 TclDStringAppendObj(dsPtr, resObj);
2009 goto ok;
2010 }
2011
2012 /*
2013 * Extract the list and append each item as element.
2014 */
2015
2016 /*
2017 * NOTE (4): If we extract the string rep we can assume a properly quoted
2018 * string. Together with a separating space this way of simply appending
2019 * the whole string rep might be faster. It also doesn't check if the
2020 * result is a valid list. Nor that the list has an even number elements.
2021 */
2022
2023 if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
2024 goto error;
2025 }
2026
2027 if ((listc % 2) == 1) {
2028 /*
2029 * Odd number of elements is wrong.
2030 */
2031
2032 Tcl_ResetResult(interp);
2033 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2034 "Expected list with even number of "
2035 "elements, got %d element%s instead", listc,
2036 (listc == 1 ? "" : "s")));
2037 goto error;
2038 } else {
2039 int len;
2040 const char *str = TclGetStringFromObj(resObj, &len);
2041
2042 if (len) {
2043 TclDStringAppendLiteral(dsPtr, " ");
2044 Tcl_DStringAppend(dsPtr, str, len);
2045 }
2046 goto ok;
2047 }
2048
2049 ok:
2050 result = TCL_OK;
2051 stop:
2052 if (optionObj) {
2053 Tcl_DecrRefCount(optionObj);
2054 }
2055 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
2056 Tcl_Release(rcPtr);
2057 return result;
2058 error:
2059 result = TCL_ERROR;
2060 goto stop;
2061 }
2062
2063 /*
2064 *----------------------------------------------------------------------
2065 *
2066 * ReflectTruncate --
2067 *
2068 * This function is invoked to truncate a channel's file size.
2069 *
2070 * Results:
2071 * A standard Tcl result code.
2072 *
2073 * Side effects:
2074 * Arbitrary, as it calls upon a Tcl script.
2075 *
2076 *----------------------------------------------------------------------
2077 */
2078
2079 static int
ReflectTruncate(ClientData clientData,long long length)2080 ReflectTruncate(
2081 ClientData clientData, /* Channel to query */
2082 long long length) /* Length to truncate to. */
2083 {
2084 ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
2085 Tcl_Obj *lenObj;
2086 int errorNum; /* EINVAL or EOK (success). */
2087 Tcl_Obj *resObj; /* Result for 'truncate' */
2088
2089 /*
2090 * Are we in the correct thread?
2091 */
2092
2093 #ifdef TCL_THREADS
2094 if (rcPtr->thread != Tcl_GetCurrentThread()) {
2095 ForwardParam p;
2096
2097 p.truncate.length = length;
2098
2099 ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
2100
2101 if (p.base.code != TCL_OK) {
2102 PassReceivedError(rcPtr->chan, &p);
2103 return EINVAL;
2104 }
2105
2106 return EOK;
2107 }
2108 #endif
2109
2110 /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
2111
2112 Tcl_Preserve(rcPtr);
2113
2114 lenObj = Tcl_NewIntObj(length);
2115 Tcl_IncrRefCount(lenObj);
2116
2117 if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
2118 Tcl_SetChannelError(rcPtr->chan, resObj);
2119 errorNum = EINVAL;
2120 } else {
2121 errorNum = EOK;
2122 }
2123
2124 Tcl_DecrRefCount(lenObj);
2125 Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
2126 Tcl_Release(rcPtr);
2127 return errorNum;
2128 }
2129
2130 /*
2131 * Helpers. =========================================================
2132 */
2133
2134 /*
2135 *----------------------------------------------------------------------
2136 *
2137 * EncodeEventMask --
2138 *
2139 * This function takes a list of event items and constructs the
2140 * equivalent internal bitmask. The list must contain at least one
2141 * element. Elements are "read", "write", or any unique abbreviation of
2142 * them. Note that the bitmask is not changed if problems are
2143 * encountered.
2144 *
2145 * Results:
2146 * A standard Tcl error code. A bitmask where TCL_READABLE and/or
2147 * TCL_WRITABLE can be set.
2148 *
2149 * Side effects:
2150 * May shimmer 'obj' to a list representation. May place an error message
2151 * into the interp result.
2152 *
2153 *----------------------------------------------------------------------
2154 */
2155
2156 static int
EncodeEventMask(Tcl_Interp * interp,const char * objName,Tcl_Obj * obj,int * mask)2157 EncodeEventMask(
2158 Tcl_Interp *interp,
2159 const char *objName,
2160 Tcl_Obj *obj,
2161 int *mask)
2162 {
2163 int events; /* Mask of events to post */
2164 int listc; /* #elements in eventspec list */
2165 Tcl_Obj **listv; /* Elements of eventspec list */
2166 int evIndex; /* Id of event for an element of the eventspec
2167 * list. */
2168
2169 if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
2170 return TCL_ERROR;
2171 }
2172
2173 if (listc < 1) {
2174 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2175 "bad %s list: is empty", objName));
2176 return TCL_ERROR;
2177 }
2178
2179 events = 0;
2180 while (listc > 0) {
2181 if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
2182 objName, 0, &evIndex) != TCL_OK) {
2183 return TCL_ERROR;
2184 }
2185 switch (evIndex) {
2186 case EVENT_READ:
2187 events |= TCL_READABLE;
2188 break;
2189 case EVENT_WRITE:
2190 events |= TCL_WRITABLE;
2191 break;
2192 }
2193 listc --;
2194 }
2195
2196 *mask = events;
2197 return TCL_OK;
2198 }
2199
2200 /*
2201 *----------------------------------------------------------------------
2202 *
2203 * DecodeEventMask --
2204 *
2205 * This function takes an internal bitmask of events and constructs the
2206 * equivalent list of event items.
2207 *
2208 * Results, Contract:
2209 * A Tcl_Obj reference. The object will have a refCount of one. The user
2210 * has to decrement it to release the object.
2211 *
2212 * Side effects:
2213 * None.
2214 *
2215 *----------------------------------------------------------------------
2216 */
2217
2218 static Tcl_Obj *
DecodeEventMask(int mask)2219 DecodeEventMask(
2220 int mask)
2221 {
2222 const char *eventStr;
2223 Tcl_Obj *evObj;
2224
2225 switch (mask & RANDW) {
2226 case RANDW:
2227 eventStr = "read write";
2228 break;
2229 case TCL_READABLE:
2230 eventStr = "read";
2231 break;
2232 case TCL_WRITABLE:
2233 eventStr = "write";
2234 break;
2235 default:
2236 eventStr = "";
2237 break;
2238 }
2239
2240 evObj = Tcl_NewStringObj(eventStr, -1);
2241 Tcl_IncrRefCount(evObj);
2242 /* assert evObj.refCount == 1 */
2243 return evObj;
2244 }
2245
2246 /*
2247 *----------------------------------------------------------------------
2248 *
2249 * NewReflectedChannel --
2250 *
2251 * This function is invoked to allocate and initialize the instance data
2252 * of a new reflected channel.
2253 *
2254 * Results:
2255 * A heap-allocated channel instance.
2256 *
2257 * Side effects:
2258 * Allocates memory.
2259 *
2260 *----------------------------------------------------------------------
2261 */
2262
2263 static ReflectedChannel *
NewReflectedChannel(Tcl_Interp * interp,Tcl_Obj * cmdpfxObj,int mode,Tcl_Obj * handleObj)2264 NewReflectedChannel(
2265 Tcl_Interp *interp,
2266 Tcl_Obj *cmdpfxObj,
2267 int mode,
2268 Tcl_Obj *handleObj)
2269 {
2270 ReflectedChannel *rcPtr;
2271 int mn = 0;
2272
2273 rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel));
2274
2275 /* rcPtr->chan: Assigned by caller. Dummy data here. */
2276
2277 rcPtr->chan = NULL;
2278 rcPtr->interp = interp;
2279 rcPtr->dead = 0;
2280 rcPtr->readTimer = 0;
2281 rcPtr->writeTimer = 0;
2282 #if TCL_THREADS
2283 rcPtr->thread = Tcl_GetCurrentThread();
2284 #endif
2285 rcPtr->mode = mode;
2286 rcPtr->interest = 0; /* Initially no interest registered */
2287
2288 /* ASSERT: cmdpfxObj is a Tcl List */
2289 rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
2290 Tcl_IncrRefCount(rcPtr->cmd);
2291 rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
2292 while (mn <= (int)METH_WRITE) {
2293 Tcl_ListObjAppendElement(NULL, rcPtr->methods,
2294 Tcl_NewStringObj(methodNames[mn++], -1));
2295 }
2296 Tcl_IncrRefCount(rcPtr->methods);
2297 rcPtr->name = handleObj;
2298 Tcl_IncrRefCount(rcPtr->name);
2299 return rcPtr;
2300 }
2301
2302 /*
2303 *----------------------------------------------------------------------
2304 *
2305 * NextHandle --
2306 *
2307 * This function is invoked to generate a channel handle for a new
2308 * reflected channel.
2309 *
2310 * Results:
2311 * A Tcl_Obj containing the string of the new channel handle. The
2312 * refcount of the returned object is -- zero --.
2313 *
2314 * Side effects:
2315 * May allocate memory. Mutex protected critical section locks out other
2316 * threads for a short time.
2317 *
2318 *----------------------------------------------------------------------
2319 */
2320
2321 static Tcl_Obj *
NextHandle(void)2322 NextHandle(void)
2323 {
2324 /*
2325 * Count number of generated reflected channels. Used for id generation.
2326 * Ids are never reclaimed and there is no dealing with wrap around. On
2327 * the other hand, "unsigned long" should be big enough except for
2328 * absolute longrunners (generate a 100 ids per second => overflow will
2329 * occur in 1 1/3 years).
2330 */
2331
2332 TCL_DECLARE_MUTEX(rcCounterMutex)
2333 static unsigned long rcCounter = 0;
2334 Tcl_Obj *resObj;
2335
2336 Tcl_MutexLock(&rcCounterMutex);
2337 resObj = Tcl_ObjPrintf("rc%lu", rcCounter);
2338 rcCounter++;
2339 Tcl_MutexUnlock(&rcCounterMutex);
2340
2341 return resObj;
2342 }
2343
2344 static void
FreeReflectedChannel(ReflectedChannel * rcPtr)2345 FreeReflectedChannel(
2346 ReflectedChannel *rcPtr)
2347 {
2348 Channel *chanPtr = (Channel *) rcPtr->chan;
2349
2350 TclChannelRelease((Tcl_Channel)chanPtr);
2351 if (rcPtr->name) {
2352 Tcl_DecrRefCount(rcPtr->name);
2353 }
2354 if (rcPtr->methods) {
2355 Tcl_DecrRefCount(rcPtr->methods);
2356 }
2357 if (rcPtr->cmd) {
2358 Tcl_DecrRefCount(rcPtr->cmd);
2359 }
2360 ckfree(rcPtr);
2361 }
2362
2363 /*
2364 *----------------------------------------------------------------------
2365 *
2366 * InvokeTclMethod --
2367 *
2368 * This function is used to invoke the Tcl level of a reflected channel.
2369 * It handles all the command assembly, invokation, and generic state and
2370 * result mgmt. It does *not* handle thread redirection; that is the
2371 * responsibility of clients of this function.
2372 *
2373 * Results:
2374 * Result code and data as returned by the method.
2375 *
2376 * Side effects:
2377 * Arbitrary, as it calls upon a Tcl script.
2378 *
2379 * Contract:
2380 * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
2381 * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
2382 * resObj.refCount in {0, 1, ...}
2383 *
2384 *----------------------------------------------------------------------
2385 */
2386
2387 static int
InvokeTclMethod(ReflectedChannel * rcPtr,MethodName method,Tcl_Obj * argOneObj,Tcl_Obj * argTwoObj,Tcl_Obj ** resultObjPtr)2388 InvokeTclMethod(
2389 ReflectedChannel *rcPtr,
2390 MethodName method,
2391 Tcl_Obj *argOneObj, /* NULL'able */
2392 Tcl_Obj *argTwoObj, /* NULL'able */
2393 Tcl_Obj **resultObjPtr) /* NULL'able */
2394 {
2395 Tcl_Obj *methObj = NULL; /* Method name in object form */
2396 Tcl_InterpState sr; /* State of handler interp */
2397 int result; /* Result code of method invokation */
2398 Tcl_Obj *resObj = NULL; /* Result of method invokation. */
2399 Tcl_Obj *cmd;
2400
2401 if (rcPtr->dead) {
2402 /*
2403 * The channel is marked as dead. Bail out immediately, with an
2404 * appropriate error.
2405 */
2406
2407 if (resultObjPtr != NULL) {
2408 resObj = Tcl_NewStringObj(msg_dstlost,-1);
2409 *resultObjPtr = resObj;
2410 Tcl_IncrRefCount(resObj);
2411 }
2412
2413 /*
2414 * Not touching argOneObj, argTwoObj, they have not been used.
2415 * See the contract as well.
2416 */
2417
2418 return TCL_ERROR;
2419 }
2420
2421 /*
2422 * Insert method into the callback command, after the command prefix,
2423 * before the channel id.
2424 */
2425
2426 cmd = TclListObjCopy(NULL, rcPtr->cmd);
2427
2428 Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
2429 Tcl_ListObjAppendElement(NULL, cmd, methObj);
2430 Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
2431
2432 /*
2433 * Append the additional argument containing method specific details
2434 * behind the channel id. If specified.
2435 *
2436 * Because of the contract there is no need to increment the refcounts.
2437 * The objects will survive the Tcl_EvalObjv without change.
2438 */
2439
2440 if (argOneObj) {
2441 Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
2442 if (argTwoObj) {
2443 Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
2444 }
2445 }
2446
2447 /*
2448 * And run the handler... This is done in auch a manner which leaves any
2449 * existing state intact.
2450 */
2451
2452 Tcl_IncrRefCount(cmd);
2453 sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
2454 Tcl_Preserve(rcPtr->interp);
2455 result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
2456
2457 /*
2458 * We do not try to extract the result information if the caller has no
2459 * interest in it. I.e. there is no need to put effort into creating
2460 * something which is discarded immediately after.
2461 */
2462
2463 if (resultObjPtr) {
2464 if (result == TCL_OK) {
2465 /*
2466 * Ok result taken as is, also if the caller requests that there
2467 * is no capture.
2468 */
2469
2470 resObj = Tcl_GetObjResult(rcPtr->interp);
2471 } else {
2472 /*
2473 * Non-ok result is always treated as an error. We have to capture
2474 * the full state of the result, including additional options.
2475 *
2476 * This is complex and ugly, and would be completely unnecessary
2477 * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
2478 */
2479
2480 if (result != TCL_ERROR) {
2481 int cmdLen;
2482 const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
2483
2484 Tcl_IncrRefCount(cmd);
2485 Tcl_ResetResult(rcPtr->interp);
2486 Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
2487 "chan handler returned bad code: %d", result));
2488 Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
2489 cmdLen);
2490 Tcl_DecrRefCount(cmd);
2491 result = TCL_ERROR;
2492 }
2493 Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
2494 "\n (chan handler subcommand \"%s\")",
2495 methodNames[method]));
2496 resObj = MarshallError(rcPtr->interp);
2497 }
2498 Tcl_IncrRefCount(resObj);
2499 }
2500 Tcl_DecrRefCount(cmd);
2501 Tcl_RestoreInterpState(rcPtr->interp, sr);
2502 Tcl_Release(rcPtr->interp);
2503
2504 /*
2505 * The resObj has a ref count of 1 at this location. This means that the
2506 * caller of InvokeTclMethod has to dispose of it (but only if it was
2507 * returned to it).
2508 */
2509
2510 if (resultObjPtr != NULL) {
2511 *resultObjPtr = resObj;
2512 }
2513
2514 /*
2515 * There no need to handle the case where nothing is returned, because for
2516 * that case resObj was not set anyway.
2517 */
2518
2519 return result;
2520 }
2521
2522 /*
2523 *----------------------------------------------------------------------
2524 *
2525 * ErrnoReturn --
2526 *
2527 * Checks a method error result if it returned an 'errno'.
2528 *
2529 * Results:
2530 * The negative errno found in the error result, or 0.
2531 *
2532 * Side effects:
2533 * None.
2534 *
2535 * Users:
2536 * ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized
2537 * short reads/writes.
2538 *
2539 *----------------------------------------------------------------------
2540 */
2541
2542 static int
ErrnoReturn(ReflectedChannel * rcPtr,Tcl_Obj * resObj)2543 ErrnoReturn(
2544 ReflectedChannel *rcPtr,
2545 Tcl_Obj *resObj)
2546 {
2547 int code;
2548 Tcl_InterpState sr; /* State of handler interp */
2549
2550 if (rcPtr->dead) {
2551 return 0;
2552 }
2553
2554 sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
2555 UnmarshallErrorResult(rcPtr->interp, resObj);
2556
2557 resObj = Tcl_GetObjResult(rcPtr->interp);
2558
2559 if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
2560 || (code >= 0))) {
2561 if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
2562 code = -EAGAIN;
2563 } else {
2564 code = 0;
2565 }
2566 }
2567
2568 Tcl_RestoreInterpState(rcPtr->interp, sr);
2569 return code;
2570 }
2571
2572 /*
2573 *----------------------------------------------------------------------
2574 *
2575 * GetReflectedChannelMap --
2576 *
2577 * Gets and potentially initializes the reflected channel map for an
2578 * interpreter.
2579 *
2580 * Results:
2581 * A pointer to the map created, for use by the caller.
2582 *
2583 * Side effects:
2584 * Initializes the reflected channel map for an interpreter.
2585 *
2586 *----------------------------------------------------------------------
2587 */
2588
2589 static ReflectedChannelMap *
GetReflectedChannelMap(Tcl_Interp * interp)2590 GetReflectedChannelMap(
2591 Tcl_Interp *interp)
2592 {
2593 ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);
2594
2595 if (rcmPtr == NULL) {
2596 rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
2597 Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
2598 Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr);
2599 }
2600 return rcmPtr;
2601 }
2602
2603 /*
2604 *----------------------------------------------------------------------
2605 *
2606 * DeleteReflectedChannelMap --
2607 *
2608 * Deletes the channel table for an interpreter, closing any open
2609 * channels whose refcount reaches zero. This procedure is invoked when
2610 * an interpreter is deleted, via the AssocData cleanup mechanism.
2611 *
2612 * Results:
2613 * None.
2614 *
2615 * Side effects:
2616 * Deletes the hash table of channels. May close channels. May flush
2617 * output on closed channels. Removes any channeEvent handlers that were
2618 * registered in this interpreter.
2619 *
2620 *----------------------------------------------------------------------
2621 */
2622
2623 static void
MarkDead(ReflectedChannel * rcPtr)2624 MarkDead(
2625 ReflectedChannel *rcPtr)
2626 {
2627 if (rcPtr->dead) {
2628 return;
2629 }
2630 if (rcPtr->name) {
2631 Tcl_DecrRefCount(rcPtr->name);
2632 rcPtr->name = NULL;
2633 }
2634 if (rcPtr->methods) {
2635 Tcl_DecrRefCount(rcPtr->methods);
2636 rcPtr->methods = NULL;
2637 }
2638 if (rcPtr->cmd) {
2639 Tcl_DecrRefCount(rcPtr->cmd);
2640 rcPtr->cmd = NULL;
2641 }
2642 rcPtr->dead = 1;
2643 }
2644
2645 static void
DeleteReflectedChannelMap(ClientData clientData,Tcl_Interp * interp)2646 DeleteReflectedChannelMap(
2647 ClientData clientData, /* The per-interpreter data structure. */
2648 Tcl_Interp *interp) /* The interpreter being deleted. */
2649 {
2650 ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
2651 /* The map */
2652 Tcl_HashSearch hSearch; /* Search variable. */
2653 Tcl_HashEntry *hPtr; /* Search variable. */
2654 ReflectedChannel *rcPtr;
2655 Tcl_Channel chan;
2656 #if TCL_THREADS
2657 ForwardingResult *resultPtr;
2658 ForwardingEvent *evPtr;
2659 ForwardParam *paramPtr;
2660 #endif
2661
2662 /*
2663 * Delete all entries. The channels may have been closed already, or will
2664 * be closed later, by the standard IO finalization of an interpreter
2665 * under destruction. Except for the channels which were moved to a
2666 * different interpreter and/or thread. They do not exist from the IO
2667 * systems point of view and will not get closed. Therefore mark all as
2668 * dead so that any future access will cause a proper error. For channels
2669 * in a different thread we actually do the same as
2670 * DeleteThreadReflectedChannelMap(), just restricted to the channels of
2671 * this interp.
2672 */
2673
2674 for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
2675 hPtr != NULL;
2676 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
2677 chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
2678 rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
2679
2680 MarkDead(rcPtr);
2681 Tcl_DeleteHashEntry(hPtr);
2682 }
2683 Tcl_DeleteHashTable(&rcmPtr->map);
2684 ckfree(&rcmPtr->map);
2685
2686 #if TCL_THREADS
2687 /*
2688 * The origin interpreter for one or more reflected channels is gone.
2689 */
2690
2691 /*
2692 * Go through the list of pending results and cancel all whose events were
2693 * destined for this interpreter. While this is in progress we block any
2694 * other access to the list of pending results.
2695 */
2696
2697 Tcl_MutexLock(&rcForwardMutex);
2698
2699 for (resultPtr = forwardList;
2700 resultPtr != NULL;
2701 resultPtr = resultPtr->nextPtr) {
2702 if (resultPtr->dsti != interp) {
2703 /*
2704 * Ignore results/events for other interpreters.
2705 */
2706
2707 continue;
2708 }
2709
2710 /*
2711 * The receiver for the event exited, before processing the event. We
2712 * detach the result now, wake the originator up and signal failure.
2713 *
2714 * Attention: Results may have been detached already, by either the
2715 * receiver, or this thread, as part of other parts in the thread
2716 * teardown. Such results are ignored. See ticket [b47b176adf] for the
2717 * identical race condition in Tcl 8.6 IORTrans.
2718 */
2719
2720 evPtr = resultPtr->evPtr;
2721
2722 /*
2723 * Basic crash safety until this routine can get revised [3411310]
2724 */
2725
2726 if (evPtr == NULL) {
2727 continue;
2728 }
2729 paramPtr = evPtr->param;
2730 if (!evPtr) {
2731 continue;
2732 }
2733
2734 evPtr->resultPtr = NULL;
2735 resultPtr->evPtr = NULL;
2736 resultPtr->result = TCL_ERROR;
2737
2738 ForwardSetStaticError(paramPtr, msg_send_dstlost);
2739
2740 Tcl_ConditionNotify(&resultPtr->done);
2741 }
2742 Tcl_MutexUnlock(&rcForwardMutex);
2743
2744 /*
2745 * Get the map of all channels handled by the current thread. This is a
2746 * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
2747 * through the channels and remove all which were handled by this
2748 * interpreter. They have already been marked as dead.
2749 */
2750
2751 rcmPtr = GetThreadReflectedChannelMap();
2752 for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
2753 hPtr != NULL;
2754 hPtr = Tcl_NextHashEntry(&hSearch)) {
2755 chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
2756 rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
2757
2758 if (rcPtr->interp != interp) {
2759 /*
2760 * Ignore entries for other interpreters.
2761 */
2762
2763 continue;
2764 }
2765
2766 MarkDead(rcPtr);
2767 Tcl_DeleteHashEntry(hPtr);
2768 }
2769 #endif
2770 }
2771
2772 #if TCL_THREADS
2773 /*
2774 *----------------------------------------------------------------------
2775 *
2776 * GetThreadReflectedChannelMap --
2777 *
2778 * Gets and potentially initializes the reflected channel map for a
2779 * thread.
2780 *
2781 * Results:
2782 * A pointer to the map created, for use by the caller.
2783 *
2784 * Side effects:
2785 * Initializes the reflected channel map for a thread.
2786 *
2787 *----------------------------------------------------------------------
2788 */
2789
2790 static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)2791 GetThreadReflectedChannelMap(void)
2792 {
2793 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2794
2795 if (!tsdPtr->rcmPtr) {
2796 tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
2797 Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
2798 Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
2799 }
2800
2801 return tsdPtr->rcmPtr;
2802 }
2803
2804 /*
2805 *----------------------------------------------------------------------
2806 *
2807 * DeleteThreadReflectedChannelMap --
2808 *
2809 * Deletes the channel table for a thread. This procedure is invoked when
2810 * a thread is deleted. The channels have already been marked as dead, in
2811 * DeleteReflectedChannelMap().
2812 *
2813 * Results:
2814 * None.
2815 *
2816 * Side effects:
2817 * Deletes the hash table of channels.
2818 *
2819 *----------------------------------------------------------------------
2820 */
2821
2822 static void
DeleteThreadReflectedChannelMap(TCL_UNUSED (ClientData))2823 DeleteThreadReflectedChannelMap(
2824 TCL_UNUSED(ClientData))
2825 {
2826 Tcl_HashSearch hSearch; /* Search variable. */
2827 Tcl_HashEntry *hPtr; /* Search variable. */
2828 Tcl_ThreadId self = Tcl_GetCurrentThread();
2829 ReflectedChannelMap *rcmPtr; /* The map */
2830 ForwardingResult *resultPtr;
2831
2832 /*
2833 * The origin thread for one or more reflected channels is gone.
2834 * NOTE: If this function is called due to a thread getting killed the
2835 * per-interp DeleteReflectedChannelMap is apparently not called.
2836 */
2837
2838 /*
2839 * Go through the list of pending results and cancel all whose events were
2840 * destined for this thread. While this is in progress we block any other
2841 * access to the list of pending results.
2842 */
2843
2844 Tcl_MutexLock(&rcForwardMutex);
2845
2846 for (resultPtr = forwardList;
2847 resultPtr != NULL;
2848 resultPtr = resultPtr->nextPtr) {
2849 ForwardingEvent *evPtr;
2850 ForwardParam *paramPtr;
2851
2852 if (resultPtr->dst != self) {
2853 /*
2854 * Ignore results/events for other threads.
2855 */
2856
2857 continue;
2858 }
2859
2860 /*
2861 * The receiver for the event exited, before processing the event. We
2862 * detach the result now, wake the originator up and signal failure.
2863 *
2864 * Attention: Results may have been detached already, by either the
2865 * receiver, or this thread, as part of other parts in the thread
2866 * teardown. Such results are ignored. See ticket [b47b176adf] for the
2867 * identical race condition in Tcl 8.6 IORTrans.
2868 */
2869
2870 evPtr = resultPtr->evPtr;
2871
2872 /*
2873 * Basic crash safety until this routine can get revised [3411310]
2874 */
2875
2876 if (evPtr == NULL ) {
2877 continue;
2878 }
2879 paramPtr = evPtr->param;
2880 if (!evPtr) {
2881 continue;
2882 }
2883
2884 evPtr->resultPtr = NULL;
2885 resultPtr->evPtr = NULL;
2886 resultPtr->result = TCL_ERROR;
2887
2888 ForwardSetStaticError(paramPtr, msg_send_dstlost);
2889
2890 Tcl_ConditionNotify(&resultPtr->done);
2891 }
2892 Tcl_MutexUnlock(&rcForwardMutex);
2893
2894 /*
2895 * Run over the event queue of this thread and remove all ReflectEvent's
2896 * still pending. These are inbound events for reflected channels this
2897 * thread owns but doesn't handle. The inverse of the channel map
2898 * actually.
2899 */
2900
2901 Tcl_DeleteEvents(ReflectEventDelete, NULL);
2902
2903 /*
2904 * Get the map of all channels handled by the current thread. This is a
2905 * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
2906 * through the channels, remove all, mark them as dead.
2907 */
2908
2909 rcmPtr = GetThreadReflectedChannelMap();
2910 for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
2911 hPtr != NULL;
2912 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
2913 Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
2914 ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
2915
2916 MarkDead(rcPtr);
2917 Tcl_DeleteHashEntry(hPtr);
2918 }
2919 ckfree(rcmPtr);
2920 }
2921
2922 static void
ForwardOpToHandlerThread(ReflectedChannel * rcPtr,ForwardedOperation op,const void * param)2923 ForwardOpToHandlerThread(
2924 ReflectedChannel *rcPtr, /* Channel instance */
2925 ForwardedOperation op, /* Forwarded driver operation */
2926 const void *param) /* Arguments */
2927 {
2928 /*
2929 * Core of the communication from OWNER to HANDLER thread. The receiver is
2930 * ForwardProc() below.
2931 */
2932
2933 Tcl_ThreadId dst = rcPtr->thread;
2934 ForwardingEvent *evPtr;
2935 ForwardingResult *resultPtr;
2936
2937 /*
2938 * We gather the lock early. This allows us to check the liveness of the
2939 * channel without interference from DeleteThreadReflectedChannelMap().
2940 */
2941
2942 Tcl_MutexLock(&rcForwardMutex);
2943
2944 if (rcPtr->dead) {
2945 /*
2946 * The channel is marked as dead. Bail out immediately, with an
2947 * appropriate error. Do not forget to unlock the mutex on this path.
2948 */
2949
2950 ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
2951 Tcl_MutexUnlock(&rcForwardMutex);
2952 return;
2953 }
2954
2955 /*
2956 * Create and initialize the event and data structures.
2957 */
2958
2959 evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
2960 resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));
2961
2962 evPtr->event.proc = ForwardProc;
2963 evPtr->resultPtr = resultPtr;
2964 evPtr->op = op;
2965 evPtr->rcPtr = rcPtr;
2966 evPtr->param = (ForwardParam *) param;
2967
2968 resultPtr->src = Tcl_GetCurrentThread();
2969 resultPtr->dst = dst;
2970 resultPtr->dsti = rcPtr->interp;
2971 resultPtr->done = NULL;
2972 resultPtr->result = -1;
2973 resultPtr->evPtr = evPtr;
2974
2975 /*
2976 * Now execute the forward.
2977 */
2978
2979 TclSpliceIn(resultPtr, forwardList);
2980
2981 /*
2982 * Do not unlock here. That is done by the ConditionWait.
2983 */
2984
2985 /*
2986 * Ensure cleanup of the event if the origin thread exits while this event
2987 * is pending or in progress. Exit of the destination thread is handled by
2988 * DeleteThreadReflectedChannelMap(), this is set up by
2989 * GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
2990 * (see above) for.
2991 */
2992
2993 Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);
2994
2995 /*
2996 * Queue the event and poke the other thread's notifier.
2997 */
2998
2999 Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
3000 Tcl_ThreadAlert(dst);
3001
3002 /*
3003 * (*) Block until the handler thread has either processed the transfer or
3004 * rejected it.
3005 */
3006
3007 while (resultPtr->result < 0) {
3008 /*
3009 * NOTE (1): Is it possible that the current thread goes away while
3010 * waiting here? IOW Is it possible that "SrcExitProc" is called while
3011 * we are here? See complementary note (2) in "SrcExitProc"
3012 *
3013 * The ConditionWait unlocks the mutex during the wait and relocks it
3014 * immediately after.
3015 */
3016
3017 Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
3018 }
3019
3020 /*
3021 * Unlink result from the forwarder list. No need to lock. Either still
3022 * locked, or locked by the ConditionWait
3023 */
3024
3025 TclSpliceOut(resultPtr, forwardList);
3026
3027 resultPtr->nextPtr = NULL;
3028 resultPtr->prevPtr = NULL;
3029
3030 Tcl_MutexUnlock(&rcForwardMutex);
3031 Tcl_ConditionFinalize(&resultPtr->done);
3032
3033 /*
3034 * Kill the cleanup handler now, and the result structure as well, before
3035 * returning the success code.
3036 *
3037 * Note: The event structure has already been deleted.
3038 */
3039
3040 Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
3041
3042 ckfree(resultPtr);
3043 }
3044
3045 static int
ForwardProc(Tcl_Event * evGPtr,TCL_UNUSED (int))3046 ForwardProc(
3047 Tcl_Event *evGPtr,
3048 TCL_UNUSED(int) /* mask */)
3049 {
3050 /*
3051 * HANDLER thread.
3052
3053 * The receiver part for the operations coming from the OWNER thread.
3054 * See ForwardOpToHandlerThread() for the transmitter.
3055 *
3056 * Notes regarding access to the referenced data.
3057 *
3058 * In principle the data belongs to the originating thread (see
3059 * evPtr->src), however this thread is currently blocked at (*), i.e.,
3060 * quiescent. Because of this we can treat the data as belonging to us,
3061 * without fear of race conditions. I.e. we can read and write as we like.
3062 *
3063 * The only thing we cannot be sure of is the resultPtr. This can be be
3064 * NULLed if the originating thread went away while the event is handled
3065 * here now.
3066 */
3067
3068 ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
3069 ForwardingResult *resultPtr = evPtr->resultPtr;
3070 ReflectedChannel *rcPtr = evPtr->rcPtr;
3071 Tcl_Interp *interp = rcPtr->interp;
3072 ForwardParam *paramPtr = evPtr->param;
3073 Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
3074 ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
3075 * this interp. */
3076 Tcl_HashEntry *hPtr; /* Entry in the above map */
3077
3078 /*
3079 * Ignore the event if no one is waiting for its result anymore.
3080 */
3081
3082 if (!resultPtr) {
3083 return 1;
3084 }
3085
3086 paramPtr->base.code = TCL_OK;
3087 paramPtr->base.msgStr = NULL;
3088 paramPtr->base.mustFree = 0;
3089
3090 switch (evPtr->op) {
3091 /*
3092 * The destination thread for the following operations is
3093 * rcPtr->thread, which contains rcPtr->interp, the interp we have to
3094 * call upon for the driver.
3095 */
3096
3097 case ForwardedClose: {
3098 /*
3099 * No parameters/results.
3100 */
3101
3102 if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
3103 ForwardSetObjError(paramPtr, resObj);
3104 }
3105
3106 /*
3107 * Freeing is done here, in the origin thread, callback command
3108 * objects belong to this thread. Deallocating them in a different
3109 * thread is not allowed
3110 *
3111 * We remove the channel from both interpreter and thread maps before
3112 * releasing the memory, to prevent future accesses (like by
3113 * 'postevent') from finding and dereferencing a dangling pointer.
3114 */
3115
3116 rcmPtr = GetReflectedChannelMap(interp);
3117 hPtr = Tcl_FindHashEntry(&rcmPtr->map,
3118 Tcl_GetChannelName(rcPtr->chan));
3119 Tcl_DeleteHashEntry(hPtr);
3120
3121 rcmPtr = GetThreadReflectedChannelMap();
3122 hPtr = Tcl_FindHashEntry(&rcmPtr->map,
3123 Tcl_GetChannelName(rcPtr->chan));
3124 Tcl_DeleteHashEntry(hPtr);
3125 MarkDead(rcPtr);
3126 break;
3127 }
3128
3129 case ForwardedInput: {
3130 Tcl_Obj *toReadObj;
3131
3132 TclNewIntObj(toReadObj, paramPtr->input.toRead);
3133 Tcl_IncrRefCount(toReadObj);
3134
3135 Tcl_Preserve(rcPtr);
3136 if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
3137 int code = ErrnoReturn(rcPtr, resObj);
3138
3139 if (code < 0) {
3140 paramPtr->base.code = code;
3141 } else {
3142 ForwardSetObjError(paramPtr, resObj);
3143 }
3144 paramPtr->input.toRead = -1;
3145 } else {
3146 /*
3147 * Process a regular result.
3148 */
3149
3150 int bytec; /* Number of returned bytes */
3151 unsigned char *bytev; /* Array of returned bytes */
3152
3153 bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
3154
3155 if (paramPtr->input.toRead < bytec) {
3156 ForwardSetStaticError(paramPtr, msg_read_toomuch);
3157 paramPtr->input.toRead = -1;
3158 } else {
3159 if (bytec > 0) {
3160 memcpy(paramPtr->input.buf, bytev, bytec);
3161 }
3162 paramPtr->input.toRead = bytec;
3163 }
3164 }
3165 Tcl_Release(rcPtr);
3166 Tcl_DecrRefCount(toReadObj);
3167 break;
3168 }
3169
3170 case ForwardedOutput: {
3171 Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
3172 paramPtr->output.buf, paramPtr->output.toWrite);
3173 Tcl_IncrRefCount(bufObj);
3174
3175 Tcl_Preserve(rcPtr);
3176 if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
3177 int code = ErrnoReturn(rcPtr, resObj);
3178
3179 if (code < 0) {
3180 paramPtr->base.code = code;
3181 } else {
3182 ForwardSetObjError(paramPtr, resObj);
3183 }
3184 paramPtr->output.toWrite = -1;
3185 } else {
3186 /*
3187 * Process a regular result.
3188 */
3189
3190 int written;
3191
3192 if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
3193 Tcl_DecrRefCount(resObj);
3194 resObj = MarshallError(interp);
3195 ForwardSetObjError(paramPtr, resObj);
3196 paramPtr->output.toWrite = -1;
3197 } else if (written==0 || paramPtr->output.toWrite<written) {
3198 ForwardSetStaticError(paramPtr, msg_write_toomuch);
3199 paramPtr->output.toWrite = -1;
3200 } else {
3201 paramPtr->output.toWrite = written;
3202 }
3203 }
3204 Tcl_Release(rcPtr);
3205 Tcl_DecrRefCount(bufObj);
3206 break;
3207 }
3208
3209 case ForwardedSeek: {
3210 Tcl_Obj *offObj;
3211 Tcl_Obj *baseObj;
3212
3213 TclNewIntObj(offObj, paramPtr->seek.offset);
3214 baseObj = Tcl_NewStringObj(
3215 (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
3216 (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
3217
3218 Tcl_IncrRefCount(offObj);
3219 Tcl_IncrRefCount(baseObj);
3220
3221 Tcl_Preserve(rcPtr);
3222 if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
3223 ForwardSetObjError(paramPtr, resObj);
3224 paramPtr->seek.offset = -1;
3225 } else {
3226 /*
3227 * Process a regular result. If the type is wrong this may change
3228 * into an error.
3229 */
3230
3231 Tcl_WideInt newLoc;
3232
3233 if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
3234 if (newLoc < 0) {
3235 ForwardSetStaticError(paramPtr, msg_seek_beforestart);
3236 paramPtr->seek.offset = -1;
3237 } else {
3238 paramPtr->seek.offset = newLoc;
3239 }
3240 } else {
3241 Tcl_DecrRefCount(resObj);
3242 resObj = MarshallError(interp);
3243 ForwardSetObjError(paramPtr, resObj);
3244 paramPtr->seek.offset = -1;
3245 }
3246 }
3247 Tcl_Release(rcPtr);
3248 Tcl_DecrRefCount(offObj);
3249 Tcl_DecrRefCount(baseObj);
3250 break;
3251 }
3252
3253 case ForwardedWatch: {
3254 Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
3255 /* assert maskObj.refCount == 1 */
3256
3257 Tcl_Preserve(rcPtr);
3258 rcPtr->interest = paramPtr->watch.mask;
3259 (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
3260 Tcl_DecrRefCount(maskObj);
3261 Tcl_Release(rcPtr);
3262 break;
3263 }
3264
3265 case ForwardedBlock: {
3266 Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
3267
3268 Tcl_IncrRefCount(blockObj);
3269 Tcl_Preserve(rcPtr);
3270 if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
3271 &resObj) != TCL_OK) {
3272 ForwardSetObjError(paramPtr, resObj);
3273 }
3274 Tcl_Release(rcPtr);
3275 Tcl_DecrRefCount(blockObj);
3276 break;
3277 }
3278
3279 case ForwardedSetOpt: {
3280 Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
3281 Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
3282
3283 Tcl_IncrRefCount(optionObj);
3284 Tcl_IncrRefCount(valueObj);
3285 Tcl_Preserve(rcPtr);
3286 if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
3287 &resObj) != TCL_OK) {
3288 ForwardSetObjError(paramPtr, resObj);
3289 }
3290 Tcl_Release(rcPtr);
3291 Tcl_DecrRefCount(optionObj);
3292 Tcl_DecrRefCount(valueObj);
3293 break;
3294 }
3295
3296 case ForwardedGetOpt: {
3297 /*
3298 * Retrieve the value of one option.
3299 */
3300
3301 Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
3302
3303 Tcl_IncrRefCount(optionObj);
3304 Tcl_Preserve(rcPtr);
3305 if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
3306 ForwardSetObjError(paramPtr, resObj);
3307 } else {
3308 TclDStringAppendObj(paramPtr->getOpt.value, resObj);
3309 }
3310 Tcl_Release(rcPtr);
3311 Tcl_DecrRefCount(optionObj);
3312 break;
3313 }
3314
3315 case ForwardedGetOptAll:
3316 /*
3317 * Retrieve all options.
3318 */
3319
3320 Tcl_Preserve(rcPtr);
3321 if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
3322 ForwardSetObjError(paramPtr, resObj);
3323 } else {
3324 /*
3325 * Extract list, validate that it is a list, and #elements. See
3326 * NOTE (4) as well.
3327 */
3328
3329 int listc;
3330 Tcl_Obj **listv;
3331
3332 if (Tcl_ListObjGetElements(interp, resObj, &listc,
3333 &listv) != TCL_OK) {
3334 Tcl_DecrRefCount(resObj);
3335 resObj = MarshallError(interp);
3336 ForwardSetObjError(paramPtr, resObj);
3337 } else if ((listc % 2) == 1) {
3338 /*
3339 * Odd number of elements is wrong. [x].
3340 */
3341
3342 char *buf = (char *)ckalloc(200);
3343 sprintf(buf,
3344 "{Expected list with even number of elements, got %d %s instead}",
3345 listc, (listc == 1 ? "element" : "elements"));
3346
3347 ForwardSetDynamicError(paramPtr, buf);
3348 } else {
3349 int len;
3350 const char *str = TclGetStringFromObj(resObj, &len);
3351
3352 if (len) {
3353 TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
3354 Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
3355 }
3356 }
3357 }
3358 Tcl_Release(rcPtr);
3359 break;
3360
3361 case ForwardedTruncate: {
3362 Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length);
3363
3364 Tcl_IncrRefCount(lenObj);
3365 Tcl_Preserve(rcPtr);
3366 if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
3367 ForwardSetObjError(paramPtr, resObj);
3368 }
3369 Tcl_Release(rcPtr);
3370 Tcl_DecrRefCount(lenObj);
3371 break;
3372 }
3373
3374 default:
3375 /*
3376 * Bad operation code.
3377 */
3378
3379 Tcl_Panic("Bad operation code in ForwardProc");
3380 break;
3381 }
3382
3383 /*
3384 * Remove the reference we held on the result of the invoke, if we had
3385 * such.
3386 */
3387
3388 if (resObj != NULL) {
3389 Tcl_DecrRefCount(resObj);
3390 }
3391
3392 if (resultPtr) {
3393 /*
3394 * Report the forwarding result synchronously to the waiting caller.
3395 * This unblocks (*) as well. This is wrapped into a conditional
3396 * because the caller may have exited in the mean time.
3397 */
3398
3399 Tcl_MutexLock(&rcForwardMutex);
3400 resultPtr->result = TCL_OK;
3401 Tcl_ConditionNotify(&resultPtr->done);
3402 Tcl_MutexUnlock(&rcForwardMutex);
3403 }
3404
3405 return 1;
3406 }
3407
3408 static void
SrcExitProc(ClientData clientData)3409 SrcExitProc(
3410 ClientData clientData)
3411 {
3412 ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
3413 ForwardingResult *resultPtr;
3414 ForwardParam *paramPtr;
3415
3416 /*
3417 * NOTE (2): Can this handler be called with the originator blocked?
3418 */
3419
3420 /*
3421 * The originator for the event exited. It is not sure if this can happen,
3422 * as the originator should be blocked at (*) while the event is in
3423 * transit/pending.
3424 *
3425 * We make sure that the event cannot refer to the result anymore, remove
3426 * it from the list of pending results and free the structure. Locking the
3427 * access ensures that we cannot get in conflict with "ForwardProc",
3428 * should it already execute the event.
3429 */
3430
3431 Tcl_MutexLock(&rcForwardMutex);
3432
3433 resultPtr = evPtr->resultPtr;
3434 paramPtr = evPtr->param;
3435
3436 evPtr->resultPtr = NULL;
3437 resultPtr->evPtr = NULL;
3438 resultPtr->result = TCL_ERROR;
3439
3440 ForwardSetStaticError(paramPtr, msg_send_originlost);
3441
3442 /*
3443 * See below: TclSpliceOut(resultPtr, forwardList);
3444 */
3445
3446 Tcl_MutexUnlock(&rcForwardMutex);
3447
3448 /*
3449 * This unlocks (*). The structure will be spliced out and freed by
3450 * "ForwardProc". Maybe.
3451 */
3452
3453 Tcl_ConditionNotify(&resultPtr->done);
3454 }
3455
3456 static void
ForwardSetObjError(ForwardParam * paramPtr,Tcl_Obj * obj)3457 ForwardSetObjError(
3458 ForwardParam *paramPtr,
3459 Tcl_Obj *obj)
3460 {
3461 int len;
3462 const char *msgStr = TclGetStringFromObj(obj, &len);
3463
3464 len++;
3465 ForwardSetDynamicError(paramPtr, ckalloc(len));
3466 memcpy(paramPtr->base.msgStr, msgStr, len);
3467 }
3468 #endif
3469
3470 /*
3471 * Local Variables:
3472 * mode: c
3473 * c-basic-offset: 4
3474 * fill-column: 78
3475 * tab-width: 8
3476 * indent-tabs-mode: nil
3477 * End:
3478 */
3479