www/wtcl.c

   1 /*
   2  * Copyright (c) 1995, the EUROPAGATE consortium (see below).
   3  *
   4  * The EUROPAGATE consortium members are:
   5  *
   6  *    University College Dublin
   7  *    Danmarks Teknologiske Videnscenter
   8  *    An Chomhairle Leabharlanna
   9  *    Consejo Superior de Investigaciones Cientificas
  10  *
  11  * Permission to use, copy, modify, distribute, and sell this software and
  12  * its documentation, in whole or in part, for any purpose, is hereby granted,
  13  * provided that:
  14  *
  15  * 1. This copyright and permission notice appear in all copies of the
  16  * software and its documentation. Notices of copyright or attribution
  17  * which appear at the beginning of any file must remain unchanged.
  18  *
  19  * 2. The names of EUROPAGATE or the project partners may not be used to
  20  * endorse or promote products derived from this software without specific
  21  * prior written permission.
  22  *
  23  * 3. Users of this software (implementors and gateway operators) agree to
  24  * inform the EUROPAGATE consortium of their use of the software. This
  25  * information will be used to evaluate the EUROPAGATE project and the
  26  * software, and to plan further developments. The consortium may use
  27  * the information in later publications.
  28  *
  29  * 4. Users of this software agree to make their best efforts, when
  30  * documenting their use of the software, to acknowledge the EUROPAGATE
  31  * consortium, and the role played by the software in their work.
  32  *
  33  * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
  34  * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
  35  * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
  36  * IN NO EVENT SHALL THE EUROPAGATE CONSORTIUM OR ITS MEMBERS BE LIABLE
  37  * FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF
  38  * ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
  39  * OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND
  40  * ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
  41  * USE OR PERFORMANCE OF THIS SOFTWARE.
  42  *
  43  * $Log: wtcl.c,v $
  44  * Revision 1.22  1997/12/15 15:05:03  adam
  45  * Enhanced the code that deals with FORM variables.
  46  *
  47  * Revision 1.21  1997/02/10 10:15:40  adam
  48  * Bug fix: egw_source <file> <var> didn't work properly.
  49  *
  50  * Revision 1.20  1997/01/31 11:16:01  adam
  51  * Enhanced the egw_source command. An optional parameter specifies the
  52  * name of a variable in which the HTML output is stored.
  53  *
  54  * Revision 1.19  1997/01/27 11:27:17  adam
  55  * Implemented a new command, egw_clear, to clear http output cache.
  56  * Changed prototype for function wo_clear.
  57  *
  58  * Revision 1.18  1997/01/24 13:13:13  adam
  59  * Implemnted egw_source and added a "raw" option to the URL.
  60  * Fixed a bug in the buffering system of wproto; the macro wo_putc could
  61  * override memory if it was the first HTML generating function called.
  62  *
  63  * Revision 1.17  1996/05/31 08:02:56  adam
  64  * Bug fix: egw_enc encoded '/' - it shouldn't.
  65  *
  66  * Revision 1.16  1996/05/23 15:53:12  adam
  67  * Bug fix: egw_enc failed on 8-bit chars.
  68  * New command: egw_parms.
  69  *
  70  * Revision 1.15  1996/05/22  16:50:27  adam
  71  * Bug fix.
  72  *
  73  * Revision 1.14  1996/05/21  14:53:04  adam
  74  * Tcl command wform extented; options -raw and -exists added.
  75  *
  76  * Revision 1.13  1996/03/14  11:48:40  adam
  77  * New function egw_prog that returns name of shell.
  78  *
  79  * Revision 1.12  1996/03/07  12:45:34  adam
  80  * New Tcl calls egw_enc/egw_dec to encode/decode binary URL info.
  81  *
  82  * Revision 1.11  1996/01/24  08:26:56  adam
  83  * All tcl commands prefixed with egw_ (except the html command).
  84  *
  85  * Revision 1.10  1995/11/08  16:14:35  adam
  86  * Many improvements and bug fixes.
  87  * First version that ran on dtbsun.
  88  *
  89  * Revision 1.9  1995/11/07  14:57:00  adam
  90  * Work on search in multiple targets.
  91  * New wtcl command: wlog.
  92  * Optional timeout parameter to zwait.
  93  *
  94  * Revision 1.8  1995/11/06  17:44:23  adam
  95  * State reestablised when shell restarts. History of previous
  96  * result sets.
  97  *
  98  * Revision 1.7  1995/10/31  16:56:25  adam
  99  * Record presentation.
 100  *
 101  * Revision 1.6  1995/10/31  10:03:54  adam
 102  * Work on queries.
 103  * New command implemented - aborts script.
 104  *
 105  * Revision 1.5  1995/10/30  17:35:18  adam
 106  * New function zwait that waits for a variable change - due to i/o events
 107  * that invoke callback routines.
 108  *
 109  * Revision 1.4  1995/10/27  17:30:16  adam
 110  * First search request/response that works.
 111  *
 112  * Revision 1.3  1995/10/27  15:12:14  adam
 113  * IrTcl incorporated in the gateway.
 114  * Better separation of script types.
 115  * Z39.50 gateway scripts entered.
 116  *
 117  * Revision 1.2  1995/10/23  16:55:43  adam
 118  * A lot of changes - really.
 119  *
 120  * Revision 1.1  1995/10/20  14:02:42  adam
 121  * First version of WWW gateway with embedded Tcl.
 122  *
 123  */
 124
 125 #include <stdio.h>
 126 #include <stdlib.h>
 127 #include <string.h>
 128 #include <assert.h>
 129 #include <ctype.h>
 130
 131 #include "wtcl.h"
 132
 133 static void *do_create (WCLIENT wcl, void *args);
 134 static int do_exec (const char *fname, char *parms, void *mydata);
 135 static int do_load (char *parms, void *mydata);
 136 static int do_save (char *parms, void *mydata);
 137
 138 static struct w_interp_type w_interp_t = {
 139     "tcl",
 140     do_create,
 141     do_exec,
 142     do_load,
 143     do_save
 144 };
 145
 146 W_Interp_Type w_interp_tcl = &w_interp_t;
 147
 148
 149 static char *mod = "wtcl";
 150
 151 struct tcl_info {
 152     Tcl_Interp *interp;
 153     char  *fbuf;
 154     int    fbuf_size;
 155     int    fbuf_ptr;
 156     int    wabort;
 157     WCLIENT wcl;
 158 };
 159
 160 static int exec_file (const char *fname, struct tcl_info *p);
 161
 162 Tcl_Interp *w_interp_tcl_get (W_Interp w_interp)
 163 {
 164     struct tcl_info *p;
 165
 166     if (strcmp (w_interp->ctrl->name, "tcl"))
 167     {
 168         gw_log (GW_LOG_FATAL, mod, "Internal failure");
 169         assert (0);
 170     }
 171     p = (struct tcl_info*) w_interp->mydata;
 172     return p->interp;
 173 }
 174
 175 static int proc_wabort_invoke (ClientData clientData, Tcl_Interp *interp,
 176                                int argc, char **argv)
 177 {
 178     struct tcl_info *p = (struct tcl_info*) clientData;
 179
 180     p->wabort = 1;
 181     if (argc > 1)
 182         Tcl_AppendResult (interp, argv[1], NULL);
 183     return TCL_RETURN;
 184 }
 185
 186 static int proc_wflush_invoke (ClientData clientData, Tcl_Interp *interp,
 187                                int argc, char **argv)
 188 {
 189     struct tcl_info *p = (struct tcl_info*) clientData;
 190
 191     wo_flush (p->wcl);
 192     return TCL_OK;
 193 }
 194
 195 static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp,
 196                              int argc, char **argv)
 197 {
 198     struct tcl_info *p = (struct tcl_info*) clientData;
 199     int i;
 200
 201     for (i = 1; i<argc; i++)
 202         wo_write (p->wcl, argv[i], strlen(argv[i]));
 203     return TCL_OK;
 204 }
 205
 206 static int proc_form_invoke (struct tcl_info *p, wform_data *wfdata,
 207                              Tcl_Interp *interp,
 208                              int argc, char **argv)
 209 {
 210     const char *arg = NULL;
 211     int failFlag = 0;
 212
 213     if (argc == 3)
 214     {
 215         if (!strcmp (argv[1], "-raw"))
 216         {
 217             interp->result = p->wcl->raw_data;
 218             return TCL_OK;
 219         }
 220         else if (!strcmp (argv[1], "-exists"))
 221         {
 222             failFlag = 1;
 223             arg = argv[2];
 224         }
 225         else
 226         {
 227             Tcl_AppendResult (p->interp, "bad option to ", argv[0],
 228                               " \"", argv[1], "\"", NULL);
 229             return TCL_ERROR;
 230         }
 231     }
 232     else if (argc == 2)
 233         arg = argv[1];
 234     if (arg)
 235     {
 236         for (; wfdata; wfdata = wfdata->next)
 237             if (!strcmp (arg, wfdata->name))
 238             {
 239                 failFlag = 0;
 240                 if (wfdata->value)
 241                     Tcl_AppendElement (p->interp, wfdata->value);
 242             }
 243         if (failFlag)
 244         {
 245             Tcl_AppendResult (p->interp, arg, " doesn't exist", NULL);
 246             return TCL_ERROR;
 247         }
 248     }
 249     else
 250         for ( ; wfdata; wfdata = wfdata->next)
 251         {
 252             Tcl_AppendResult (p->interp, "{ ", NULL);
 253             Tcl_AppendElement (p->interp, wfdata->name);
 254             Tcl_AppendElement (p->interp, wfdata->value ? wfdata->value : "");
 255             Tcl_AppendResult (p->interp, " }\n", NULL);
 256         }
 257     return TCL_OK;
 258 }
 259
 260 static int proc_wform_invoke (ClientData clientData, Tcl_Interp *interp,
 261                               int argc, char **argv)
 262 {
 263     struct tcl_info *p = (struct tcl_info*) clientData;
 264     wform_data *wfdata = p->wcl->wf_data;
 265     return proc_form_invoke (p, wfdata, interp, argc, argv);
 266 }
 267
 268 static int proc_parms_invoke (ClientData clientData, Tcl_Interp *interp,
 269                               int argc, char **argv)
 270 {
 271     struct tcl_info *p = (struct tcl_info*) clientData;
 272     wform_data *wfdata = p->wcl->wf_parms_var;
 273     return proc_form_invoke (p, wfdata, interp, argc, argv);
 274 }
 275
 276
 277 static int proc_wlog_invoke (ClientData clientData, Tcl_Interp *interp,
 278                              int argc, char **argv)
 279 {
 280     unsigned mask;
 281
 282     if (argc < 3)
 283         return TCL_OK;
 284     if (!strcmp (argv[1], "debug"))
 285         mask = GW_LOG_DEBUG;
 286     else if (!strcmp (argv[1], "fatal"))
 287         mask = GW_LOG_FATAL;
 288     else if (!strcmp (argv[1], "warn"))
 289         mask = GW_LOG_WARN;
 290     else if (!strcmp (argv[1], "acct"))
 291         mask = GW_LOG_ACCT;
 292     else
 293         mask = GW_LOG_DEBUG;
 294     switch (argc)
 295     {
 296     case 3:
 297         gw_log (mask, mod, "%s", argv[2]);
 298         break;
 299     case 4:
 300         gw_log (mask, mod, "%s %s", argv[2], argv[3]);
 301         break;
 302     case 5:
 303         gw_log (mask, mod, "%s %s %s", argv[2], argv[3], argv[4]);
 304         break;
 305     case 6:
 306         gw_log (mask, mod, "%s %s %s %s", argv[2], argv[3], argv[4], argv[5]);
 307         break;
 308     }
 309     return TCL_OK;
 310 }
 311
 312 static int proc_enc (ClientData clientData, Tcl_Interp *interp,
 313                      int argc, char **argv)
 314 {
 315     int i;
 316     char buf1[6];
 317     char buf2[2];
 318
 319     buf1[0] = '%';
 320     buf2[1] = '\0';
 321     for (i = 1; i<argc; i++)
 322     {
 323         const char *cp = argv[i];
 324         while (*cp)
 325         {
 326             if (*cp < ' ' || *cp >= 127 || *cp == '&' || *cp == '?'
 327                 || *cp == '%' || *cp == '+' || *cp == '"')
 328             {
 329                 sprintf (buf1+1, "%02X", *cp & 0xff);
 330                 Tcl_AppendResult (interp, buf1, NULL);
 331             }
 332             else if (*cp == ' ')
 333             {
 334                 Tcl_AppendResult (interp, "+", NULL);
 335             }
 336             else
 337             {
 338                 buf2[0] = *cp;
 339                 Tcl_AppendResult (interp, buf2, NULL);
 340             }
 341             cp++;
 342         }
 343     }
 344     return TCL_OK;
 345 }
 346
 347 static int proc_dec (ClientData clientData, Tcl_Interp *interp,
 348                      int argc, char **argv)
 349 {
 350     int i;
 351     unsigned val;
 352     char buf[2];
 353
 354     buf[1] = '\0';
 355     for (i = 1; i<argc; i++)
 356     {
 357         const char *cp = argv[i];
 358         while (*cp)
 359         {
 360             if (*cp == '%' && cp[1] && cp[2])
 361             {
 362                 if (cp[1] >= 'A')
 363                     val = cp[1] - 'A'+10;
 364                 else
 365                     val = cp[1] - '0';
 366
 367
 368                 if (cp[2] >= 'A')
 369                     val = val*16 + (cp[2] - 'A'+10);
 370                 else
 371                     val = val*16 + (cp[2] - '0');
 372                 buf[0] = val;
 373                 cp += 3;
 374             }
 375             else
 376                 buf[0] = *cp++;
 377             Tcl_AppendResult (interp, buf, NULL);
 378         }
 379     }
 380     return TCL_OK;
 381 }
 382
 383 static int proc_prog (ClientData clientData, Tcl_Interp *interp,
 384                       int argc, char **argv)
 385 {
 386     struct tcl_info *p = (struct tcl_info*) clientData;
 387
 388     Tcl_AppendResult (p->interp, p->wcl->prog, NULL);
 389     return TCL_OK;
 390 }
 391
 392 static int proc_source (ClientData clientData, Tcl_Interp *interp,
 393                         int argc, char **argv)
 394 {
 395     struct tcl_info *p = (struct tcl_info*) clientData;
 396     int r, offset = 0;
 397
 398     if (argc < 2 || argc > 3)
 399     {
 400         Tcl_AppendResult (p->interp,
 401                           "wrong # args: should be egw_source file ?var?",
 402                           NULL);
 403         return TCL_ERROR;
 404     }
 405     if (argc == 3)
 406         offset = wproto_save_push (p->wcl);
 407     r = exec_file (argv[1], p);
 408     Tcl_ResetResult (p->interp);
 409     if (argc == 3)
 410     {
 411         char *res = wproto_save_pop (p->wcl, offset);
 412         if (res)
 413             Tcl_SetVar (p->interp, argv[2], res, 0);
 414     }
 415     if (r == -1)
 416     {
 417         Tcl_AppendResult (p->interp, "egw_source: couldn't open ",
 418                           argv[1], NULL);
 419         return TCL_ERROR;
 420     }
 421     else if (r == -2)
 422     {
 423         Tcl_AppendResult (p->interp, "egw_source: Tcl error in script ",
 424                           argv[1], NULL);
 425         return TCL_ERROR;
 426     }
 427     return TCL_OK;
 428 }
 429
 430 static int proc_clear (ClientData clientData, Tcl_Interp *interp,
 431                         int argc, char **argv)
 432 {
 433     struct tcl_info *p = (struct tcl_info*) clientData;
 434
 435     wo_clear (p->wcl);
 436     return TCL_OK;
 437 }
 438
 439 int Tcl_AppInit (Tcl_Interp *interp)
 440 {
 441     if (Tcl_Init (interp) == TCL_ERROR)
 442         return TCL_ERROR;
 443     return TCL_OK;
 444 }
 445
 446 static void *do_create (WCLIENT wcl, void *args)
 447 {
 448     struct tcl_info *p;
 449     char tmp_str[256];
 450
 451     if (!(p = malloc (sizeof(*p))))
 452     {
 453         gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, mod, "malloc: tcl_info");
 454         exit (1);
 455     }
 456     if (!(p->interp = Tcl_CreateInterp ()))
 457     {
 458         gw_log (GW_LOG_FATAL, mod, "Cannot make Tcl_Interp");
 459         exit (1);
 460     }
 461     p->wcl = wcl;
 462     p->fbuf_size = 1024;
 463     if (!(p->fbuf = malloc (p->fbuf_size)))
 464     {
 465         gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, mod, "malloc: tcl_info fbuf");
 466         exit (1);
 467     }
 468     Tcl_AppInit (p->interp);
 469     Tcl_CreateCommand (p->interp, "html", proc_html_invoke, p, NULL);
 470     Tcl_CreateCommand (p->interp, "egw_form", proc_wform_invoke, p, NULL);
 471     Tcl_CreateCommand (p->interp, "egw_parms", proc_parms_invoke, p, NULL);
 472     Tcl_CreateCommand (p->interp, "egw_abort", proc_wabort_invoke, p, NULL);
 473     Tcl_CreateCommand (p->interp, "egw_flush", proc_wflush_invoke, p, NULL);
 474     Tcl_CreateCommand (p->interp, "egw_log", proc_wlog_invoke, p, NULL);
 475     Tcl_CreateCommand (p->interp, "egw_enc", proc_enc, p, NULL);
 476     Tcl_CreateCommand (p->interp, "egw_dec", proc_dec, p, NULL);
 477     Tcl_CreateCommand (p->interp, "egw_prog", proc_prog, p, NULL);
 478     Tcl_CreateCommand (p->interp, "egw_source", proc_source, p, NULL);
 479     Tcl_CreateCommand (p->interp, "egw_clear", proc_clear, p, NULL);
 480     sprintf (tmp_str, "%d", wcl->id);
 481     Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY);
 482     return p;
 483 }
 484
 485 static void report_error (struct tcl_info *p, int errorLine,
 486                           const char *pre, const char *msg)
 487 {
 488     if (!msg)
 489         msg = "";
 490     gw_log (GW_LOG_WARN, mod, "%s %d %s", pre, errorLine, msg);
 491     wo_printf (p->wcl, "\n<br><hr>\n<strong>"
 492                "%s %d</strong><br>\n", pre, errorLine);
 493     wo_printf (p->wcl, "<xmp>\n%s</xmp>\n<hr>\n", msg);
 494 }
 495
 496 static int tcl_exec (const char *fname, struct tcl_info *p, FILE *inf,
 497                      int *lineno)
 498 {
 499     int c, escape = 0, level = 0;
 500     int r, fbuf_ptr = 0;
 501     int local_line = 0;
 502
 503     while (1)
 504     {
 505         if (fbuf_ptr == p->fbuf_size-1)
 506         {
 507             char *newb;
 508
 509             if (!(newb = malloc (p->fbuf_size += 16384)))
 510             {
 511                 gw_log (GW_LOG_FATAL|GW_LOG_ERRNO, mod, "malloc: fbuf");
 512                 exit (1);
 513             }
 514             memcpy (newb, p->fbuf, fbuf_ptr);
 515             free (p->fbuf);
 516             p->fbuf = newb;
 517         }
 518         c = getc (inf);
 519         if (c == EOF)
 520         {
 521             report_error (p, *lineno, "Error in Tcl script starting at line",
 522                                       "Unexpected EOF (missing right brace)");
 523             return TCL_ERROR;
 524         }
 525         if (c == '\\')
 526             escape = 1;
 527         else if (c == '{' && !escape)
 528         {
 529             level++;
 530             escape = 0;
 531         }
 532         else if (c == '}' && !escape)
 533         {
 534             if (--level < 0)
 535                 break;
 536             escape = 0;
 537         }
 538         else
 539         {
 540             if (c == '\n')
 541                 local_line++;
 542             escape = 0;
 543         }
 544         p->fbuf[fbuf_ptr++] = c;
 545     }
 546     p->fbuf[fbuf_ptr] = '\0';
 547     p->wabort = 0;
 548     r = Tcl_Eval (p->interp, p->fbuf);
 549     if (r == TCL_ERROR)
 550         report_error (p, p->interp->errorLine + *lineno - 1,
 551                       "Error in Tcl script in line",
 552                       Tcl_GetVar (p->interp, "errorInfo", 0));
 553     (*lineno) += local_line;
 554     if (p->wabort)
 555         return TCL_RETURN;
 556     return r;
 557 }
 558
 559 static int var_ref (struct tcl_info *p, FILE *inf)
 560 {
 561     int c, i = 0;
 562     char name[32], *vp;
 563
 564     c = getc (inf);
 565     if (c == '{')
 566     {
 567         while ((c = getc(inf)) != EOF)
 568         {
 569             if (c == '\n')
 570                 break;
 571             if (c == '}')
 572             {
 573                 c = getc (inf);
 574                 break;
 575             }
 576             if (i < 31)
 577                 name[i++] = c;
 578         }
 579     }
 580     else
 581     {
 582         while (c != EOF)
 583         {
 584             if (c != '(' && c != ')' && c != '-' && c != '_' && !isalnum(c))
 585                 break;
 586             if (i < 31)
 587                 name[i++] = c;
 588             c = getc (inf);
 589         }
 590     }
 591     name[i] = '\0';
 592     vp = Tcl_GetVar (p->interp, name, 0);
 593     if (vp)
 594         wo_puts (p->wcl, vp);
 595     return c;
 596 }
 597
 598 static int exec_file (const char *fname, struct tcl_info *p)
 599 {
 600     int c, escape = 0;
 601     int lineno = 1;
 602     FILE *inf = fopen (fname, "r");
 603
 604     gw_log (GW_LOG_DEBUG, mod, "Executing %s", fname);
 605     if (!inf)
 606     {
 607         gw_log (GW_LOG_WARN|GW_LOG_ERRNO, mod, "open %s", fname);
 608         return -1;
 609     }
 610     c = getc (inf);
 611     while (c != EOF)
 612     {
 613         switch (c)
 614         {
 615         case '\\':
 616             escape = 1;
 617             c = getc (inf);
 618             break;
 619         case '$':
 620             if (escape)
 621             {
 622                 c = getc (inf);
 623                 wo_putc (p->wcl, c);
 624             }
 625             else
 626                 c = var_ref (p, inf);
 627             break;
 628         case '{':
 629             if (escape)
 630                 wo_putc (p->wcl, c);
 631             else
 632             {
 633                 int r = tcl_exec (fname, p, inf, &lineno);
 634                 if (r == TCL_RETURN)
 635                 {
 636                     fclose (inf);
 637                     return 0;
 638                 }
 639                 else if (r == TCL_ERROR)
 640                 {
 641                     fclose (inf);
 642                     return -2;
 643                 }
 644             }
 645             escape = 0;
 646             c = getc (inf);
 647             break;
 648         default:
 649             if (c == '\n')
 650                 lineno++;
 651             escape = 0;
 652             wo_putc (p->wcl, c);
 653             c = getc (inf);
 654         }
 655     }
 656     fclose (inf);
 657     return 0;
 658 }
 659
 660 static int do_exec (const char *fname, char *parms, void *mydata)
 661 {
 662     struct tcl_info *p = mydata;
 663
 664     Tcl_SetVar (p->interp, "sessionParms", parms, TCL_GLOBAL_ONLY);
 665     return exec_file (fname, p);
 666 }
 667
 668 static int do_load (char *parms, void *mydata)
 669 {
 670     struct tcl_info *p = mydata;
 671     char fname[80];
 672     int r;
 673
 674     sprintf (fname, "tcl.state.%d", p->wcl->id);
 675     r = Tcl_EvalFile (p->interp, fname);
 676     if (r == TCL_ERROR)
 677         gw_log (GW_LOG_WARN, mod, "Cannot load Tcl state" );
 678     return 0;
 679 }
 680
 681 static int do_save (char *parms, void *mydata)
 682 {
 683     struct tcl_info *p = mydata;
 684     struct Tcl_CmdInfo cinfo;
 685
 686     if (Tcl_GetCommandInfo(p->interp, "saveState", &cinfo))
 687     {
 688         int r;
 689
 690         gw_log (GW_LOG_DEBUG, mod, "saveState");
 691         r = Tcl_Eval (p->interp, "saveState\n");
 692         if (r == TCL_ERROR)
 693             report_error (p, p->interp->errorLine,
 694                           "Error in Tcl saveState in line",
 695                           Tcl_GetVar (p->interp, "errorInfo", 0));
 696     }
 697     return 0;
 698 }
 699