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