/[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.25 - (show annotations) (download) (as text)
Tue Dec 28 01:46:26 1999 UTC (19 years, 8 months ago) by guppy
Branch: MAIN
Changes since 1.24: +3 -1 lines
File MIME type: text/x-chdr
stricthost

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23