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