/[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.24 - (show annotations) (download) (as text)
Wed Dec 15 02:32:58 1999 UTC (19 years, 9 months ago) by guppy
Branch: MAIN
Changes since 1.23: +23 -10 lines
File MIME type: text/x-chdr
id-header patch, finally, we have id tags for each file

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23