/[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.1 - (show annotations) (download) (as text)
Mon Jul 26 21:11:06 2010 UTC (8 years, 11 months ago) by simple
Branch: MAIN
Branch point for: eggheads
File MIME type: text/x-chdr
Initial revision

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23