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

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

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


Revision 1.9.2.4 - (show annotations) (download) (as text)
Sat Jun 16 15:59:49 2012 UTC (6 years, 11 months ago) by thommey
Branch: gettext
Changes since 1.9.2.3: +3 -1 lines
File MIME type: text/x-chdr
Call Tcl's bgerror on Eggdrop background errors.

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.9.2.3 2011/09/09 21:39:14 thommey Exp $
8 */
9 /*
10 * Copyright (C) 1997 Robey Pointer
11 * Copyright (C) 1999 - 2010 Eggheads Development Team
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 <stdlib.h> /* getenv() */
29 #include <locale.h> /* setlocale() */
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
36 * when protect is on) (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
46 extern time_t online_since;
47
48 extern char origbotname[], botuser[], motdfile[], admin[], userfile[],
49 firewall[], helpdir[], notify_new[], vhost[], moddir[],
50 tempdir[], owner[], network[], botnetnick[], bannerfile[],
51 egg_version[], natip[], configfile[], logfile_suffix[], log_ts[],
52 textdir[], pid_file[], listen_ip[];
53
54
55 extern int flood_telnet_thr, flood_telnet_time, shtime, share_greet,
56 require_p, keep_all_logs, allow_new_telnets, stealth_telnets,
57 use_telnet_banner, default_flags, conmask, switch_logfiles_at,
58 connect_timeout, firewallport, notify_users_at, flood_thr, tands,
59 ignore_time, reserved_port_min, reserved_port_max, max_logs,
60 max_logsize, dcc_total, raw_log, identtimeout, dcc_sanitycheck,
61 dupwait_timeout, egg_numver, share_unlinks, protect_telnet,
62 strict_host, resolve_timeout, default_uflags, userfile_perm,
63 cidr_support;
64
65 #ifdef IPV6
66 extern char vhost6[];
67 extern int pref_af;
68 #endif
69
70 #ifdef TLS
71 extern int tls_maxdepth, tls_vfybots, tls_vfyclients, tls_vfydcc, tls_auth;
72 extern char tls_capath[], tls_cafile[], tls_certfile[], tls_keyfile[],
73 tls_ciphers[];
74 #endif
75
76 extern struct dcc_t *dcc;
77 extern tcl_timer_t *timer, *utimer;
78
79 Tcl_Interp *interp;
80
81 int protect_readonly = 0; /* Enable read-only protection? */
82 char whois_fields[1025] = "";
83
84 int dcc_flood_thr = 3;
85 int use_invites = 0;
86 int use_exempts = 0;
87 int force_expire = 0;
88 int remote_boots = 2;
89 int allow_dk_cmds = 1;
90 int must_be_owner = 1;
91 int quiet_reject = 1;
92 int copy_to_tmp = 1;
93 int max_socks = 100;
94 int quick_logs = 0;
95 int par_telnet_flood = 1;
96 int quiet_save = 0;
97 int strtot = 0;
98 int handlen = HANDLEN;
99 int utftot = 0;
100 int clientdata_stuff = 0;
101
102 /* Prototypes for Tcl */
103 Tcl_Interp *Tcl_CreateInterp();
104
105 int expmem_tcl()
106 {
107 return strtot + utftot + clientdata_stuff;
108 }
109
110 static void botnet_change(char *new)
111 {
112 if (egg_strcasecmp(botnetnick, new)) {
113 /* Trying to change bot's nickname */
114 if (tands > 0) {
115 putlog(LOG_MISC, "*", _("* Tried to change my botnet nick, but I'm still "
116 "linked to a botnet."));
117 putlog(LOG_MISC, "*", _("* (Unlink and try again.)"));
118 return;
119 } else {
120 if (botnetnick[0])
121 putlog(LOG_MISC, "*", _("* IDENTITY CHANGE: %s -> %s"), botnetnick, new);
122 strcpy(botnetnick, new);
123 }
124 }
125 }
126
127
128 /*
129 * Vars, traces, misc
130 */
131
132 int init_misc();
133
134 /* Used for read/write to integer couplets */
135 typedef struct {
136 int *left; /* left side of couplet */
137 int *right; /* right side */
138 } coupletinfo;
139
140 /* FIXME: tcl_eggcouplet() should be redesigned so we can use
141 * TCL_TRACE_WRITES | TCL_TRACE_READS as the bit mask instead
142 * of 2 calls as is done in add_tcl_coups().
143 */
144 /* Read/write integer couplets (int1:int2) */
145 static char *tcl_eggcouplet(ClientData cdata, Tcl_Interp *irp,
146 EGG_CONST char *name1,
147 EGG_CONST char *name2, int flags)
148 {
149 char *s, s1[41];
150 coupletinfo *cp = (coupletinfo *) cdata;
151
152 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
153 egg_snprintf(s1, sizeof s1, "%d:%d", *(cp->left), *(cp->right));
154 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
155 if (flags & TCL_TRACE_UNSETS)
156 Tcl_TraceVar(interp, name1,
157 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
158 tcl_eggcouplet, cdata);
159 } else { /* writes */
160 s = (char *) Tcl_GetVar2(interp, name1, name2, 0);
161 if (s != NULL) {
162 int nr1, nr2;
163
164 nr1 = nr2 = 0;
165
166 if (strlen(s) > 40)
167 s[40] = 0;
168
169 sscanf(s, "%d%*c%d", &nr1, &nr2);
170 *(cp->left) = nr1;
171 *(cp->right) = nr2;
172 }
173 }
174 return NULL;
175 }
176
177 /* Read or write normal integer.
178 */
179 static char *tcl_eggint(ClientData cdata, Tcl_Interp *irp,
180 EGG_CONST char *name1,
181 EGG_CONST char *name2, int flags)
182 {
183 char *s, s1[40];
184 long l;
185 intinfo *ii = (intinfo *) cdata;
186
187 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
188 /* Special cases */
189 if ((int *) ii->var == &conmask)
190 strcpy(s1, masktype(conmask));
191 else if ((int *) ii->var == &default_flags) {
192 struct flag_record fr = { FR_GLOBAL, 0, 0, 0, 0, 0 };
193 fr.global = default_flags;
194
195 fr.udef_global = default_uflags;
196 build_flags(s1, &fr, 0);
197 } else if ((int *) ii->var == &userfile_perm) {
198 egg_snprintf(s1, sizeof s1, "0%o", userfile_perm);
199 } else
200 egg_snprintf(s1, sizeof s1, "%d", *(int *) ii->var);
201 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
202 if (flags & TCL_TRACE_UNSETS)
203 Tcl_TraceVar(interp, name1,
204 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
205 tcl_eggint, cdata);
206 return NULL;
207 } else { /* Writes */
208 s = (char *) Tcl_GetVar2(interp, name1, name2, TCL_GLOBAL_ONLY);
209 if (s != NULL) {
210 if ((int *) ii->var == &conmask) {
211 if (s[0])
212 conmask = logmodes(s);
213 else
214 conmask = LOG_MODES | LOG_MISC | LOG_CMDS;
215 } else if ((int *) ii->var == &default_flags) {
216 struct flag_record fr = { FR_GLOBAL, 0, 0, 0, 0, 0 };
217
218 break_down_flags(s, &fr, 0);
219 default_flags = sanity_check(fr.global); /* drummer */
220
221 default_uflags = fr.udef_global;
222 } else if ((int *) ii->var == &userfile_perm) {
223 int p = oatoi(s);
224
225 if (p <= 0)
226 return "invalid userfile permissions";
227 userfile_perm = p;
228 } else if ((ii->ro == 2) || ((ii->ro == 1) && protect_readonly))
229 return "read-only variable";
230 else {
231 if (Tcl_ExprLong(interp, s, &l) == TCL_ERROR)
232 return "variable must have integer value";
233 if ((int *) ii->var == &max_socks) {
234 if (l < threaddata()->MAXSOCKS)
235 return "you can't DECREASE max-socks below current usage";
236 max_socks = l;
237 } else if ((int *) ii->var == &max_logs) {
238 if (l < max_logs)
239 return "you can't DECREASE max-logs";
240 max_logs = l;
241 init_misc();
242 } else
243 *(ii->var) = (int) l;
244 }
245 }
246 return NULL;
247 }
248 }
249
250 /* Read/write normal string variable
251 */
252 static char *tcl_eggstr(ClientData cdata, Tcl_Interp *irp,
253 EGG_CONST char *name1,
254 EGG_CONST char *name2, int flags)
255 {
256 char *s;
257 strinfo *st = (strinfo *) cdata;
258
259 if (flags & (TCL_TRACE_READS | TCL_TRACE_UNSETS)) {
260 if ((st->str == firewall) && (firewall[0])) {
261 char s1[127];
262
263 egg_snprintf(s1, sizeof s1, "%s:%d", firewall, firewallport);
264 Tcl_SetVar2(interp, name1, name2, s1, TCL_GLOBAL_ONLY);
265 } else
266 Tcl_SetVar2(interp, name1, name2, st->str, TCL_GLOBAL_ONLY);
267 if (flags & TCL_TRACE_UNSETS) {
268 Tcl_TraceVar(interp, name1, TCL_TRACE_READS | TCL_TRACE_WRITES |
269 TCL_TRACE_UNSETS, tcl_eggstr, cdata);
270 if ((st->max <= 0) && (protect_readonly || (st->max == 0)))
271 return "read-only variable"; /* it won't return the error... */
272 }
273 return NULL;
274 } else { /* writes */
275 if ((st->max <= 0) && (protect_readonly || (st->max == 0))) {
276 Tcl_SetVar2(interp, name1, name2, st->str, TCL_GLOBAL_ONLY);
277 return "read-only variable";
278 }
279 #ifdef USE_TCL_BYTE_ARRAYS
280 # undef malloc
281 # undef free
282 {
283 Tcl_Obj *obj;
284 unsigned char *bytes;
285 int len;
286
287 obj = Tcl_GetVar2Ex(interp, name1, name2, 0);
288 if (!obj)
289 return NULL;
290 len = 0;
291 bytes = Tcl_GetByteArrayFromObj(obj, &len);
292 if (!bytes)
293 return NULL;
294 s = malloc(len + 1);
295 memcpy(s, bytes, len);
296 s[len] = 0;
297 }
298 #else
299 s = (char *) Tcl_GetVar2(interp, name1, name2, 0);
300 #endif /* USE_TCL_BYTE_ARRAYS */
301 if (s != NULL) {
302 if (strlen(s) > abs(st->max))
303 s[abs(st->max)] = 0;
304 if (st->str == botnetnick)
305 botnet_change(s);
306 else if (st->str == logfile_suffix)
307 logsuffix_change(s);
308 else if (st->str == firewall) {
309 splitc(firewall, s, ':');
310 if (!firewall[0])
311 strcpy(firewall, s);
312 else
313 firewallport = atoi(s);
314 } else
315 strcpy(st->str, s);
316 if ((st->flags) && (s[0])) {
317 if (st->str[strlen(st->str) - 1] != '/')
318 strcat(st->str, "/");
319 }
320 #ifdef USE_TCL_BYTE_ARRAYS
321 free(s);
322 #endif /* USE_TCL_BYTE_ARRAYS */
323 }
324 return NULL;
325 }
326 }
327
328 /* Add/remove tcl commands
329 */
330
331 #ifdef USE_TCL_BYTE_ARRAYS
332 static int utf_converter(ClientData cdata, Tcl_Interp *myinterp, int objc,
333 Tcl_Obj *CONST objv[])
334 {
335 char **strings, *byteptr;
336 int i, len, retval, diff;
337 void **callback_data;
338 Function func;
339 ClientData cd;
340
341 objc += 5;
342 strings = (char **) nmalloc(sizeof(char *) * objc);
343 memset(strings, 0, sizeof(char *) * objc);
344 diff = utftot;
345 utftot += sizeof(char *) * objc;
346 objc -= 5;
347 for (i = 0; i < objc; i++) {
348 byteptr = (char *) Tcl_GetByteArrayFromObj(objv[i], &len);
349 strings[i] = (char *) nmalloc(len + 1);
350 utftot += len + 1;
351 strncpy(strings[i], byteptr, len);
352 strings[i][len] = 0;
353 }
354 callback_data = (void **) cdata;
355 func = (Function) callback_data[0];
356 cd = (ClientData) callback_data[1];
357 diff -= utftot;
358 retval = func(cd, myinterp, objc, strings);
359 for (i = 0; i < objc; i++)
360 nfree(strings[i]);
361 nfree(strings);
362 utftot += diff;
363 return retval;
364 }
365
366 void cmd_delete_callback(ClientData cdata)
367 {
368 nfree(cdata);
369 clientdata_stuff -= sizeof(void *) * 2;
370 }
371 #endif /* USE_TCL_BYTE_ARRAYS */
372
373 #ifdef USE_TCL_BYTE_ARRAYS
374 void add_tcl_commands(tcl_cmds *table)
375 {
376 void **cdata;
377
378 while (table->name) {
379 cdata = (void **) nmalloc(sizeof(void *) * 2);
380 clientdata_stuff += sizeof(void *) * 2;
381 cdata[0] = (void *)table->func;
382 cdata[1] = NULL;
383 Tcl_CreateObjCommand(interp, table->name, utf_converter, (ClientData) cdata,
384 cmd_delete_callback);
385 table++;
386 }
387 }
388
389 #else /* USE_TCL_BYTE_ARRAYS */
390
391 void add_tcl_commands(tcl_cmds *table)
392 {
393 int i;
394
395 for (i = 0; table[i].name; i++)
396 Tcl_CreateCommand(interp, table[i].name, table[i].func, NULL, NULL);
397 }
398 #endif /* USE_TCL_BYTE_ARRAYS */
399
400 #ifdef USE_TCL_BYTE_ARRAYS
401 void add_cd_tcl_cmds(cd_tcl_cmd *table)
402 {
403 void **cdata;
404
405 while (table->name) {
406 cdata = nmalloc(sizeof(void *) * 2);
407 clientdata_stuff += sizeof(void *) * 2;
408 cdata[0] = (void *)table->callback;
409 cdata[1] = table->cdata;
410 Tcl_CreateObjCommand(interp, table->name, utf_converter, (ClientData) cdata,
411 cmd_delete_callback);
412 table++;
413 }
414 }
415
416 #else /* USE_TCL_BYTE_ARRAYS */
417
418 void add_cd_tcl_cmds(cd_tcl_cmd *table)
419 {
420 while (table->name) {
421 Tcl_CreateCommand(interp, table->name, table->callback,
422 (ClientData) table->cdata, NULL);
423 table++;
424 }
425 }
426 #endif /* USE_TCL_BYTE_ARRAYS */
427
428 void rem_tcl_commands(tcl_cmds *table)
429 {
430 int i;
431
432 for (i = 0; table[i].name; i++)
433 Tcl_DeleteCommand(interp, table[i].name);
434 }
435
436 void rem_cd_tcl_cmds(cd_tcl_cmd *table)
437 {
438 while (table->name) {
439 Tcl_DeleteCommand(interp, table->name);
440 table++;
441 }
442 }
443
444 #ifdef USE_TCL_OBJ
445 void add_tcl_objcommands(tcl_cmds *table)
446 {
447 int i;
448
449 for (i = 0; table[i].name; i++)
450 Tcl_CreateObjCommand(interp, table[i].name, table[i].func, (ClientData) 0,
451 NULL);
452 }
453 #endif
454
455 /* Get the current tcl result string. */
456 const char *tcl_resultstring()
457 {
458 const char *result;
459 #ifdef USE_TCL_OBJ
460 result = Tcl_GetStringResult(interp);
461 #else
462 result = interp->result;
463 #endif
464 return result;
465 }
466
467 int tcl_resultempty() {
468 const char *result;
469 result = tcl_resultstring();
470 return (result && result[0]) ? 0 : 1;
471 }
472
473 /* Get the current tcl result as int. replaces atoi(interp->result) */
474 int tcl_resultint()
475 {
476 int result;
477 #ifdef USE_TCL_OBJ
478 if (Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(interp), &result) != TCL_OK)
479 #else
480 if (Tcl_GetInt(NULL, interp->result, &result) != TCL_OK)
481 #endif
482 result = 0;
483 return result;
484 }
485
486 static tcl_strings def_tcl_strings[] = {
487 {"botnet-nick", botnetnick, HANDLEN, 0},
488 {"userfile", userfile, 120, STR_PROTECT},
489 {"motd", motdfile, 120, STR_PROTECT},
490 {"admin", admin, 120, 0},
491 {"help-path", helpdir, 120, STR_DIR | STR_PROTECT},
492 {"temp-path", tempdir, 120, STR_DIR | STR_PROTECT},
493 {"text-path", textdir, 120, STR_DIR | STR_PROTECT},
494 #ifdef TLS
495 {"ssl-capath", tls_capath, 120, STR_DIR | STR_PROTECT},
496 {"ssl-cafile", tls_cafile, 120, STR_PROTECT},
497 {"ssl-ciphers", tls_ciphers, 120, STR_PROTECT},
498 {"ssl-privatekey", tls_keyfile, 120, STR_PROTECT},
499 {"ssl-certificate", tls_certfile, 120, STR_PROTECT},
500 #endif
501 #ifndef STATIC
502 {"mod-path", moddir, 120, STR_DIR | STR_PROTECT},
503 #endif
504 {"notify-newusers", notify_new, 120, 0},
505 {"owner", owner, 120, STR_PROTECT},
506 {"vhost4", vhost, 120, 0},
507 #ifdef IPV6
508 {"vhost6", vhost6, 120, 0},
509 #endif
510 {"listen-addr", listen_ip, 120, 0},
511 {"network", network, 40, 0},
512 {"whois-fields", whois_fields, 1024, 0},
513 {"nat-ip", natip, 120, 0},
514 {"username", botuser, 10, 0},
515 {"version", egg_version, 0, 0},
516 {"firewall", firewall, 120, 0},
517 {"config", configfile, 0, 0},
518 {"telnet-banner", bannerfile, 120, STR_PROTECT},
519 {"logfile-suffix", logfile_suffix, 20, 0},
520 {"timestamp-format",log_ts, 32, 0},
521 {"pidfile", pid_file, 120, STR_PROTECT},
522 {NULL, NULL, 0, 0}
523 };
524
525 static tcl_ints def_tcl_ints[] = {
526 {"ignore-time", &ignore_time, 0},
527 {"handlen", &handlen, 2},
528 #ifdef TLS
529 {"ssl-chain-depth", &tls_maxdepth, 0},
530 {"ssl-verify-dcc", &tls_vfydcc, 0},
531 {"ssl-verify-clients", &tls_vfyclients, 0},
532 {"ssl-verify-bots", &tls_vfybots, 0},
533 {"ssl-cert-auth", &tls_auth, 0},
534 #endif
535 {"dcc-flood-thr", &dcc_flood_thr, 0},
536 {"hourly-updates", &notify_users_at, 0},
537 {"switch-logfiles-at", &switch_logfiles_at, 0},
538 {"connect-timeout", &connect_timeout, 0},
539 {"reserved-port", &reserved_port_min, 0},
540 {"require-p", &require_p, 0},
541 {"keep-all-logs", &keep_all_logs, 0},
542 {"open-telnets", &allow_new_telnets, 0},
543 {"stealth-telnets", &stealth_telnets, 0},
544 {"use-telnet-banner", &use_telnet_banner, 0},
545 {"uptime", (int *) &online_since, 2},
546 {"console", &conmask, 0},
547 {"default-flags", &default_flags, 0},
548 {"numversion", &egg_numver, 2},
549 {"remote-boots", &remote_boots, 1},
550 {"max-socks", &max_socks, 0},
551 {"max-logs", &max_logs, 0},
552 {"max-logsize", &max_logsize, 0},
553 {"quick-logs", &quick_logs, 0},
554 {"raw-log", &raw_log, 1},
555 {"protect-telnet", &protect_telnet, 0},
556 {"dcc-sanitycheck", &dcc_sanitycheck, 0},
557 {"ident-timeout", &identtimeout, 0},
558 {"share-unlinks", &share_unlinks, 0},
559 {"log-time", &shtime, 0},
560 {"allow-dk-cmds", &allow_dk_cmds, 0},
561 {"resolve-timeout", &resolve_timeout, 0},
562 {"must-be-owner", &must_be_owner, 1},
563 {"paranoid-telnet-flood", &par_telnet_flood, 0},
564 {"use-exempts", &use_exempts, 0},
565 {"use-invites", &use_invites, 0},
566 {"quiet-save", &quiet_save, 0},
567 {"force-expire", &force_expire, 0},
568 {"dupwait-timeout", &dupwait_timeout, 0},
569 {"strict-host", &strict_host, 0},
570 {"userfile-perm", &userfile_perm, 0},
571 {"copy-to-tmp", &copy_to_tmp, 0},
572 {"quiet-reject", &quiet_reject, 0},
573 {"cidr-support", &cidr_support, 0},
574 #ifdef IPV6
575 {"prefer-ipv6", &pref_af, 0},
576 #endif
577 {NULL, NULL, 0}
578 };
579
580 static tcl_coups def_tcl_coups[] = {
581 {"telnet-flood", &flood_telnet_thr, &flood_telnet_time},
582 {"reserved-portrange", &reserved_port_min, &reserved_port_max},
583 {NULL, NULL, NULL}
584 };
585
586 /* Set up Tcl variables that will hook into eggdrop internal vars via
587 * trace callbacks.
588 */
589 static void init_traces()
590 {
591 add_tcl_coups(def_tcl_coups);
592 add_tcl_strings(def_tcl_strings);
593 add_tcl_ints(def_tcl_ints);
594 }
595
596 void kill_tcl()
597 {
598 rem_tcl_coups(def_tcl_coups);
599 rem_tcl_strings(def_tcl_strings);
600 rem_tcl_ints(def_tcl_ints);
601 kill_bind();
602 Tcl_DeleteInterp(interp);
603 }
604
605 extern tcl_cmds tcluser_cmds[], tcldcc_cmds[], tclmisc_cmds[],
606 tclmisc_objcmds[], tcldns_cmds[];
607 #ifdef TLS
608 extern tcl_cmds tcltls_cmds[];
609 #endif
610
611 #ifdef REPLACE_NOTIFIER
612 /* The tickle_*() functions replace the Tcl Notifier
613 * The tickle_*() functions can be called by Tcl threads
614 */
615 void tickle_SetTimer (TCL_CONST86 Tcl_Time *timePtr)
616 {
617 struct threaddata *td = threaddata();
618 /* we can block 1 second maximum, because we have SECONDLY events */
619 if (!timePtr || timePtr->sec > 1 || (timePtr->sec == 1 && timePtr->usec > 0)) {
620 td->blocktime.tv_sec = 1;
621 td->blocktime.tv_usec = 0;
622 } else {
623 td->blocktime.tv_sec = timePtr->sec;
624 td->blocktime.tv_usec = timePtr->usec;
625 }
626 }
627
628 int tickle_WaitForEvent (TCL_CONST86 Tcl_Time *timePtr)
629 {
630 struct threaddata *td = threaddata();
631
632 tickle_SetTimer(timePtr);
633 return (*td->mainloopfunc)(0);
634 }
635
636 void tickle_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData cd)
637 {
638 alloctclsock(fd, mask, proc, cd);
639 }
640
641 void tickle_DeleteFileHandler(int fd)
642 {
643 killtclsock(fd);
644 }
645
646 void tickle_FinalizeNotifier(ClientData cd)
647 {
648 struct threaddata *td = threaddata();
649 if (td->socklist)
650 nfree(td->socklist);
651 }
652
653 ClientData tickle_InitNotifier()
654 {
655 static int ismainthread = 1;
656 init_threaddata(ismainthread);
657 if (ismainthread)
658 ismainthread = 0;
659 return NULL;
660 }
661
662 int tclthreadmainloop(int zero)
663 {
664 int i;
665 i = sockread(NULL, NULL, threaddata()->socklist, threaddata()->MAXSOCKS, 1);
666 return (i == -5);
667 }
668
669 struct threaddata *threaddata()
670 {
671 static Tcl_ThreadDataKey tdkey;
672 struct threaddata *td = Tcl_GetThreadData(&tdkey, sizeof(struct threaddata));
673 return td;
674 }
675
676 #else /* REPLACE_NOTIFIER */
677
678 int tclthreadmainloop() { return 0; }
679
680 struct threaddata *threaddata()
681 {
682 static struct threaddata tsd;
683 return &tsd;
684 }
685
686 #endif /* REPLACE_NOTIFIER */
687
688 int init_threaddata(int mainthread)
689 {
690 struct threaddata *td = threaddata();
691 td->mainloopfunc = mainthread ? mainloop : tclthreadmainloop;
692 td->socklist = NULL;
693 td->mainthread = mainthread;
694 td->blocktime.tv_sec = 1;
695 td->blocktime.tv_usec = 0;
696 td->MAXSOCKS = 0;
697 increase_socks_max();
698 return 0;
699 }
700
701 /* Not going through Tcl's crazy main() system (what on earth was he
702 * smoking?!) so we gotta initialize the Tcl interpreter
703 */
704 void init_tcl(int argc, char **argv)
705 {
706 #ifdef REPLACE_NOTIFIER
707 Tcl_NotifierProcs notifierprocs;
708 #endif /* REPLACE_NOTIFIER */
709
710 #ifdef USE_TCL_ENCODING
711 const char *encoding;
712 int i;
713 char *langEnv;
714 #endif /* USE_TCL_ENCODING */
715 #ifdef USE_TCL_PACKAGE
716 int j;
717 char pver[1024] = "";
718 #endif /* USE_TCL_PACKAGE */
719
720 #ifdef REPLACE_NOTIFIER
721 egg_bzero(&notifierprocs, sizeof(notifierprocs));
722 notifierprocs.initNotifierProc = tickle_InitNotifier;
723 notifierprocs.createFileHandlerProc = tickle_CreateFileHandler;
724 notifierprocs.deleteFileHandlerProc = tickle_DeleteFileHandler;
725 notifierprocs.setTimerProc = tickle_SetTimer;
726 notifierprocs.waitForEventProc = tickle_WaitForEvent;
727 notifierprocs.finalizeNotifierProc = tickle_FinalizeNotifier;
728
729 Tcl_SetNotifier(&notifierprocs);
730 #endif /* REPLACE_NOTIFIER */
731
732 /* This must be done *BEFORE* Tcl_SetSystemEncoding(),
733 * or Tcl_SetSystemEncoding() will cause a segfault.
734 */
735 #ifdef USE_TCL_FINDEXEC
736 /* This is used for 'info nameofexecutable'.
737 * The filename in argv[0] must exist in a directory listed in
738 * the environment variable PATH for it to register anything.
739 */
740 Tcl_FindExecutable(argv[0]);
741 #endif /* USE_TCL_FINDEXEC */
742
743 /* Initialize the interpreter */
744 interp = Tcl_CreateInterp();
745
746 #ifdef DEBUG_MEM
747 /* Initialize Tcl's memory debugging if we want it */
748 Tcl_InitMemory(interp);
749 #endif
750
751 /* Set Tcl variable tcl_interactive to 0 */
752 Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
753
754 /* Setup script library facility */
755 Tcl_Init(interp);
756 Tcl_SetServiceMode(TCL_SERVICE_ALL);
757
758 /* Code based on Tcl's TclpSetInitialEncodings() */
759 #ifdef USE_TCL_ENCODING
760 /* Determine the current encoding from the LC_* or LANG environment
761 * variables.
762 */
763 langEnv = getenv("LC_ALL");
764 if (langEnv == NULL || langEnv[0] == '\0') {
765 langEnv = getenv("LC_CTYPE");
766 }
767 if (langEnv == NULL || langEnv[0] == '\0') {
768 langEnv = getenv("LANG");
769 }
770 if (langEnv == NULL || langEnv[0] == '\0') {
771 langEnv = NULL;
772 }
773
774 encoding = NULL;
775 if (langEnv != NULL) {
776 for (i = 0; localeTable[i].lang != NULL; i++)
777 if (strcmp(localeTable[i].lang, langEnv) == 0) {
778 encoding = localeTable[i].encoding;
779 break;
780 }
781
782 /* There was no mapping in the locale table. If there is an
783 * encoding subfield, we can try to guess from that.
784 */
785 if (encoding == NULL) {
786 char *p;
787
788 for (p = langEnv; *p != '\0'; p++) {
789 if (*p == '.') {
790 p++;
791 break;
792 }
793 }
794 if (*p != '\0') {
795 Tcl_DString ds;
796
797 Tcl_DStringInit(&ds);
798 Tcl_DStringAppend(&ds, p, -1);
799
800 encoding = Tcl_DStringValue(&ds);
801 Tcl_UtfToLower(Tcl_DStringValue(&ds));
802 if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
803 Tcl_DStringFree(&ds);
804 goto resetPath;
805 }
806 Tcl_DStringFree(&ds);
807 encoding = NULL;
808 }
809 }
810 }
811
812 if (encoding == NULL) {
813 encoding = "iso8859-1";
814 }
815
816 Tcl_SetSystemEncoding(NULL, encoding);
817
818 resetPath:
819
820 /* Initialize the C library's locale subsystem. */
821 setlocale(LC_CTYPE, "");
822
823 /* In case the initial locale is not "C", ensure that the numeric
824 * processing is done in "C" locale regardless. */
825 setlocale(LC_NUMERIC, "C");
826
827 /* Keep the iso8859-1 encoding preloaded. The IO package uses it for
828 * gets on a binary channel. */
829 Tcl_GetEncoding(NULL, "iso8859-1");
830 #endif /* USE_TCL_ENCODING */
831
832 #ifdef USE_TCL_PACKAGE
833 /* Add eggdrop to Tcl's package list */
834 for (j = 0; j <= strlen(egg_version); j++) {
835 if ((egg_version[j] == ' ') || (egg_version[j] == '+'))
836 break;
837 pver[strlen(pver)] = egg_version[j];
838 }
839 Tcl_PkgProvide(interp, "eggdrop", pver);
840 #endif /* USE_TCL_PACKAGE */
841
842 /* Initialize binds and traces */
843 init_bind();
844 init_traces();
845
846 /* Add new commands */
847 add_tcl_commands(tcluser_cmds);
848 add_tcl_commands(tcldcc_cmds);
849 add_tcl_commands(tclmisc_cmds);
850 #ifdef USE_TCL_OBJ
851 add_tcl_objcommands(tclmisc_objcmds);
852 #endif
853 add_tcl_commands(tcldns_cmds);
854 #ifdef TLS
855 add_tcl_commands(tcltls_cmds);
856 #endif
857 }
858
859 void do_tcl(char *whatzit, char *script)
860 {
861 int code;
862 char *result;
863 #ifdef USE_TCL_ENCODING
864 Tcl_DString dstr;
865 #endif
866
867 code = Tcl_Eval(interp, script);
868
869 #ifdef USE_TCL_ENCODING
870 /* properly convert string to system encoding. */
871 Tcl_DStringInit(&dstr);
872 Tcl_UtfToExternalDString(NULL, tcl_resultstring(), -1, &dstr);
873 result = Tcl_DStringValue(&dstr);
874 #else
875 /* use old pre-Tcl 8.1 way. */
876 result = tcl_resultstring();
877 #endif
878
879 if (code != TCL_OK) {
880 putlog(LOG_MISC, "*", _("Tcl error in script for '%s':"), whatzit);
881 putlog(LOG_MISC, "*", "%s", result);
882 Tcl_BackgroundError(interp);
883 }
884
885 #ifdef USE_TCL_ENCODING
886 Tcl_DStringFree(&dstr);
887 #endif
888 }
889
890 /* Interpret tcl file fname.
891 *
892 * returns: 1 - if everything was okay
893 */
894 int readtclprog(char *fname)
895 {
896 int code;
897 EGG_CONST char *result;
898 #ifdef USE_TCL_ENCODING
899 Tcl_DString dstr;
900 #endif
901
902 if (!file_readable(fname))
903 return 0;
904
905 code = Tcl_EvalFile(interp, fname);
906 result = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
907
908 #ifdef USE_TCL_ENCODING
909 /* properly convert string to system encoding. */
910 Tcl_DStringInit(&dstr);
911 Tcl_UtfToExternalDString(NULL, result, -1, &dstr);
912 result = Tcl_DStringValue(&dstr);
913 #endif
914
915 if (code != TCL_OK) {
916 putlog(LOG_MISC, "*", _("Tcl error in file '%s':"), fname);
917 putlog(LOG_MISC, "*", "%s", result);
918 Tcl_BackgroundError(interp);
919 code = 0; /* JJM: refactored to remove premature return */
920 } else {
921 /* Refresh internal variables */
922 code = 1;
923 }
924
925 #ifdef USE_TCL_ENCODING
926 Tcl_DStringFree(&dstr);
927 #endif
928
929 return code;
930 }
931
932 void add_tcl_strings(tcl_strings *list)
933 {
934 int i;
935 strinfo *st;
936 int tmp;
937
938 for (i = 0; list[i].name; i++) {
939 st = nmalloc(sizeof *st);
940 strtot += sizeof(strinfo);
941 st->max = list[i].length - (list[i].flags & STR_DIR);
942 if (list[i].flags & STR_PROTECT)
943 st->max = -st->max;
944 st->str = list[i].buf;
945 st->flags = (list[i].flags & STR_DIR);
946 tmp = protect_readonly;
947 protect_readonly = 0;
948 tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_WRITES);
949 protect_readonly = tmp;
950 tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_READS);
951 Tcl_TraceVar(interp, list[i].name, TCL_TRACE_READS | TCL_TRACE_WRITES |
952 TCL_TRACE_UNSETS, tcl_eggstr, (ClientData) st);
953 }
954 }
955
956 void rem_tcl_strings(tcl_strings *list)
957 {
958 int i, f;
959 strinfo *st;
960
961 f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
962 for (i = 0; list[i].name; i++) {
963 st = (strinfo *) Tcl_VarTraceInfo(interp, list[i].name, f, tcl_eggstr,
964 NULL);
965 Tcl_UntraceVar(interp, list[i].name, f, tcl_eggstr, st);
966 if (st != NULL) {
967 strtot -= sizeof(strinfo);
968 nfree(st);
969 }
970 }
971 }
972
973 void add_tcl_ints(tcl_ints *list)
974 {
975 int i, tmp;
976 intinfo *ii;
977
978 for (i = 0; list[i].name; i++) {
979 ii = nmalloc(sizeof *ii);
980 strtot += sizeof(intinfo);
981 ii->var = list[i].val;
982 ii->ro = list[i].readonly;
983 tmp = protect_readonly;
984 protect_readonly = 0;
985 tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_WRITES);
986 protect_readonly = tmp;
987 tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_READS);
988 Tcl_TraceVar(interp, list[i].name,
989 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
990 tcl_eggint, (ClientData) ii);
991 }
992
993 }
994
995 void rem_tcl_ints(tcl_ints *list)
996 {
997 int i, f;
998 intinfo *ii;
999
1000 f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
1001 for (i = 0; list[i].name; i++) {
1002 ii = (intinfo *) Tcl_VarTraceInfo(interp, list[i].name, f, tcl_eggint,
1003 NULL);
1004 Tcl_UntraceVar(interp, list[i].name, f, tcl_eggint, (ClientData) ii);
1005 if (ii) {
1006 strtot -= sizeof(intinfo);
1007 nfree(ii);
1008 }
1009 }
1010 }
1011
1012 /* Allocate couplet space for tracing couplets
1013 */
1014 void add_tcl_coups(tcl_coups *list)
1015 {
1016 coupletinfo *cp;
1017 int i;
1018
1019 for (i = 0; list[i].name; i++) {
1020 cp = nmalloc(sizeof *cp);
1021 strtot += sizeof(coupletinfo);
1022 cp->left = list[i].lptr;
1023 cp->right = list[i].rptr;
1024 tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL,
1025 TCL_TRACE_WRITES);
1026 tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL,
1027 TCL_TRACE_READS);
1028 Tcl_TraceVar(interp, list[i].name,
1029 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
1030 tcl_eggcouplet, (ClientData) cp);
1031 }
1032 }
1033
1034 void rem_tcl_coups(tcl_coups *list)
1035 {
1036 int i, f;
1037 coupletinfo *cp;
1038
1039 f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
1040 for (i = 0; list[i].name; i++) {
1041 cp = (coupletinfo *) Tcl_VarTraceInfo(interp, list[i].name, f,
1042 tcl_eggcouplet, NULL);
1043 strtot -= sizeof(coupletinfo);
1044 Tcl_UntraceVar(interp, list[i].name, f, tcl_eggcouplet, (ClientData) cp);
1045 nfree(cp);
1046 }
1047 }
1048
1049 /* Check if the Tcl library supports threads
1050 */
1051 int tcl_threaded()
1052 {
1053 #ifdef HAVE_TCL_GETCURRENTTHREAD
1054 if (Tcl_GetCurrentThread() != (Tcl_ThreadId)0)
1055 return 1;
1056 #endif
1057
1058 return 0;
1059 }
1060
1061 /* Check if we need to fork before initializing Tcl
1062 */
1063 int fork_before_tcl()
1064 {
1065 #ifndef REPLACE_NOTIFIER
1066 return tcl_threaded();
1067 #endif
1068 return 0;
1069 }

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23