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

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

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


Revision 1.5 - (hide annotations) (download) (as text)
Sat Oct 23 11:16:13 2010 UTC (8 years, 6 months ago) by pseudo
Branch: MAIN
Changes since 1.4: +6 -8 lines
File MIME type: text/x-chdr
Modified SIGQUIT handler to restart the bot by default.
Added support for evnt bind procs to cancel default signal actions.
Removed the die-on-sighup and die-on-sigterm variables.
Added a new bind type DIE triggered before a clean shutdown. Changed the exit status on clean shutdown to 0.

1 simple 1.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 pseudo 1.5 * $Id: tcl.c,v 1.4 2010/10/19 12:13:33 pseudo Exp $
8 simple 1.1 */
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 pseudo 1.2 firewall[], helpdir[], notify_new[], vhost[], moddir[],
50 simple 1.1 tempdir[], owner[], network[], botnetnick[], bannerfile[],
51     egg_version[], natip[], configfile[], logfile_suffix[], log_ts[],
52 pseudo 1.2 textdir[], pid_file[], listen_ip[];
53    
54 simple 1.1
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 pseudo 1.5 ignore_time, reserved_port_min, reserved_port_max, max_logs,
60     max_logsize, dcc_total, raw_log, identtimeout, dcc_sanitycheck,
61     dupwait_timeout, egg_numver, share_unlinks, protect_telnet,
62     sort_users, strict_host, resolve_timeout, default_uflags,
63     userfile_perm, cidr_support;
64 simple 1.1
65 pseudo 1.2 #ifdef IPV6
66     extern char vhost6[];
67     extern int pref_af;
68     #endif
69    
70 pseudo 1.4 #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 simple 1.1 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 pseudo 1.4 #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 simple 1.1 #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 pseudo 1.4 {"vhost", vhost, 120, 0},
511 pseudo 1.2 #ifdef IPV6
512     {"vhost6", vhost6, 120, 0},
513     #endif
514     {"listen-addr", listen_ip, 120, 0},
515 simple 1.1 {"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 pseudo 1.4 #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 simple 1.1 {"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     {"remote-boots", &remote_boots, 1},
554     {"max-socks", &max_socks, 0},
555     {"max-logs", &max_logs, 0},
556     {"max-logsize", &max_logsize, 0},
557     {"quick-logs", &quick_logs, 0},
558     {"raw-log", &raw_log, 1},
559     {"protect-telnet", &protect_telnet, 0},
560     {"dcc-sanitycheck", &dcc_sanitycheck, 0},
561     {"sort-users", &sort_users, 0},
562     {"ident-timeout", &identtimeout, 0},
563     {"share-unlinks", &share_unlinks, 0},
564     {"log-time", &shtime, 0},
565     {"allow-dk-cmds", &allow_dk_cmds, 0},
566     {"resolve-timeout", &resolve_timeout, 0},
567     {"must-be-owner", &must_be_owner, 1},
568     {"paranoid-telnet-flood", &par_telnet_flood, 0},
569     {"use-exempts", &use_exempts, 0},
570     {"use-invites", &use_invites, 0},
571     {"quiet-save", &quiet_save, 0},
572     {"force-expire", &force_expire, 0},
573     {"dupwait-timeout", &dupwait_timeout, 0},
574     {"strict-host", &strict_host, 0},
575     {"userfile-perm", &userfile_perm, 0},
576     {"copy-to-tmp", &copy_to_tmp, 0},
577     {"quiet-reject", &quiet_reject, 0},
578     {"cidr-support", &cidr_support, 0},
579     {"strict-servernames", &strict_servernames, 0}, /* compat */
580     {"enable-simul", &enable_simul, 0}, /* compat */
581     {"debug-output", &debug_output, 0}, /* compat */
582     {"use-console-r", &use_console_r, 0}, /* compat */
583 pseudo 1.2 #ifdef IPV6
584 pseudo 1.3 {"prefer-ipv6", &pref_af, 0},
585 pseudo 1.2 #endif
586 simple 1.1 {NULL, NULL, 0}
587     };
588    
589     static tcl_coups def_tcl_coups[] = {
590     {"telnet-flood", &flood_telnet_thr, &flood_telnet_time},
591     {"reserved-portrange", &reserved_port_min, &reserved_port_max},
592     {NULL, NULL, NULL}
593     };
594    
595     /* Set up Tcl variables that will hook into eggdrop internal vars via
596     * trace callbacks.
597     */
598     static void init_traces()
599     {
600     add_tcl_coups(def_tcl_coups);
601     add_tcl_strings(def_tcl_strings);
602     add_tcl_ints(def_tcl_ints);
603     }
604    
605     void kill_tcl()
606     {
607     rem_tcl_coups(def_tcl_coups);
608     rem_tcl_strings(def_tcl_strings);
609     rem_tcl_ints(def_tcl_ints);
610     kill_bind();
611     Tcl_DeleteInterp(interp);
612     }
613    
614     extern tcl_cmds tcluser_cmds[], tcldcc_cmds[], tclmisc_cmds[],
615     tclmisc_objcmds[], tcldns_cmds[];
616 pseudo 1.4 #ifdef TLS
617     extern tcl_cmds tcltls_cmds[];
618     #endif
619 simple 1.1
620     #ifdef REPLACE_NOTIFIER
621     /* The tickle_*() functions replace the Tcl Notifier
622     * The tickle_*() functions can be called by Tcl threads
623     */
624     void tickle_SetTimer (TCL_CONST86 Tcl_Time *timePtr)
625     {
626     struct threaddata *td = threaddata();
627     /* we can block 1 second maximum, because we have SECONDLY events */
628     if (!timePtr || timePtr->sec > 1 || (timePtr->sec == 1 && timePtr->usec > 0)) {
629     td->blocktime.tv_sec = 1;
630     td->blocktime.tv_usec = 0;
631     } else {
632     td->blocktime.tv_sec = timePtr->sec;
633     td->blocktime.tv_usec = timePtr->usec;
634     }
635     }
636    
637     int tickle_WaitForEvent (TCL_CONST86 Tcl_Time *timePtr)
638     {
639     struct threaddata *td = threaddata();
640    
641     tickle_SetTimer(timePtr);
642     return (*td->mainloopfunc)(0);
643     }
644    
645     void tickle_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData cd)
646     {
647     alloctclsock(fd, mask, proc, cd);
648     }
649    
650     void tickle_DeleteFileHandler(int fd)
651     {
652     killtclsock(fd);
653     }
654    
655     void tickle_FinalizeNotifier(ClientData cd)
656     {
657     struct threaddata *td = threaddata();
658     if (td->socklist)
659     nfree(td->socklist);
660     }
661    
662     ClientData tickle_InitNotifier()
663     {
664     static int ismainthread = 1;
665     init_threaddata(ismainthread);
666     if (ismainthread)
667     ismainthread = 0;
668     return NULL;
669     }
670    
671     int tclthreadmainloop(int zero)
672     {
673     int i;
674     i = sockread(NULL, NULL, threaddata()->socklist, threaddata()->MAXSOCKS, 1);
675     return (i == -4);
676     }
677    
678     struct threaddata *threaddata()
679     {
680     static Tcl_ThreadDataKey tdkey;
681     struct threaddata *td = Tcl_GetThreadData(&tdkey, sizeof(struct threaddata));
682     return td;
683     }
684    
685     #else /* REPLACE_NOTIFIER */
686    
687     int tclthreadmainloop() { return 0; }
688    
689     struct threaddata *threaddata()
690     {
691     static struct threaddata tsd;
692     return &tsd;
693     }
694    
695     #endif /* REPLACE_NOTIFIER */
696    
697     int init_threaddata(int mainthread)
698     {
699     struct threaddata *td = threaddata();
700     td->mainloopfunc = mainthread ? mainloop : tclthreadmainloop;
701     td->socklist = NULL;
702     td->mainthread = mainthread;
703     td->blocktime.tv_sec = 1;
704     td->blocktime.tv_usec = 0;
705     td->MAXSOCKS = 0;
706     increase_socks_max();
707     return 0;
708     }
709    
710     /* Not going through Tcl's crazy main() system (what on earth was he
711     * smoking?!) so we gotta initialize the Tcl interpreter
712     */
713     void init_tcl(int argc, char **argv)
714     {
715     #ifdef REPLACE_NOTIFIER
716     Tcl_NotifierProcs notifierprocs;
717     #endif /* REPLACE_NOTIFIER */
718    
719     #ifdef USE_TCL_ENCODING
720     const char *encoding;
721     int i;
722     char *langEnv;
723     #endif /* USE_TCL_ENCODING */
724     #ifdef USE_TCL_PACKAGE
725     int j;
726     char pver[1024] = "";
727     #endif /* USE_TCL_PACKAGE */
728    
729     #ifdef REPLACE_NOTIFIER
730     egg_bzero(&notifierprocs, sizeof(notifierprocs));
731     notifierprocs.initNotifierProc = tickle_InitNotifier;
732     notifierprocs.createFileHandlerProc = tickle_CreateFileHandler;
733     notifierprocs.deleteFileHandlerProc = tickle_DeleteFileHandler;
734     notifierprocs.setTimerProc = tickle_SetTimer;
735     notifierprocs.waitForEventProc = tickle_WaitForEvent;
736     notifierprocs.finalizeNotifierProc = tickle_FinalizeNotifier;
737    
738     Tcl_SetNotifier(&notifierprocs);
739     #endif /* REPLACE_NOTIFIER */
740    
741     /* This must be done *BEFORE* Tcl_SetSystemEncoding(),
742     * or Tcl_SetSystemEncoding() will cause a segfault.
743     */
744     #ifdef USE_TCL_FINDEXEC
745     /* This is used for 'info nameofexecutable'.
746     * The filename in argv[0] must exist in a directory listed in
747     * the environment variable PATH for it to register anything.
748     */
749     Tcl_FindExecutable(argv[0]);
750     #endif /* USE_TCL_FINDEXEC */
751    
752     /* Initialize the interpreter */
753     interp = Tcl_CreateInterp();
754    
755     #ifdef DEBUG_MEM
756     /* Initialize Tcl's memory debugging if we want it */
757     Tcl_InitMemory(interp);
758     #endif
759    
760     /* Set Tcl variable tcl_interactive to 0 */
761     Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
762    
763     /* Setup script library facility */
764     Tcl_Init(interp);
765     Tcl_SetServiceMode(TCL_SERVICE_ALL);
766    
767     /* Code based on Tcl's TclpSetInitialEncodings() */
768     #ifdef USE_TCL_ENCODING
769     /* Determine the current encoding from the LC_* or LANG environment
770     * variables.
771     */
772     langEnv = getenv("LC_ALL");
773     if (langEnv == NULL || langEnv[0] == '\0') {
774     langEnv = getenv("LC_CTYPE");
775     }
776     if (langEnv == NULL || langEnv[0] == '\0') {
777     langEnv = getenv("LANG");
778     }
779     if (langEnv == NULL || langEnv[0] == '\0') {
780     langEnv = NULL;
781     }
782    
783     encoding = NULL;
784     if (langEnv != NULL) {
785     for (i = 0; localeTable[i].lang != NULL; i++)
786     if (strcmp(localeTable[i].lang, langEnv) == 0) {
787     encoding = localeTable[i].encoding;
788     break;
789     }
790    
791     /* There was no mapping in the locale table. If there is an
792     * encoding subfield, we can try to guess from that.
793     */
794     if (encoding == NULL) {
795     char *p;
796    
797     for (p = langEnv; *p != '\0'; p++) {
798     if (*p == '.') {
799     p++;
800     break;
801     }
802     }
803     if (*p != '\0') {
804     Tcl_DString ds;
805    
806     Tcl_DStringInit(&ds);
807     Tcl_DStringAppend(&ds, p, -1);
808    
809     encoding = Tcl_DStringValue(&ds);
810     Tcl_UtfToLower(Tcl_DStringValue(&ds));
811     if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
812     Tcl_DStringFree(&ds);
813     goto resetPath;
814     }
815     Tcl_DStringFree(&ds);
816     encoding = NULL;
817     }
818     }
819     }
820    
821     if (encoding == NULL) {
822     encoding = "iso8859-1";
823     }
824    
825     Tcl_SetSystemEncoding(NULL, encoding);
826    
827     resetPath:
828    
829     /* Initialize the C library's locale subsystem. */
830     setlocale(LC_CTYPE, "");
831    
832     /* In case the initial locale is not "C", ensure that the numeric
833     * processing is done in "C" locale regardless. */
834     setlocale(LC_NUMERIC, "C");
835    
836     /* Keep the iso8859-1 encoding preloaded. The IO package uses it for
837     * gets on a binary channel. */
838     Tcl_GetEncoding(NULL, "iso8859-1");
839     #endif /* USE_TCL_ENCODING */
840    
841     #ifdef USE_TCL_PACKAGE
842     /* Add eggdrop to Tcl's package list */
843     for (j = 0; j <= strlen(egg_version); j++) {
844     if ((egg_version[j] == ' ') || (egg_version[j] == '+'))
845     break;
846     pver[strlen(pver)] = egg_version[j];
847     }
848     Tcl_PkgProvide(interp, "eggdrop", pver);
849     #endif /* USE_TCL_PACKAGE */
850    
851     /* Initialize binds and traces */
852     init_bind();
853     init_traces();
854    
855     /* Add new commands */
856     add_tcl_commands(tcluser_cmds);
857     add_tcl_commands(tcldcc_cmds);
858     add_tcl_commands(tclmisc_cmds);
859     #ifdef USE_TCL_OBJ
860     add_tcl_objcommands(tclmisc_objcmds);
861     #endif
862     add_tcl_commands(tcldns_cmds);
863 pseudo 1.4 #ifdef TLS
864     add_tcl_commands(tcltls_cmds);
865     #endif
866 simple 1.1 }
867    
868     void do_tcl(char *whatzit, char *script)
869     {
870     int code;
871     char *result;
872     #ifdef USE_TCL_ENCODING
873     Tcl_DString dstr;
874     #endif
875    
876     code = Tcl_Eval(interp, script);
877    
878     #ifdef USE_TCL_ENCODING
879     /* properly convert string to system encoding. */
880     Tcl_DStringInit(&dstr);
881     Tcl_UtfToExternalDString(NULL, tcl_resultstring(), -1, &dstr);
882     result = Tcl_DStringValue(&dstr);
883     #else
884     /* use old pre-Tcl 8.1 way. */
885     result = tcl_resultstring();
886     #endif
887    
888     if (code != TCL_OK) {
889     putlog(LOG_MISC, "*", "Tcl error in script for '%s':", whatzit);
890     putlog(LOG_MISC, "*", "%s", result);
891     }
892    
893     #ifdef USE_TCL_ENCODING
894     Tcl_DStringFree(&dstr);
895     #endif
896     }
897    
898     /* Interpret tcl file fname.
899     *
900     * returns: 1 - if everything was okay
901     */
902     int readtclprog(char *fname)
903     {
904     int code;
905     EGG_CONST char *result;
906     #ifdef USE_TCL_ENCODING
907     Tcl_DString dstr;
908     #endif
909    
910     if (!file_readable(fname))
911     return 0;
912    
913     code = Tcl_EvalFile(interp, fname);
914     result = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
915    
916     #ifdef USE_TCL_ENCODING
917     /* properly convert string to system encoding. */
918     Tcl_DStringInit(&dstr);
919     Tcl_UtfToExternalDString(NULL, result, -1, &dstr);
920     result = Tcl_DStringValue(&dstr);
921     #endif
922    
923     if (code != TCL_OK) {
924     putlog(LOG_MISC, "*", "Tcl error in file '%s':", fname);
925     putlog(LOG_MISC, "*", "%s", result);
926     code = 0; /* JJM: refactored to remove premature return */
927     } else {
928     /* Refresh internal variables */
929     code = 1;
930     }
931    
932     #ifdef USE_TCL_ENCODING
933     Tcl_DStringFree(&dstr);
934     #endif
935    
936     return code;
937     }
938    
939     void add_tcl_strings(tcl_strings *list)
940     {
941     int i;
942     strinfo *st;
943     int tmp;
944    
945     for (i = 0; list[i].name; i++) {
946     st = nmalloc(sizeof *st);
947     strtot += sizeof(strinfo);
948     st->max = list[i].length - (list[i].flags & STR_DIR);
949     if (list[i].flags & STR_PROTECT)
950     st->max = -st->max;
951     st->str = list[i].buf;
952     st->flags = (list[i].flags & STR_DIR);
953     tmp = protect_readonly;
954     protect_readonly = 0;
955     tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_WRITES);
956     protect_readonly = tmp;
957     tcl_eggstr((ClientData) st, interp, list[i].name, NULL, TCL_TRACE_READS);
958     Tcl_TraceVar(interp, list[i].name, TCL_TRACE_READS | TCL_TRACE_WRITES |
959     TCL_TRACE_UNSETS, tcl_eggstr, (ClientData) st);
960     }
961     }
962    
963     void rem_tcl_strings(tcl_strings *list)
964     {
965     int i, f;
966     strinfo *st;
967    
968     f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
969     for (i = 0; list[i].name; i++) {
970     st = (strinfo *) Tcl_VarTraceInfo(interp, list[i].name, f, tcl_eggstr,
971     NULL);
972     Tcl_UntraceVar(interp, list[i].name, f, tcl_eggstr, st);
973     if (st != NULL) {
974     strtot -= sizeof(strinfo);
975     nfree(st);
976     }
977     }
978     }
979    
980     void add_tcl_ints(tcl_ints *list)
981     {
982     int i, tmp;
983     intinfo *ii;
984    
985     for (i = 0; list[i].name; i++) {
986     ii = nmalloc(sizeof *ii);
987     strtot += sizeof(intinfo);
988     ii->var = list[i].val;
989     ii->ro = list[i].readonly;
990     tmp = protect_readonly;
991     protect_readonly = 0;
992     tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_WRITES);
993     protect_readonly = tmp;
994     tcl_eggint((ClientData) ii, interp, list[i].name, NULL, TCL_TRACE_READS);
995     Tcl_TraceVar(interp, list[i].name,
996     TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
997     tcl_eggint, (ClientData) ii);
998     }
999    
1000     }
1001    
1002     void rem_tcl_ints(tcl_ints *list)
1003     {
1004     int i, f;
1005     intinfo *ii;
1006    
1007     f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
1008     for (i = 0; list[i].name; i++) {
1009     ii = (intinfo *) Tcl_VarTraceInfo(interp, list[i].name, f, tcl_eggint,
1010     NULL);
1011     Tcl_UntraceVar(interp, list[i].name, f, tcl_eggint, (ClientData) ii);
1012     if (ii) {
1013     strtot -= sizeof(intinfo);
1014     nfree(ii);
1015     }
1016     }
1017     }
1018    
1019     /* Allocate couplet space for tracing couplets
1020     */
1021     void add_tcl_coups(tcl_coups *list)
1022     {
1023     coupletinfo *cp;
1024     int i;
1025    
1026     for (i = 0; list[i].name; i++) {
1027     cp = nmalloc(sizeof *cp);
1028     strtot += sizeof(coupletinfo);
1029     cp->left = list[i].lptr;
1030     cp->right = list[i].rptr;
1031     tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL,
1032     TCL_TRACE_WRITES);
1033     tcl_eggcouplet((ClientData) cp, interp, list[i].name, NULL,
1034     TCL_TRACE_READS);
1035     Tcl_TraceVar(interp, list[i].name,
1036     TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
1037     tcl_eggcouplet, (ClientData) cp);
1038     }
1039     }
1040    
1041     void rem_tcl_coups(tcl_coups *list)
1042     {
1043     int i, f;
1044     coupletinfo *cp;
1045    
1046     f = TCL_GLOBAL_ONLY | TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS;
1047     for (i = 0; list[i].name; i++) {
1048     cp = (coupletinfo *) Tcl_VarTraceInfo(interp, list[i].name, f,
1049     tcl_eggcouplet, NULL);
1050     strtot -= sizeof(coupletinfo);
1051     Tcl_UntraceVar(interp, list[i].name, f, tcl_eggcouplet, (ClientData) cp);
1052     nfree(cp);
1053     }
1054     }
1055    
1056     /* Check if the Tcl library supports threads
1057     */
1058     int tcl_threaded()
1059     {
1060     #ifdef HAVE_TCL_GETCURRENTTHREAD
1061     if (Tcl_GetCurrentThread() != (Tcl_ThreadId)0)
1062     return 1;
1063     #endif
1064    
1065     return 0;
1066     }
1067    
1068     /* Check if we need to fork before initializing Tcl
1069     */
1070     int fork_before_tcl()
1071     {
1072     #ifndef REPLACE_NOTIFIER
1073     return tcl_threaded();
1074     #endif
1075     return 0;
1076     }

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23