/[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.15 - (show annotations) (download) (as text)
Sat Oct 9 17:33:47 1999 UTC (19 years, 11 months ago) by arthur2
Branch: MAIN
Changes since 1.14: +3 -1 lines
File MIME type: text/x-chdr
tcl-version-checking.diff

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23