/[cvs]/eggdrop1.4/src/tcl.c
ViewVC logotype

Contents of /eggdrop1.4/src/tcl.c

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.29 - (show annotations) (download) (as text)
Thu Aug 10 01:59:37 2000 UTC (19 years, 1 month ago) by guppy
Branch: MAIN
Changes since 1.28: +39 -17 lines
File MIME type: text/x-chdr
high ascii bug fix

1 /*
2 * tcl.c -- handles:
3 * the code for every command eggdrop adds to Tcl
4 * Tcl initialization
5 * getting and setting Tcl/eggdrop variables
6 *
7 * dprintf'ized, 4feb1996
8 *
9 * $Id: tcl.c,v 1.28 2000/07/28 05:11:18 guppy Exp $
10 */
11 /*
12 * Copyright (C) 1997 Robey Pointer
13 * Copyright (C) 1999, 2000 Eggheads
14 *
15 * This program is free software; you can redistribute it and/or
16 * modify it under the terms of the GNU General Public License
17 * as published by the Free Software Foundation; either version 2
18 * of the License, or (at your option) any later version.
19 *
20 * This program is distributed in the hope that it will be useful,
21 * but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 * GNU General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with this program; if not, write to the Free Software
27 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 */
29
30 #include "main.h"
31
32 /* used for read/write to internal strings */
33 typedef struct {
34 char *str; /* pointer to actual string in eggdrop */
35 int max; /* max length (negative: read-only var when protect is on) */
36 /* (0: read-only ALWAYS) */
37 int flags; /* 1 = directory */
38 } strinfo;
39
40 typedef struct {
41 int *var;
42 int ro;
43 } intinfo;
44
45 int protect_readonly = 0; /* turn on/off readonly protection */
46 char whois_fields[1025] = ""; /* fields to display in a .whois */
47 Tcl_Interp *interp; /* eggdrop always uses the same interpreter */
48
49 extern int backgrd, flood_telnet_thr, flood_telnet_time;
50 extern int shtime, share_greet, require_p, keep_all_logs;
51 extern int allow_new_telnets, stealth_telnets, use_telnet_banner;
52 extern int default_flags, conmask, switch_logfiles_at, connect_timeout;
53 extern int firewallport, reserved_port, notify_users_at;
54 extern int flood_thr, ignore_time;
55 extern char origbotname[], botuser[], motdfile[], admin[], userfile[],
56 firewall[], helpdir[], notify_new[], hostname[], myip[], moddir[],
57 tempdir[], owner[], network[], botnetnick[], bannerfile[];
58 extern int die_on_sighup, die_on_sigterm, max_logs, max_logsize, enable_simul;
59 extern int dcc_total, debug_output, identtimeout, protect_telnet;
60 extern int egg_numver, share_unlinks, dcc_sanitycheck, sort_users;
61 extern int tands, resolve_timeout, default_uflags, strict_host;
62 extern struct dcc_t *dcc;
63 extern char egg_version[], natip[];
64 extern tcl_timer_t *timer, *utimer;
65 extern time_t online_since;
66 extern log_t *logs;
67
68 /* confvar patch by aaronwl */
69 extern char configfile[];
70 int dcc_flood_thr = 3;
71 int debug_tcl = 0;
72 int use_silence = 0;
73 int use_invites = 0; /* Jason/drummer */
74 int use_exempts = 0; /* Jason/drummer */
75 int force_expire = 0; /* Rufus */
76 int remote_boots = 2;
77 int allow_dk_cmds = 1;
78 int must_be_owner = 1;
79 int max_dcc = 20; /* needs at least 4 or 5 just to get started
80 * 20 should be enough */
81 int min_dcc_port = 1024; /* dcc-portrange, min port - dw/guppy */
82 int max_dcc_port = 65535; /* dcc-portrange, max port - dw/guppy */
83 int quick_logs = 0; /* quick write logs?
84 * flush em every min instead of every 5 */
85 int par_telnet_flood = 1; /* trigger telnet flood for +f ppl? - dw */
86 int quiet_save = 0; /* quiet-save patch by Lucas */
87
88 /* prototypes for tcl */
89 Tcl_Interp *Tcl_CreateInterp();
90 int strtot = 0;
91
92 int expmem_tcl()
93 {
94 int i, tot = 0;
95
96 Context;
97 for (i = 0; i < max_logs; i++)
98 if (logs[i].filename != NULL) {
99 tot += strlen(logs[i].filename) + 1;
100 tot += strlen(logs[i].chname) + 1;
101 }
102 return tot + strtot;
103 }
104
105 /***********************************************************************/
106
107 /* logfile [<modes> <channel> <filename>] */
108 static int tcl_logfile STDVAR
109 {
110 int i;
111 char s[151];
112
113 BADARGS(1, 4, " ?logModes channel logFile?");
114 if (argc == 1) {
115 /* they just want a list of the logfiles and modes */
116 for (i = 0; i < max_logs; i++)
117 if (logs[i].filename != NULL) {
118 strcpy(s, masktype(logs[i].mask));
119 strcat(s, " ");
120 strcat(s, logs[i].chname);
121 strcat(s, " ");
122 strcat(s, logs[i].filename);
123 Tcl_AppendElement(interp, s);
124 }
125 return TCL_OK;
126 }
127 BADARGS(4, 4, " ?logModes channel logFile?");
128 for (i = 0; i < max_logs; i++)
129 if ((logs[i].filename != NULL) && (!strcmp(logs[i].filename, argv[3]))) {
130 logs[i].flags &= ~LF_EXPIRING;
131 logs[i].mask = logmodes(argv[1]);
132 nfree(logs[i].chname);
133 logs[i].chname = NULL;
134 if (!logs[i].mask) {
135 /* ending logfile */
136 nfree(logs[i].filename);
137 logs[i].filename = NULL;
138 if (logs[i].f != NULL) {
139 fclose(logs[i].f);
140 logs[i].f = NULL;
141 }
142 logs[i].flags = 0;
143 } else {
144 logs[i].chname = (char *) nmalloc(strlen(argv[2]) + 1);
145 strcpy(logs[i].chname, argv[2]);
146 }
147 Tcl_AppendResult(interp, argv[3], NULL);
148 return TCL_OK;
149 }
150 /* do not add logfiles without any flags to log ++rtc */
151 if (!logmodes (argv [1])) {
152 Tcl_AppendResult (interp, "can't remove \"", argv[3],
153 "\" from list: no such logfile", NULL);
154 return TCL_ERROR;
155 }
156 for (i = 0; i < max_logs; i++)
157 if (logs[i].filename == NULL) {
158 logs[i].flags = 0;
159 logs[i].mask = logmodes(argv[1]);
160 logs[i].filename = (char *) nmalloc(strlen(argv[3]) + 1);
161 strcpy(logs[i].filename, argv[3]);
162 logs[i].chname = (char *) nmalloc(strlen(argv[2]) + 1);
163 strcpy(logs[i].chname, argv[2]);
164 Tcl_AppendResult(interp, argv[3], NULL);
165 return TCL_OK;
166 }
167 Tcl_AppendResult(interp, "reached max # of logfiles", NULL);
168 return TCL_ERROR;
169 }
170
171 int findidx(int z)
172 {
173 int j;
174
175 for (j = 0; j < dcc_total; j++)
176 if ((dcc[j].sock == z) && (dcc[j].type->flags & DCT_VALIDIDX))
177 return j;
178 return -1;
179 }
180
181 static void botnet_change(char *new)
182 {
183 if (strcasecmp(botnetnick, new) != 0) {
184 /* trying to change bot's nickname */
185 if (tands > 0) {
186 putlog(LOG_MISC, "*", "* Tried to change my botnet nick, but I'm still linked to a botnet.");
187 putlog(LOG_MISC, "*", "* (Unlink and try again.)");
188 return;
189 } else {
190 if (botnetnick[0])
191 putlog(LOG_MISC, "*", "* IDENTITY CHANGE: %s -> %s", botnetnick, new);
192 strcpy(botnetnick, new);
193 }
194 }
195 }
196
197 /**********************************************************************/
198
199 int init_dcc_max(), init_misc();
200
201 /* used for read/write to integer couplets */
202 typedef struct {
203 int *left; /* left side of couplet */
204 int *right; /* right side */
205 } coupletinfo;
206
207 /* read/write integer couplets (int1:int2) */
208 static char *tcl_eggcouplet(ClientData cdata, Tcl_Interp * irp, char *name1,
209 char *name2, int flags)
210 {
211 char *s, s1[41];
212 coupletinfo *cp = (coupletinfo *) cdata;
213
214 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
215 sprintf(s1, "%d:%d", *(cp->left), *(cp->right));
216 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
217 if (flags & TCL_TRACE_UNSETS)
218 Tcl_TraceVar(interp, name1,
219 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
220 tcl_eggcouplet, cdata);
221 } else { /* writes */
222 s = Tcl_GetVar2(interp, name1, name2, TCL_GLOBAL_ONLY);
223 if (s != NULL) {
224 int nr1, nr2;
225
226 if (strlen(s) > 40)
227 s[40] = 0;
228 sscanf(s, "%d%*c%d", &nr1, &nr2);
229 *(cp->left) = nr1;
230 *(cp->right) = nr2;
231 }
232 }
233 return NULL;
234 }
235
236 /* read/write normal integer */
237 static char *tcl_eggint(ClientData cdata, Tcl_Interp * irp, char *name1,
238 char *name2, int flags)
239 {
240 char *s, s1[40];
241 long l;
242 intinfo *ii = (intinfo *) cdata;
243
244 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
245 /* special cases */
246 if ((int *) ii->var == &conmask)
247 strcpy(s1, masktype(conmask));
248 else if ((int *) ii->var == &default_flags) {
249 struct flag_record fr =
250 {FR_GLOBAL, 0, 0, 0, 0, 0};
251 fr.global = default_flags;
252 fr.udef_global = default_uflags;
253 build_flags(s1, &fr, 0);
254 } else
255 sprintf(s1, "%d", *(int *) ii->var);
256 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
257 if (flags & TCL_TRACE_UNSETS)
258 Tcl_TraceVar(interp, name1,
259 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
260 tcl_eggint, cdata);
261 return NULL;
262 } else { /* writes */
263 s = Tcl_GetVar2(interp, name1, name2, TCL_GLOBAL_ONLY);
264 if (s != NULL) {
265 if ((int *) ii->var == &conmask) {
266 if (s[0])
267 conmask = logmodes(s);
268 else
269 conmask = LOG_MODES | LOG_MISC | LOG_CMDS;
270 } else if ((int *) ii->var == &default_flags) {
271 struct flag_record fr =
272 {FR_GLOBAL, 0, 0, 0, 0, 0};
273
274 break_down_flags(s, &fr, 0);
275 default_flags = sanity_check(fr.global); /* drummer */
276 default_uflags = fr.udef_global;
277 } else if ((ii->ro == 2) || ((ii->ro == 1) && protect_readonly)) {
278 return "read-only variable";
279 } else {
280 if (Tcl_ExprLong(interp, s, &l) == TCL_ERROR)
281 return interp->result;
282 if ((int *) ii->var == &max_dcc) {
283 if (l < max_dcc)
284 return "you can't DECREASE max-dcc";
285 max_dcc = l;
286 init_dcc_max();
287 } else if ((int *) ii->var == &max_logs) {
288 if (l < max_logs)
289 return "you can't DECREASE max-logs";
290 max_logs = l;
291 init_misc();
292 } else
293 *(ii->var) = (int) l;
294 }
295 }
296 return NULL;
297 }
298 }
299
300 /* read/write normal string variable */
301 static char *tcl_eggstr(ClientData cdata, Tcl_Interp * irp, char *name1,
302 char *name2, int flags)
303 {
304 char *s;
305 strinfo *st = (strinfo *) cdata;
306
307 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
308 if ((st->str == firewall) && (firewall[0])) {
309 char s1[161];
310
311 sprintf(s1, "%s:%d", firewall, firewallport);
312 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
313 } else
314 Tcl_SetVar2(interp, name1, name2, st->str, TCL_GLOBAL_ONLY);
315 if (flags & TCL_TRACE_UNSETS) {
316 Tcl_TraceVar(interp, name1, TCL_TRACE_READS | TCL_TRACE_WRITES |
317 TCL_TRACE_UNSETS, tcl_eggstr, cdata);
318 if ((st->max <= 0) && (protect_readonly || (st->max == 0)))
319 return "read-only variable"; /* it won't return the error... */
320 }
321 return NULL;
322 } else { /* writes */
323 if ((st->max <= 0) && (protect_readonly || (st->max == 0))) {
324 Tcl_SetVar2(interp, name1, name2, st->str, TCL_GLOBAL_ONLY);
325 return "read-only variable";
326 }
327 s = Tcl_GetVar2(interp, name1, name2, TCL_GLOBAL_ONLY);
328 if (s != NULL) {
329 if (strlen(s) > abs(st->max))
330 s[abs(st->max)] = 0;
331 if (st->str == botnetnick)
332 botnet_change(s);
333 else if (st->str == firewall) {
334 splitc(firewall, s, ':');
335 if (!firewall[0])
336 strcpy(firewall, s);
337 else
338 firewallport = atoi(s);
339 } else
340 strcpy(st->str, s);
341 if ((st->flags) && (s[0])) {
342 if (st->str[strlen(st->str) - 1] != '/')
343 strcat(st->str, "/");
344 }
345 }
346 return NULL;
347 }
348 }
349
350 /* add/remove tcl commands */
351 void add_tcl_commands(tcl_cmds * tab)
352 {
353 int i;
354
355 for (i = 0; tab[i].name; i++)
356 Tcl_CreateCommand(interp, tab[i].name, tab[i].func, NULL, NULL);
357 }
358
359 void rem_tcl_commands(tcl_cmds * tab)
360 {
361 int i;
362
363 for (i = 0; tab[i].name; i++)
364 Tcl_DeleteCommand(interp, tab[i].name);
365 }
366
367 static tcl_strings def_tcl_strings[] =
368 {
369 {"botnet-nick", botnetnick, HANDLEN, 0},
370 {"userfile", userfile, 120, STR_PROTECT},
371 {"motd", motdfile, 120, STR_PROTECT},
372 {"admin", admin, 120, 0},
373 {"help-path", helpdir, 120, STR_DIR | STR_PROTECT},
374 {"temp-path", tempdir, 120, STR_DIR | STR_PROTECT},
375 #ifndef STATIC
376 {"mod-path", moddir, 120, STR_DIR | STR_PROTECT},
377 #endif
378 {"notify-newusers", notify_new, 120, 0},
379 {"owner", owner, 120, STR_PROTECT},
380 {"my-hostname", hostname, 120, 0},
381 {"my-ip", myip, 120, 0},
382 {"network", network, 40, 0},
383 {"whois-fields", whois_fields, 1024, 0},
384 {"nat-ip", natip, 120, 0},
385 {"username", botuser, 10, 0},
386 {"version", egg_version, 0, 0},
387 {"firewall", firewall, 120, 0},
388 /* confvar patch by aaronwl */
389 {"config", configfile, 0, 0},
390 {"telnet-banner", bannerfile, 120, STR_PROTECT},
391 {0, 0, 0, 0}
392 };
393
394 /* ints */
395
396 static tcl_ints def_tcl_ints[] =
397 {
398 {"ignore-time", &ignore_time, 0},
399 {"dcc-flood-thr", &dcc_flood_thr, 0},
400 {"hourly-updates", &notify_users_at, 0},
401 {"switch-logfiles-at", &switch_logfiles_at, 0},
402 {"connect-timeout", &connect_timeout, 0},
403 {"reserved-port", &reserved_port, 0},
404 /* booleans (really just ints) */
405 {"require-p", &require_p, 0},
406 {"keep-all-logs", &keep_all_logs, 0},
407 {"open-telnets", &allow_new_telnets, 0},
408 {"stealth-telnets", &stealth_telnets, 0},
409 {"use-telnet-banner", &use_telnet_banner, 0},
410 {"uptime", (int *) &online_since, 2},
411 {"console", &conmask, 0},
412 {"default-flags", &default_flags, 0},
413 /* moved from eggdrop.h */
414 {"numversion", &egg_numver, 2},
415 {"debug-tcl", &debug_tcl, 1},
416 {"die-on-sighup", &die_on_sighup, 1},
417 {"die-on-sigterm", &die_on_sigterm, 1},
418 {"remote-boots", &remote_boots, 1},
419 {"max-dcc", &max_dcc, 0},
420 {"max-logs", &max_logs, 0},
421 {"max-logsize", &max_logsize, 0},
422 {"quick-logs", &quick_logs, 0},
423 {"enable-simul", &enable_simul, 1},
424 {"debug-output", &debug_output, 1},
425 {"protect-telnet", &protect_telnet, 0},
426 {"dcc-sanitycheck", &dcc_sanitycheck, 0},
427 {"sort-users", &sort_users, 0},
428 {"ident-timeout", &identtimeout, 0},
429 {"share-unlinks", &share_unlinks, 0},
430 {"log-time", &shtime, 0},
431 {"allow-dk-cmds", &allow_dk_cmds, 0},
432 {"resolve-timeout", &resolve_timeout, 0},
433 {"must-be-owner", &must_be_owner, 1},
434 {"use-silence", &use_silence, 0}, /* arthur2 */
435 {"paranoid-telnet-flood", &par_telnet_flood, 0},
436 {"use-exempts", &use_exempts, 0}, /* Jason/drummer */
437 {"use-invites", &use_invites, 0}, /* Jason/drummer */
438 {"quiet-save", &quiet_save, 0}, /* Lucas */
439 {"force-expire", &force_expire, 0}, /* Rufus */
440 {"strict-host", &strict_host, 0}, /* moved from server.mod & irc.mod */
441 {0, 0, 0} /* arthur2 */
442 };
443
444 static tcl_coups def_tcl_coups[] =
445 {
446 {"telnet-flood", &flood_telnet_thr, &flood_telnet_time},
447 {"dcc-portrange", &min_dcc_port, &max_dcc_port}, /* dw */
448 {0, 0, 0}
449 };
450
451 /* set up Tcl variables that will hook into eggdrop internal vars via */
452 /* trace callbacks */
453 static void init_traces()
454 {
455 add_tcl_coups(def_tcl_coups);
456 add_tcl_strings(def_tcl_strings);
457 add_tcl_ints(def_tcl_ints);
458 }
459
460 void kill_tcl()
461 {
462 Context;
463 rem_tcl_coups(def_tcl_coups);
464 rem_tcl_strings(def_tcl_strings);
465 rem_tcl_ints(def_tcl_ints);
466 kill_bind();
467 Tcl_DeleteInterp(interp);
468 }
469
470 extern tcl_cmds tcluser_cmds[], tcldcc_cmds[], tclmisc_cmds[];
471
472 /* not going through Tcl's crazy main() system (what on earth was he
473 * smoking?!) so we gotta initialize the Tcl interpreter */
474 void init_tcl(int argc, char **argv)
475 {
476 #ifndef HAVE_PRE7_5_TCL
477 int i;
478 char pver[1024] = "";
479 #endif
480
481 Context;
482 #ifndef HAVE_PRE7_5_TCL
483 /* This is used for 'info nameofexecutable'.
484 * The filename in argv[0] must exist in a directory listed in
485 * the environment variable PATH for it to register anything. */
486 Tcl_FindExecutable(argv[0]);
487 #endif
488
489 /* initialize the interpreter */
490 interp = Tcl_CreateInterp();
491 Tcl_Init(interp);
492
493 #ifdef DEBUG_MEM
494 /* initialize Tcl's memory debugging if we have it */
495 Tcl_InitMemory(interp);
496 #endif
497
498 /* set Tcl variable tcl_interactive to 0 */
499 Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
500
501 /* initialize binds and traces */
502 init_bind();
503 init_traces();
504
505 /* add new commands */
506 Tcl_CreateCommand(interp, "logfile", tcl_logfile, NULL, NULL);
507 /* isnt this much neater :) */
508 add_tcl_commands(tcluser_cmds);
509 add_tcl_commands(tcldcc_cmds);
510 add_tcl_commands(tclmisc_cmds);
511
512 #ifndef HAVE_PRE7_5_TCL
513 /* add eggdrop to Tcl's package list */
514 for (i = 0; i <= strlen(egg_version); i++) {
515 if ((egg_version[i] == ' ') || (egg_version[i] == '+'))
516 break;
517 pver[strlen(pver)] = egg_version[i];
518 }
519 Tcl_PkgProvide(interp, "eggdrop", pver);
520 #endif
521 }
522
523 /**********************************************************************/
524
525 void do_tcl(char *whatzit, char *script)
526 {
527 int code;
528 FILE *f = 0;
529
530 if (debug_tcl) {
531 f = fopen("DEBUG.TCL", "a");
532 if (f != NULL)
533 fprintf(f, "eval: %s\n", script);
534 }
535 Context;
536 code = Tcl_Eval(interp, script);
537 if (debug_tcl && (f != NULL)) {
538 fprintf(f, "done eval, result=%d\n", code);
539 fclose(f);
540 }
541 if (code != TCL_OK) {
542 putlog(LOG_MISC, "*", "Tcl error in script for '%s':", whatzit);
543 putlog(LOG_MISC, "*", "%s", interp->result);
544 }
545 }
546
547 /* Read the tcl file fname into memory and interpret it. Not using
548 * Tcl_EvalFile avoids problems with high ascii characters.
549 *
550 * returns: 1 - if everything was okay
551 */
552 int readtclprog(char *fname)
553 {
554 int code;
555 long size;
556 char *script;
557 FILE *f;
558
559 if ((f = fopen(fname, "r")) == NULL)
560 return 0;
561
562 /* Find out file size. */
563 fseek(f, 0, SEEK_END);
564 size = ftell(f);
565 fseek(f, 0, SEEK_SET);
566
567 /* Allocate buffer to save the file's data in. */
568 if ((script = nmalloc(size + 1)) == NULL) {
569 fclose(f);
570 return 0;
571 }
572 script[size] = 0;
573
574 /* Read file's data to the allocated buffer. */
575 fread(script, 1, size, f);
576 fclose(f);
577
578 if (debug_tcl) {
579 if ((f = fopen("DEBUG.TCL", "a")) != NULL)
580 fprintf(f, "*** eval: %s\n", script);
581 }
582 code = Tcl_Eval(interp, script);
583 nfree(script);
584 if (debug_tcl && f) {
585 fprintf(f, "*** done eval, result=%d\n", code);
586 fclose(f);
587 }
588
589 if (code != TCL_OK) {
590 putlog(LOG_MISC, "*", "Tcl error in file '%s':", fname);
591 putlog(LOG_MISC, "*", "%s",
592 Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
593 return 0;
594 }
595
596 /* Refresh internal variables */
597 return 1;
598 }
599
600 void add_tcl_strings(tcl_strings * list)
601 {
602 int i, tmp;
603 strinfo *st;
604
605 for (i = 0; list[i].name; i++) {
606 st = (strinfo *) nmalloc(sizeof(strinfo));
607 strtot += sizeof(strinfo);
608 st->max = list[i].length - (list[i].flags & STR_DIR);
609 if (list[i].flags & STR_PROTECT)
610 st->max = -st->max;
611 st->str = list[i].buf;
612 st->flags = (list[i].flags & STR_DIR);
613 tmp = protect_readonly;
614 protect_readonly = 0;
615 tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_WRITES);
616 protect_readonly = tmp;
617 tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_READS);
618 Tcl_TraceVar(interp, list[i].name, TCL_TRACE_READS | TCL_TRACE_WRITES |
619 TCL_TRACE_UNSETS, tcl_eggstr, (ClientData) st);
620 }
621 }
622
623 void rem_tcl_strings(tcl_strings * list)
624 {
625 int i;
626 strinfo *st;
627
628 for (i = 0; list[i].name; i++) {
629 st = (strinfo *) Tcl_VarTraceInfo(interp, list[i].name,
630 TCL_TRACE_READS |
631 TCL_TRACE_WRITES |
632 TCL_TRACE_UNSETS,
633 tcl_eggstr, NULL);
634 Tcl_UntraceVar(interp, list[i].name,
635 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
636 tcl_eggstr, st);
637 if (st != NULL) {
638 strtot -= sizeof(strinfo);
639 nfree(st);
640 }
641 }
642 }
643
644 void add_tcl_ints(tcl_ints * list)
645 {
646 int i, tmp;
647 intinfo *ii;
648
649 for (i = 0; list[i].name; i++) {
650 ii = nmalloc(sizeof(intinfo));
651 strtot += sizeof(intinfo);
652 ii->var = list[i].val;
653 ii->ro = list[i].readonly;
654 tmp = protect_readonly;
655 protect_readonly = 0;
656 tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_WRITES);
657 protect_readonly = tmp;
658 tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_READS);
659 Tcl_TraceVar(interp, list[i].name,
660 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
661 tcl_eggint, (ClientData) ii);
662 }
663
664 }
665
666 void rem_tcl_ints(tcl_ints * list)
667 {
668 int i;
669 intinfo *ii;
670
671 for (i = 0; list[i].name; i++) {
672 ii = (intinfo *) Tcl_VarTraceInfo(interp, list[i].name,
673 TCL_TRACE_READS |
674 TCL_TRACE_WRITES |
675 TCL_TRACE_UNSETS,
676 tcl_eggint, NULL);
677 Tcl_UntraceVar(interp, list[i].name,
678 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
679 tcl_eggint, (ClientData) ii);
680 if (ii) {
681 strtot -= sizeof(intinfo);
682 nfree(ii);
683 }
684 }
685 }
686
687 /* allocate couplet space for tracing couplets */
688 void add_tcl_coups(tcl_coups * list)
689 {
690 coupletinfo *cp;
691 int i;
692
693 for (i = 0; list[i].name; i++) {
694 cp = (coupletinfo *) nmalloc(sizeof(coupletinfo));
695 strtot += sizeof(coupletinfo);
696 cp->left = list[i].lptr;
697 cp->right = list[i].rptr;
698
699 tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL, TCL_TRACE_WRITES);
700 tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL, TCL_TRACE_READS);
701 Tcl_TraceVar(interp, list[i].name,
702 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
703 tcl_eggcouplet, (ClientData) cp);
704 }
705 }
706
707 void rem_tcl_coups(tcl_coups * list)
708 {
709 coupletinfo *cp;
710 int i;
711
712 for (i = 0; list[i].name; i++) {
713 cp = (coupletinfo *) Tcl_VarTraceInfo(interp, list[i].name,
714 TCL_TRACE_READS |
715 TCL_TRACE_WRITES |
716 TCL_TRACE_UNSETS,
717 tcl_eggcouplet, NULL);
718 strtot -= sizeof(coupletinfo);
719 Tcl_UntraceVar(interp, list[i].name,
720 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
721 tcl_eggcouplet, (ClientData) cp);
722 nfree(cp);
723 }
724 }

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23