annotate plugins/tcl/tcl_signals.c @ 14092:58c9f678b77a

[gaim-migrate @ 16717] Fix a bug reported by Jon Oberheide. If there is an extra either 1 or 3 bytes on an incoming oscar message then our ICBM parser gets into an infinite loop. This could open be caused by a malicious server or a man-in-the-middle. committer: Tailor Script <tailor@pidgin.im>
author Mark Doliner <mark@kingant.net>
date Sat, 12 Aug 2006 10:59:13 +0000
parents 4d577b63299a
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
1 /**
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
2 * @file tcl_signals.c Gaim Tcl signal API
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
3 *
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
4 * gaim
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
5 *
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
6 * Copyright (C) 2003 Ethan Blanton <eblanton@cs.purdue.edu>
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
7 *
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
8 * This program is free software; you can redistribute it and/or modify
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
9 * it under the terms of the GNU General Public License as published by
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
10 * the Free Software Foundation; either version 2 of the License, or
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
11 * (at your option) any later version.
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
12 *
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
13 * This program is distributed in the hope that it will be useful,
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
16 * GNU General Public License for more details.
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
17 *
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
18 * You should have received a copy of the GNU General Public License
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
19 * along with this program; if not, write to the Free Software
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
20 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
21 */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
22 #include <tcl.h>
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
23 #include <stdarg.h>
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
24
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
25 #include "tcl_gaim.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
26
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
27 #include "internal.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
28 #include "connection.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
29 #include "conversation.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
30 #include "signals.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
31 #include "debug.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
32 #include "value.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
33 #include "core.h"
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
34
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
35 static GList *tcl_callbacks;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
36
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
37 static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler);
12397
8d1cf3f847b1 [gaim-migrate @ 14704]
Richard Laager <rlaager@wiktel.com>
parents: 10625
diff changeset
38 static Tcl_Obj *new_cb_namespace (void);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
39
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
40 void tcl_signal_init()
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
41 {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
42 tcl_callbacks = NULL;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
43 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
44
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
45 void tcl_signal_handler_free(struct tcl_signal_handler *handler)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
46 {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
47 if (handler == NULL)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
48 return;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
49
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
50 Tcl_DecrRefCount(handler->signal);
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
51 if (handler->namespace)
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
52 Tcl_DecrRefCount(handler->namespace);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
53 g_free(handler);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
54 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
55
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
56 void tcl_signal_cleanup(Tcl_Interp *interp)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
57 {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
58 GList *cur;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
59 struct tcl_signal_handler *handler;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
60
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
61 for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
62 handler = cur->data;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
63 if (handler->interp == interp) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
64 tcl_signal_handler_free(handler);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
65 cur->data = NULL;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
66 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
67 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
68 tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
69 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
70
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
71 gboolean tcl_signal_connect(struct tcl_signal_handler *handler)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
72 {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
73 GString *proc;
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
74
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
75 gaim_signal_get_values(handler->instance,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
76 Tcl_GetString(handler->signal),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
77 &handler->returntype, &handler->nargs,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
78 &handler->argtypes);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
79
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
80 tcl_signal_disconnect(handler->interp, Tcl_GetString(handler->signal),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
81 handler->interp);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
82
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
83 if (!gaim_signal_connect_vargs(handler->instance,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
84 Tcl_GetString(handler->signal),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
85 (void *)handler->interp,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
86 GAIM_CALLBACK(tcl_signal_callback),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
87 (void *)handler))
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
88 return FALSE;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
89
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
90 handler->namespace = new_cb_namespace ();
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
91 Tcl_IncrRefCount(handler->namespace);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
92 proc = g_string_new("");
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
93 g_string_append_printf(proc, "namespace eval %s { proc cb { %s } { %s } }",
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
94 Tcl_GetString(handler->namespace),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
95 Tcl_GetString(handler->args),
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
96 Tcl_GetString(handler->proc));
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
97 if (Tcl_Eval(handler->interp, proc->str) != TCL_OK) {
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
98 Tcl_DecrRefCount(handler->namespace);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
99 g_string_free(proc, TRUE);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
100 return FALSE;
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
101 }
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
102 g_string_free(proc, TRUE);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
103
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
104 tcl_callbacks = g_list_append(tcl_callbacks, (gpointer)handler);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
105
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
106 return TRUE;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
107 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
108
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
109 void tcl_signal_disconnect(void *instance, const char *signal, Tcl_Interp *interp)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
110 {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
111 GList *cur;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
112 struct tcl_signal_handler *handler;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
113 gboolean found = FALSE;
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
114 GString *cmd;
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
115
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
116 for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
117 handler = cur->data;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
118 if (handler->interp == interp && handler->instance == instance
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
119 && !strcmp(signal, Tcl_GetString(handler->signal))) {
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
120 gaim_signal_disconnect(instance, signal, handler->interp,
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
121 GAIM_CALLBACK(tcl_signal_callback));
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
122 cmd = g_string_sized_new(64);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
123 g_string_printf(cmd, "namespace delete %s",
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
124 Tcl_GetString(handler->namespace));
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
125 Tcl_EvalEx(interp, cmd->str, -1, TCL_EVAL_GLOBAL);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
126 tcl_signal_handler_free(handler);
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
127 g_string_free(cmd, TRUE);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
128 cur->data = NULL;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
129 found = TRUE;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
130 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
131 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
132 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
133 if (found)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
134 tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
135 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
136
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
137 static GaimStringref *ref_type(GaimSubType type)
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
138 {
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
139 switch (type) {
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
140 case GAIM_SUBTYPE_ACCOUNT:
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
141 return GaimTclRefAccount;
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
142 case GAIM_SUBTYPE_CONNECTION:
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
143 return GaimTclRefConnection;
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
144 case GAIM_SUBTYPE_CONVERSATION:
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
145 return GaimTclRefConversation;
13946
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
146 case GAIM_SUBTYPE_PLUGIN:
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
147 return GaimTclRefPlugin;
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
148 case GAIM_SUBTYPE_STATUS:
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
149 return GaimTclRefStatus;
13946
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
150 case GAIM_SUBTYPE_XFER:
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
151 return GaimTclRefXfer;
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
152 default:
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
153 return NULL;
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
154 }
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
155 }
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
156
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
157 static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler)
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
158 {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
159 GString *name, *val;
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
160 GaimBlistNode *node;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
161 int error, i;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
162 void *retval = NULL;
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
163 Tcl_Obj *cmd, *arg, *result;
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
164 void **vals; /* Used for inout parameters */
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
165 char ***strs;
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
166
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
167 vals = g_new0(void *, handler->nargs);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
168 strs = g_new0(char **, handler->nargs);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
169 name = g_string_sized_new(32);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
170 val = g_string_sized_new(32);
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
171
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
172 cmd = Tcl_NewListObj(0, NULL);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
173 Tcl_IncrRefCount(cmd);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
174
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
175 arg = Tcl_DuplicateObj(handler->namespace);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
176 Tcl_AppendStringsToObj(arg, "::cb", NULL);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
177 Tcl_ListObjAppendElement(handler->interp, cmd, arg);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
178
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
179 for (i = 0; i < handler->nargs; i++) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
180 if (gaim_value_is_outgoing(handler->argtypes[i]))
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
181 g_string_printf(name, "%s::arg%d",
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
182 Tcl_GetString(handler->namespace), i);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
183
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
184 switch(gaim_value_get_type(handler->argtypes[i])) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
185 case GAIM_TYPE_UNKNOWN: /* What? I guess just pass the word ... */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
186 /* treat this as a pointer, but complain first */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
187 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "unknown GaimValue type %d\n",
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
188 gaim_value_get_type(handler->argtypes[i]));
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
189 case GAIM_TYPE_POINTER:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
190 case GAIM_TYPE_OBJECT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
191 case GAIM_TYPE_BOXED:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
192 /* These are all "pointer" types to us */
13817
ad8ddfa756ad [gaim-migrate @ 16249]
Ethan Blanton <elb@pidgin.im>
parents: 13815
diff changeset
193 if (gaim_value_is_outgoing(handler->argtypes[i]))
ad8ddfa756ad [gaim-migrate @ 16249]
Ethan Blanton <elb@pidgin.im>
parents: 13815
diff changeset
194 gaim_debug_error("tcl", "pointer types do not currently support outgoing arguments\n");
ad8ddfa756ad [gaim-migrate @ 16249]
Ethan Blanton <elb@pidgin.im>
parents: 13815
diff changeset
195 arg = gaim_tcl_ref_new(GaimTclRefPointer, va_arg(args, void *));
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
196 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
197 case GAIM_TYPE_BOOLEAN:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
198 if (gaim_value_is_outgoing(handler->argtypes[i])) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
199 vals[i] = va_arg(args, gboolean *);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
200 Tcl_LinkVar(handler->interp, name->str,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
201 (char *)&vals[i], TCL_LINK_BOOLEAN);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
202 arg = Tcl_NewStringObj(name->str, -1);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
203 } else {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
204 arg = Tcl_NewBooleanObj(va_arg(args, gboolean));
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
205 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
206 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
207 case GAIM_TYPE_CHAR:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
208 case GAIM_TYPE_UCHAR:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
209 case GAIM_TYPE_SHORT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
210 case GAIM_TYPE_USHORT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
211 case GAIM_TYPE_INT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
212 case GAIM_TYPE_UINT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
213 case GAIM_TYPE_LONG:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
214 case GAIM_TYPE_ULONG:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
215 case GAIM_TYPE_ENUM:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
216 /* I should really cast these individually to
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
217 * preserve as much information as possible ...
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
218 * but heh */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
219 if (gaim_value_is_outgoing(handler->argtypes[i])) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
220 vals[i] = va_arg(args, int *);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
221 Tcl_LinkVar(handler->interp, name->str,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
222 vals[i], TCL_LINK_INT);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
223 arg = Tcl_NewStringObj(name->str, -1);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
224 } else {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
225 arg = Tcl_NewIntObj(va_arg(args, int));
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
226 }
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
227 case GAIM_TYPE_INT64:
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
228 case GAIM_TYPE_UINT64:
10625
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
229 /* Tcl < 8.4 doesn't have wide ints, so we have ugly
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
230 * ifdefs in here */
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
231 if (gaim_value_is_outgoing(handler->argtypes[i])) {
10625
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
232 vals[i] = (void *)va_arg(args, gint64 *);
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
233 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
234 Tcl_LinkVar(handler->interp, name->str,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
235 vals[i], TCL_LINK_WIDE_INT);
10625
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
236 #else
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
237 /* This is going to cause weirdness at best,
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
238 * but what do you want ... we're losing
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
239 * precision */
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
240 Tcl_LinkVar(handler->interp, name->str,
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
241 vals[i], TCL_LINK_INT);
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
242 #endif /* Tcl >= 8.4 */
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
243 arg = Tcl_NewStringObj(name->str, -1);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
244 } else {
10625
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
245 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
246 arg = Tcl_NewWideIntObj(va_arg(args, gint64));
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
247 #else
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
248 arg = Tcl_NewIntObj((int)va_arg(args, int));
9eb235c6dc0a [gaim-migrate @ 12099]
Ethan Blanton <elb@pidgin.im>
parents: 10597
diff changeset
249 #endif /* Tcl >= 8.4 */
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
250 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
251 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
252 case GAIM_TYPE_STRING:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
253 if (gaim_value_is_outgoing(handler->argtypes[i])) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
254 strs[i] = va_arg(args, char **);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
255 if (strs[i] == NULL || *strs[i] == NULL) {
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
256 vals[i] = ckalloc(1);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
257 *(char *)vals[i] = '\0';
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
258 } else {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
259 vals[i] = ckalloc(strlen(*strs[i]) + 1);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
260 strcpy(vals[i], *strs[i]);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
261 }
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
262 Tcl_LinkVar(handler->interp, name->str,
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
263 (char *)&vals[i], TCL_LINK_STRING);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
264 arg = Tcl_NewStringObj(name->str, -1);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
265 } else {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
266 arg = Tcl_NewStringObj(va_arg(args, char *), -1);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
267 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
268 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
269 case GAIM_TYPE_SUBTYPE:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
270 switch (gaim_value_get_subtype(handler->argtypes[i])) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
271 case GAIM_SUBTYPE_UNKNOWN:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
272 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "subtype unknown\n");
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
273 case GAIM_SUBTYPE_ACCOUNT:
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
274 case GAIM_SUBTYPE_CONNECTION:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
275 case GAIM_SUBTYPE_CONVERSATION:
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
276 case GAIM_SUBTYPE_STATUS:
13946
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
277 case GAIM_SUBTYPE_PLUGIN:
4d577b63299a [gaim-migrate @ 16486]
Ethan Blanton <elb@pidgin.im>
parents: 13845
diff changeset
278 case GAIM_SUBTYPE_XFER:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
279 if (gaim_value_is_outgoing(handler->argtypes[i]))
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
280 gaim_debug_error("tcl", "pointer subtypes do not currently support outgoing arguments\n");
13815
724e4c08391a [gaim-migrate @ 16247]
Ethan Blanton <elb@pidgin.im>
parents: 13810
diff changeset
281 arg = gaim_tcl_ref_new(ref_type(gaim_value_get_subtype(handler->argtypes[i])), va_arg(args, void *));
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
282 break;
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
283 case GAIM_SUBTYPE_BLIST:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
284 case GAIM_SUBTYPE_BLIST_BUDDY:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
285 case GAIM_SUBTYPE_BLIST_GROUP:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
286 case GAIM_SUBTYPE_BLIST_CHAT:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
287 /* We're going to switch again for code-deduping */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
288 if (gaim_value_is_outgoing(handler->argtypes[i]))
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
289 node = *va_arg(args, GaimBlistNode **);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
290 else
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
291 node = va_arg(args, GaimBlistNode *);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
292 switch (node->type) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
293 case GAIM_BLIST_GROUP_NODE:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
294 arg = Tcl_NewListObj(0, NULL);
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
295 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
296 Tcl_NewStringObj("group", -1));
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
297 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
298 Tcl_NewStringObj(((GaimGroup *)node)->name, -1));
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
299 break;
6735
b0913ab92893 [gaim-migrate @ 7267]
Mark Doliner <mark@kingant.net>
parents: 6700
diff changeset
300 case GAIM_BLIST_CONTACT_NODE:
b0913ab92893 [gaim-migrate @ 7267]
Mark Doliner <mark@kingant.net>
parents: 6700
diff changeset
301 /* g_string_printf(val, "contact {%s}", Contact Name? ); */
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
302 arg = Tcl_NewStringObj("contact", -1);
6735
b0913ab92893 [gaim-migrate @ 7267]
Mark Doliner <mark@kingant.net>
parents: 6700
diff changeset
303 break;
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
304 case GAIM_BLIST_BUDDY_NODE:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
305 arg = Tcl_NewListObj(0, NULL);
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
306 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
307 Tcl_NewStringObj("buddy", -1));
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
308 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
309 Tcl_NewStringObj(((GaimBuddy *)node)->name, -1));
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
310 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
311 gaim_tcl_ref_new(GaimTclRefAccount,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
312 ((GaimBuddy *)node)->account));
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
313 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
314 case GAIM_BLIST_CHAT_NODE:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
315 arg = Tcl_NewListObj(0, NULL);
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
316 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
317 Tcl_NewStringObj("chat", -1));
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
318 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
319 Tcl_NewStringObj(((GaimChat *)node)->alias, -1));
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
320 Tcl_ListObjAppendElement(handler->interp, arg,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
321 gaim_tcl_ref_new(GaimTclRefAccount,
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
322 ((GaimChat *)node)->account));
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
323 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
324 case GAIM_BLIST_OTHER_NODE:
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
325 arg = Tcl_NewStringObj("other", -1);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
326 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
327 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
328 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
329 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
330 }
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
331 Tcl_ListObjAppendElement(handler->interp, cmd, arg);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
332 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
333
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
334 /* Call the friggin' procedure already */
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
335 if ((error = Tcl_EvalObjEx(handler->interp, cmd, TCL_EVAL_GLOBAL)) != TCL_OK) {
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
336 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n",
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
337 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
338 } else {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
339 result = Tcl_GetObjResult(handler->interp);
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
340 /* handle return values -- strings and words only */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
341 if (handler->returntype) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
342 if (gaim_value_get_type(handler->returntype) == GAIM_TYPE_STRING) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
343 retval = (void *)g_strdup(Tcl_GetString(result));
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
344 } else {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
345 if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
346 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n",
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
347 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
348 retval = NULL;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
349 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
350 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
351 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
352 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
353
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
354 /* And finally clean up */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
355 for (i = 0; i < handler->nargs; i++) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
356 g_string_printf(name, "%s::arg%d",
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
357 Tcl_GetString(handler->namespace), i);
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
358 if (gaim_value_is_outgoing(handler->argtypes[i])
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
359 && gaim_value_get_type(handler->argtypes[i]) != GAIM_TYPE_SUBTYPE)
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
360 Tcl_UnlinkVar(handler->interp, name->str);
13810
a84523152a24 [gaim-migrate @ 16240]
Ethan Blanton <elb@pidgin.im>
parents: 13219
diff changeset
361
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
362 /* We basically only have to deal with strings on the
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
363 * way out */
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
364 switch (gaim_value_get_type(handler->argtypes[i])) {
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
365 case GAIM_TYPE_STRING:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
366 if (gaim_value_is_outgoing(handler->argtypes[i])) {
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
367 if (vals[i] != NULL && *(char **)vals[i] != NULL) {
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
368 g_free(*strs[i]);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
369 *strs[i] = g_strdup(vals[i]);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
370 }
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
371 ckfree(vals[i]);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
372 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
373 break;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
374 default:
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
375 /* nothing */
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
376 ;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
377 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
378 }
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
379
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
380 g_string_free(name, TRUE);
10504
1a97d5e88d12 [gaim-migrate @ 11796]
Stu Tomlinson <stu@nosnilmot.com>
parents: 7118
diff changeset
381 g_string_free(val, TRUE);
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
382 g_free(vals);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
383 g_free(strs);
6694
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
384
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
385 return retval;
2d2f04c5c7d2 [gaim-migrate @ 7220]
Ethan Blanton <elb@pidgin.im>
parents:
diff changeset
386 }
10597
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
387
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
388 static Tcl_Obj *new_cb_namespace ()
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
389 {
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
390 static int cbnum;
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
391 char name[32];
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
392
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
393 g_snprintf (name, sizeof(name), "::gaim::_callback::cb_%d", cbnum++);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
394 return Tcl_NewStringObj (name, -1);
0e886a234d92 [gaim-migrate @ 12012]
Ethan Blanton <elb@pidgin.im>
parents: 10519
diff changeset
395 }