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

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

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


Revision 1.24 - (show annotations) (download) (as text)
Fri Aug 11 22:40:26 2000 UTC (19 years, 3 months ago) by fabian
Branch: MAIN
CVS Tags: eggdrop105040
Changes since 1.23: +36 -15 lines
File MIME type: text/x-chdr
resync with 1.4, Aug12 966031001

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23