/[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.9.2.2 - (hide annotations) (download) (as text)
Wed Jan 12 13:54:00 2011 UTC (8 years, 5 months ago) by pseudo
Branch: gettext
Changes since 1.9.2.1: +3 -3 lines
File MIME type: text/x-chdr
Removed memcpy(), memset() and strftime() compatibility replacements.

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

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23