/[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.4 - (show annotations) (download) (as text)
Tue Oct 19 12:13:33 2010 UTC (8 years, 7 months ago) by pseudo
Branch: MAIN
Changes since 1.3: +28 -2 lines
File MIME type: text/x-chdr
Added full SSL support including Tcl commands.
Added support for certificate authentication.
Added support for botnet and partyline encryption using ssl.
Documented the new features and commands.
Fixed add_server() problems with IPv6 addresses in the server list.

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23