1/*
2 * reflect.c --
3 *
4 *	Implements and registers conversion channel relying on
5 *	tcl-scripts to do the conversion. In other words: The
6 *	transformation functionality is reflected up into the
7 *	tcl-level. In case of binary data this will be usable
8 *	only with tcl 8.0 and up.
9 *
10 *
11 * Copyright (c) 1995 Andreas Kupries (a.kupries@westend.com)
12 * All rights reserved.
13 *
14 * Permission is hereby granted, without written agreement and without
15 * license or royalty fees, to use, copy, modify, and distribute this
16 * software and its documentation for any purpose, provided that the
17 * above copyright notice and the following two paragraphs appear in
18 * all copies of this software.
19 *
20 * IN NO EVENT SHALL I LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
21 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
22 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
23 * POSSIBILITY OF SUCH DAMAGE.
24 *
25 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27 * PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
28 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
29 * ENHANCEMENTS, OR MODIFICATIONS.
30 *
31 * CVS: $Id: reflect.c,v 1.25 2009/05/07 04:57:27 andreas_kupries Exp $
32 */
33
34#include "reflect.h"
35
36/*
37 * Converter description
38 * ---------------------
39 */
40
41
42/*
43 * Declarations of internal procedures.
44 */
45
46static Trf_ControlBlock
47CreateEncoder  _ANSI_ARGS_ ((ClientData     writeClientData,
48			     Trf_WriteProc* fun,
49			     Trf_Options    optInfo,
50			     Tcl_Interp*    interp,
51			     ClientData     clientData));
52static void
53DeleteEncoder  _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
54			     ClientData       clientData));
55static int
56EncodeBuffer   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
57			     unsigned char*   buffer,
58			     int              bufLen,
59			     Tcl_Interp*      interp,
60			     ClientData       clientData));
61static int
62FlushEncoder   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
63			     Tcl_Interp*      interp,
64			     ClientData       clientData));
65static void
66ClearEncoder   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
67			     ClientData       clientData));
68
69static Trf_ControlBlock
70CreateDecoder  _ANSI_ARGS_ ((ClientData     writeClientData,
71			     Trf_WriteProc* fun,
72			     Trf_Options    optInfo,
73			     Tcl_Interp*    interp,
74			     ClientData     clientData));
75static void
76DeleteDecoder  _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
77			     ClientData       clientData));
78static int
79DecodeBuffer   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
80			     unsigned char*   buffer,
81			     int              bufLen,
82			     Tcl_Interp*      interp,
83			     ClientData       clientData));
84static int
85FlushDecoder   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
86			     Tcl_Interp*      interp,
87			     ClientData       clientData));
88static void
89ClearDecoder   _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
90			     ClientData       clientData));
91
92static int
93MaxRead        _ANSI_ARGS_ ((Trf_ControlBlock ctrlBlock,
94			     ClientData       clientData));
95
96/*
97 * Converter definition.
98 */
99
100static Trf_TypeDefinition reflectDefinition =
101{
102  "transform",
103  NULL, /* filled by TrfInit_Transform, THREAD: serialize initialization */
104  NULL, /* filled by TrfInit_Transform, THREAD: serialize initialization */
105  {
106    CreateEncoder,
107    DeleteEncoder,
108    NULL,
109    EncodeBuffer,
110    FlushEncoder,
111    ClearEncoder,
112    MaxRead
113  }, {
114    CreateDecoder,
115    DeleteDecoder,
116    NULL,
117    DecodeBuffer,
118    FlushDecoder,
119    ClearDecoder,
120    MaxRead
121  },
122  TRF_UNSEEKABLE
123};
124
125
126
127/*
128 *------------------------------------------------------*
129 *
130 *	TrfInit_Transform --
131 *
132 *	------------------------------------------------*
133 *	Register the conversion implemented in this file.
134 *	------------------------------------------------*
135 *
136 *	Sideeffects:
137 *		As of 'Trf_Register'.
138 *
139 *	Result:
140 *		A standard Tcl error code.
141 *
142 *------------------------------------------------------*
143 */
144
145int
146TrfInit_Transform (interp)
147Tcl_Interp* interp;
148{
149  TrfLock; /* THREADING: serialize initialization */
150  reflectDefinition.options = TrfTransformOptions ();
151  TrfUnlock;
152
153  return Trf_Register (interp, &reflectDefinition);
154}
155
156/*
157 *------------------------------------------------------*
158 *
159 *	CreateEncoder --
160 *
161 *	------------------------------------------------*
162 *	Allocate and initialize the control block of a
163 *	data encoder.
164 *	------------------------------------------------*
165 *
166 *	Sideeffects:
167 *		Allocates memory.
168 *
169 *	Result:
170 *		An opaque reference to the control block.
171 *
172 *------------------------------------------------------*
173 */
174
175static Trf_ControlBlock
176CreateEncoder (writeClientData, fun, optInfo, interp, clientData)
177ClientData     writeClientData;
178Trf_WriteProc* fun;
179Trf_Options    optInfo;
180Tcl_Interp*    interp;
181ClientData     clientData;
182{
183  ReflectControl*          c;
184  TrfTransformOptionBlock* o = (TrfTransformOptionBlock*) optInfo;
185  int                    res;
186
187  c = (ReflectControl*) ckalloc (sizeof (ReflectControl));
188  c->write           = fun;
189  c->writeClientData = writeClientData;
190  c->interp          = interp;
191
192  /* Store reference, tell the interpreter about it. */
193  c->command      = o->command;
194  Tcl_IncrRefCount (c->command);
195
196  c->maxRead = -1;
197  c->naturalRatio.numBytesTransform = 0;
198  c->naturalRatio.numBytesDown = 0;
199
200  res = RefExecuteCallback (c, interp,
201			    (unsigned char*) "create/write",
202			    NULL, 0, TRANSMIT_DONT, 0);
203
204  if (res != TCL_OK) {
205    Tcl_DecrRefCount (c->command);
206    ckfree ((VOID*) c);
207    return (ClientData) NULL;
208  }
209
210  return (ClientData) c;
211}
212
213/*
214 *------------------------------------------------------*
215 *
216 *	DeleteEncoder --
217 *
218 *	------------------------------------------------*
219 *	Destroy the control block of an encoder.
220 *	------------------------------------------------*
221 *
222 *	Sideeffects:
223 *		Releases the memory allocated by 'CreateEncoder'
224 *
225 *	Result:
226 *		None.
227 *
228 *------------------------------------------------------*
229 */
230
231static void
232DeleteEncoder (ctrlBlock, clientData)
233Trf_ControlBlock ctrlBlock;
234ClientData clientData;
235{
236  ReflectControl* c = (ReflectControl*) ctrlBlock;
237
238  RefExecuteCallback (c, NULL, (unsigned char*) "delete/write",
239		      NULL, 0, TRANSMIT_DONT, 0);
240
241  Tcl_DecrRefCount (c->command);
242  ckfree ((VOID*) c);
243}
244
245/*
246 *------------------------------------------------------*
247 *
248 *	EncodeBuffer --
249 *
250 *	------------------------------------------------*
251 *	Encode the given buffer and write the result.
252 *	------------------------------------------------*
253 *
254 *	Sideeffects:
255 *		As of the called WriteFun.
256 *
257 *	Result:
258 *		Generated bytes implicitly via WriteFun.
259 *		A standard Tcl error code.
260 *
261 *------------------------------------------------------*
262 */
263
264static int
265EncodeBuffer (ctrlBlock, buffer, bufLen, interp, clientData)
266Trf_ControlBlock ctrlBlock;
267unsigned char* buffer;
268int bufLen;
269Tcl_Interp* interp;
270ClientData clientData;
271{
272  ReflectControl* c = (ReflectControl*) ctrlBlock;
273
274  return RefExecuteCallback (c, interp,
275			     (unsigned char*) "write",
276			     buffer, bufLen, TRANSMIT_DOWN, 1);
277}
278
279/*
280 *------------------------------------------------------*
281 *
282 *	FlushEncoder --
283 *
284 *	------------------------------------------------*
285 *	Encode an incomplete character sequence (if possible).
286 *	------------------------------------------------*
287 *
288 *	Sideeffects:
289 *		As of the called WriteFun.
290 *
291 *	Result:
292 *		Generated bytes implicitly via WriteFun.
293 *		A standard Tcl error code.
294 *
295 *------------------------------------------------------*
296 */
297
298static int
299FlushEncoder (ctrlBlock, interp, clientData)
300Trf_ControlBlock ctrlBlock;
301Tcl_Interp* interp;
302ClientData clientData;
303{
304  ReflectControl* c = (ReflectControl*) ctrlBlock;
305
306  return RefExecuteCallback (c, interp,
307			     (unsigned char*) "flush/write",
308			     NULL, 0, TRANSMIT_DOWN, 1);
309}
310
311/*
312 *------------------------------------------------------*
313 *
314 *	ClearEncoder --
315 *
316 *	------------------------------------------------*
317 *	Discard an incomplete character sequence.
318 *	------------------------------------------------*
319 *
320 *	Sideeffects:
321 *		See above.
322 *
323 *	Result:
324 *		None.
325 *
326 *------------------------------------------------------*
327 */
328
329static void
330ClearEncoder (ctrlBlock, clientData)
331Trf_ControlBlock ctrlBlock;
332ClientData clientData;
333{
334  ReflectControl* c = (ReflectControl*) ctrlBlock;
335
336  RefExecuteCallback (c, (Tcl_Interp*) NULL,
337		      (unsigned char*) "clear/write",
338		      NULL, 0, TRANSMIT_DONT, 0);
339}
340
341/*
342 *------------------------------------------------------*
343 *
344 *	CreateDecoder --
345 *
346 *	------------------------------------------------*
347 *	Allocate and initialize the control block of a
348 *	data decoder.
349 *	------------------------------------------------*
350 *
351 *	Sideeffects:
352 *		Allocates memory.
353 *
354 *	Result:
355 *		An opaque reference to the control block.
356 *
357 *------------------------------------------------------*
358 */
359
360static Trf_ControlBlock
361CreateDecoder (writeClientData, fun, optInfo, interp, clientData)
362ClientData     writeClientData;
363Trf_WriteProc* fun;
364Trf_Options    optInfo;
365Tcl_Interp*    interp;
366ClientData     clientData;
367{
368  ReflectControl*          c;
369  TrfTransformOptionBlock* o = (TrfTransformOptionBlock*) optInfo;
370  int                      res;
371
372  c = (ReflectControl*) ckalloc (sizeof (ReflectControl));
373  c->write           = fun;
374  c->writeClientData = writeClientData;
375  c->interp          = interp;
376
377  c->maxRead = -1;
378  c->naturalRatio.numBytesTransform = 0;
379  c->naturalRatio.numBytesDown = 0;
380
381  /* Store reference, tell the interpreter about it. */
382  c->command      = o->command;
383  Tcl_IncrRefCount (c->command);
384
385  res = RefExecuteCallback (c, interp,
386			    (unsigned char*) "create/read",
387			    NULL, 0, TRANSMIT_DONT, 0);
388
389  if (res != TCL_OK) {
390    Tcl_DecrRefCount (c->command);
391
392    ckfree ((VOID*) c);
393    return (ClientData) NULL;
394  }
395
396  return (ClientData) c;
397}
398
399/*
400 *------------------------------------------------------*
401 *
402 *	DeleteDecoder --
403 *
404 *	------------------------------------------------*
405 *	Destroy the control block of an decoder.
406 *	------------------------------------------------*
407 *
408 *	Sideeffects:
409 *		Releases the memory allocated by 'CreateDecoder'
410 *
411 *	Result:
412 *		None.
413 *
414 *------------------------------------------------------*
415 */
416
417static void
418DeleteDecoder (ctrlBlock, clientData)
419Trf_ControlBlock ctrlBlock;
420ClientData clientData;
421{
422  ReflectControl* c = (ReflectControl*) ctrlBlock;
423
424  RefExecuteCallback (c, NULL, (unsigned char*) "delete/read",
425		      NULL, 0, TRANSMIT_DONT, 0);
426
427  Tcl_DecrRefCount (c->command);
428  ckfree ((VOID*) c);
429}
430
431/*
432 *------------------------------------------------------*
433 *
434 *	DecodeBuffer --
435 *
436 *	------------------------------------------------*
437 *	Decode the given buffer and write the result.
438 *	------------------------------------------------*
439 *
440 *	Sideeffects:
441 *		As of the called WriteFun.
442 *
443 *	Result:
444 *		Generated bytes implicitly via WriteFun.
445 *		A standard Tcl error code.
446 *
447 *------------------------------------------------------*
448 */
449
450static int
451DecodeBuffer (ctrlBlock, buffer, bufLen, interp, clientData)
452Trf_ControlBlock ctrlBlock;
453unsigned char* buffer;
454int bufLen;
455Tcl_Interp* interp;
456ClientData clientData;
457{
458  ReflectControl* c = (ReflectControl*) ctrlBlock;
459
460  return RefExecuteCallback (c, interp,
461			     (unsigned char*) "read",
462			     buffer, bufLen, TRANSMIT_DOWN, 1);
463}
464
465/*
466 *------------------------------------------------------*
467 *
468 *	FlushDecoder --
469 *
470 *	------------------------------------------------*
471 *	Decode an incomplete character sequence (if possible).
472 *	------------------------------------------------*
473 *
474 *	Sideeffects:
475 *		As of the called WriteFun.
476 *
477 *	Result:
478 *		Generated bytes implicitly via WriteFun.
479 *		A standard Tcl error code.
480 *
481 *------------------------------------------------------*
482 */
483
484static int
485FlushDecoder (ctrlBlock, interp, clientData)
486Trf_ControlBlock ctrlBlock;
487Tcl_Interp* interp;
488ClientData clientData;
489{
490  ReflectControl* c = (ReflectControl*) ctrlBlock;
491
492  return RefExecuteCallback (c, interp,
493			     (unsigned char*) "flush/read",
494			     NULL, 0, TRANSMIT_DOWN, 1);
495}
496
497/*
498 *------------------------------------------------------*
499 *
500 *	ClearDecoder --
501 *
502 *	------------------------------------------------*
503 *	Discard an incomplete character sequence.
504 *	------------------------------------------------*
505 *
506 *	Sideeffects:
507 *		See above.
508 *
509 *	Result:
510 *		None.
511 *
512 *------------------------------------------------------*
513 */
514
515static void
516ClearDecoder (ctrlBlock, clientData)
517Trf_ControlBlock ctrlBlock;
518ClientData clientData;
519{
520  ReflectControl* c = (ReflectControl*) ctrlBlock;
521
522  RefExecuteCallback (c, (Tcl_Interp*) NULL,
523		      (unsigned char*) "clear/read",
524		      NULL, 0, TRANSMIT_DONT, 0);
525}
526
527/*
528 *------------------------------------------------------*
529 *
530 *	MaxRead --
531 *
532 *	------------------------------------------------*
533 *	Query the tcl level of the transformation about
534 *      the max. number of bytes to read next time.
535 *	------------------------------------------------*
536 *
537 *	Sideeffects:
538 *		As of the tcl level.
539 *
540 *	Result:
541 *		The max. number of bytes to read.
542 *
543 *------------------------------------------------------*
544 */
545
546static int
547MaxRead (ctrlBlock, clientData)
548Trf_ControlBlock ctrlBlock;
549ClientData       clientData;
550{
551  ReflectControl* c = (ReflectControl*) ctrlBlock;
552
553  c->maxRead = -1; /* unbounded consumption */
554
555  RefExecuteCallback (c, (Tcl_Interp*) NULL,
556		      (unsigned char*) "query/maxRead",
557		      NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
558
559  return c->maxRead;
560}
561
562/*
563 *------------------------------------------------------*
564 *
565 *	RefExecuteCallback --
566 *
567 *	------------------------------------------------*
568 *	Execute callback for buffer and operation.
569 *	------------------------------------------------*
570 *
571 *	Sideeffects:
572 *		Everything possible, depending on the
573 *		script executed.
574 *
575 *	Result:
576 *		A standard TCL error code. In case of an
577 *		error a message is left in the result area
578 *		of the specified interpreter.
579 *
580 *------------------------------------------------------*
581 */
582
583int
584RefExecuteCallback (c, interp, op, buf, bufLen, transmit, preserve)
585ReflectControl* c;        /* Transformation instance */
586Tcl_Interp*     interp;   /* Interpreter we are running in, possibly NULL */
587unsigned char*  op;       /* Operation to perform by the tcl-level */
588unsigned char*  buf;      /* Data for the operation */
589int             bufLen;   /* Length of data above */
590int             transmit; /* What to do with the result, see TRANSMIT_xxx */
591int             preserve; /* Preserve result of transformation interp ? y/n */
592{
593  /*
594   * Step 1, create the complete command to execute. Do this by appending
595   * operation and buffer to operate upon to a copy of the callback
596   * definition. We *cannot* create a list containing 3 objects and then use
597   * 'Tcl_EvalObjv', because the command may contain additional prefixed
598   * arguments. Feathers curried commands would come in handy here.
599   */
600
601  int             res = TCL_OK;
602  Tcl_Obj*        resObj; /* See below, switch (transmit) */
603  Tcl_Obj**       listObj;
604  int             resLen;
605  unsigned char*  resBuf;
606#if GT81
607  Tcl_SavedResult ciSave;
608#endif
609  Tcl_Obj* command;
610  Tcl_Obj* temp;
611
612  START (RefExecuteCallback);
613  PRINT ("args = (%s | %d | %d | %d)\n", op, bufLen, transmit, preserve); FL;
614
615  command = Tcl_DuplicateObj (c->command);
616
617#if GT81
618  if (preserve) {
619    PRINTLN ("preserve");
620    Tcl_SaveResult (c->interp, &ciSave);
621  }
622#endif
623
624  if (command == (Tcl_Obj*) NULL) {
625    /* Memory allocation problem */
626    res = TCL_ERROR;
627    PRINT ("command not duplicated @ %d\n", __LINE__);
628    goto cleanup;
629  }
630
631  Tcl_IncrRefCount (command);
632
633  temp = Tcl_NewStringObj ((char*) op, -1);
634
635  if (temp == (Tcl_Obj*) NULL) {
636    /* Memory allocation problem */
637    PRINT ("op object not allocated @ %d\n", __LINE__);
638    res = TCL_ERROR;
639    goto cleanup;
640  }
641
642  res = Tcl_ListObjAppendElement (interp, command, temp);
643
644  if (res != TCL_OK)
645    goto cleanup;
646
647  /*
648   * Use a byte-array to prevent the misinterpretation of binary data
649   * coming through as UTF while at the tcl level.
650   */
651
652#if GT81
653  temp = Tcl_NewByteArrayObj (buf, bufLen);
654#else
655  temp = Tcl_NewStringObj    ((char*) buf, bufLen);
656#endif
657
658  if (temp == (Tcl_Obj*) NULL) {
659    /* Memory allocation problem */
660#if GT81
661    PRINT ("bytearray not allocated @ %d\n", __LINE__);
662#else
663    PRINT ("string not allocated @ %d\n", __LINE__);
664#endif
665    res = TCL_ERROR;
666    goto cleanup;
667  }
668
669  res = Tcl_ListObjAppendElement (interp, command, temp);
670
671  if (res != TCL_OK)
672    goto cleanup;
673
674  /*
675   * Step 2, execute the command at the global level of the interpreter
676   * used to create the transformation. Destroy the command afterward.
677   * If an error occured, the current interpreter is defined and not equal
678   * to the interpreter for the callback, then copy the error message into
679   * current interpreter. Don't copy if in preservation mode.
680   */
681
682  res = Tcl_GlobalEvalObj (c->interp, command);
683  Tcl_DecrRefCount (command);
684  command = (Tcl_Obj*) NULL;
685
686  if (res != TCL_OK) {
687    /* copy error message from 'c->interp' to actual 'interp'. */
688
689    if ((interp != (Tcl_Interp*) NULL) &&
690	(c->interp != interp) &&
691	!preserve) {
692
693        Tcl_SetObjResult (interp, Tcl_GetObjResult (c->interp));
694    }
695
696    PRINTLN ("!error"); FL;
697    goto cleanup;
698  }
699
700  /*
701   * Step 3, transmit a possible conversion result to the underlying
702   * channel, or ourselves
703   */
704
705  switch (transmit) {
706  case TRANSMIT_DONT:
707    /* nothing to do */
708    break;
709
710  case TRANSMIT_DOWN:
711    /* Caller said to expect data in interpreter result area.
712     * Take it, then write it out to the channel system.
713     */
714    resObj = Tcl_GetObjResult (c->interp);
715#if GT81
716    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj (resObj, &resLen);
717#else
718    resBuf = (unsigned char*) Tcl_GetStringFromObj (resObj, &resLen);
719#endif
720    res = c->write (c->writeClientData, resBuf, resLen, interp);
721    break;
722
723  case TRANSMIT_NUM:
724    /* Interpret result as integer number */
725    resObj = Tcl_GetObjResult (c->interp);
726
727    Tcl_GetIntFromObj (c->interp, resObj, &c->maxRead);
728    break;
729
730  case TRANSMIT_RATIO:
731    /* Result should be 2-element list. Ignore superfluous list elements.
732     */
733    resObj = Tcl_GetObjResult (c->interp);
734    resLen = -1;
735    res = Tcl_ListObjLength(c->interp, resObj, &resLen);
736
737    c->naturalRatio.numBytesTransform = 0;
738    c->naturalRatio.numBytesDown      = 0;
739
740    if ((res != TCL_OK) || (resLen < 2)) {
741      PRINT ("TRANSMIT_RATIO problem (%d, %d)\n",
742	     res == TCL_OK, resLen);
743      PRINTLN ("reset result");
744
745      Tcl_ResetResult (c->interp);
746      goto cleanup;
747    }
748
749    res = Tcl_ListObjGetElements(c->interp, resObj, &resLen, &listObj);
750
751    Tcl_GetIntFromObj (c->interp, listObj [0],
752		       &c->naturalRatio.numBytesTransform);
753    Tcl_GetIntFromObj (c->interp, listObj [1],
754		       &c->naturalRatio.numBytesDown);
755    break;
756  }
757
758  PRINTLN ("reset result");
759  Tcl_ResetResult (c->interp);
760
761#if GT81
762  if (preserve) {
763    PRINTLN ("restore");
764    Tcl_RestoreResult (c->interp, &ciSave);
765  }
766#endif
767
768  DONE (RefExecuteCallback);
769  return res;
770
771cleanup:
772  PRINTLN ("cleanup...");
773
774#if GT81
775  if (preserve) {
776    PRINTLN ("restore");
777    Tcl_RestoreResult (c->interp, &ciSave);
778  }
779#endif
780
781  if (command != (Tcl_Obj*) NULL) {
782    PRINTLN ("decr-ref command");
783    Tcl_DecrRefCount (command);
784  }
785
786  DONE (RefExecuteCallback);
787  return res;
788}
789