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