view libpurple/plugins/tcl/tcl_signals.c @ 28290:c9d3bda6ef81

Fix some problems adding "stuff" to oscar buddy lists, where "stuff" is often buddies to block, but can also be buddies to allow or maybe your privacy setting. I imagine this eliminates some "unable to add buddy" errors. Apparently I discovered this idiosyncrasy on 2007-04-23 and fixed it for icon items in 5ee6fd5ddac3a8e8920941dee8be3ae5a615c105, but for some reason I didn't fix it for any other types of items. I'm also making this loop a bit less heavy handed... it used to require that new items had an itemID greater than every other item. Now it just makes sure the itemID is not equal the itemID and not equal to the groupID of any other item. Let it be known that the best way for me to fix blocking is to have people I don't want to talk to IM me.

/**
 * @file tcl_signals.c Purple Tcl signal API
 *
 * purple
 *
 * Copyright (C) 2003 Ethan Blanton <[e-mail]>
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02111-1301  USA
 */
#include <tcl.h>
#include <stdarg.h>

#include "tcl_purple.h"

#include "internal.h"
#include "connection.h"
#include "conversation.h"
#include "signals.h"
#include "debug.h"
#include "value.h"
#include "core.h"

static GList *tcl_callbacks;

static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler);
static Tcl_Obj *new_cb_namespace (void);

void tcl_signal_init()
{
	tcl_callbacks = NULL;
}

void tcl_signal_handler_free(struct tcl_signal_handler *handler)
{
	if (handler == NULL)
		return;

	Tcl_DecrRefCount(handler->signal);
	if (handler->namespace)
	{
		Tcl_DecrRefCount(handler->namespace);
	}
	g_free(handler);
}

void tcl_signal_cleanup(Tcl_Interp *interp)
{
	GList *cur;
	struct tcl_signal_handler *handler;

	for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
		handler = cur->data;
		if (handler->interp == interp) {
			tcl_signal_handler_free(handler);
			cur->data = NULL;
		}
	}
	tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
}

gboolean tcl_signal_connect(struct tcl_signal_handler *handler)
{
	GString *proc;

	purple_signal_get_values(handler->instance,
			       Tcl_GetString(handler->signal),
			       &handler->returntype, &handler->nargs,
			       &handler->argtypes);

	tcl_signal_disconnect(handler->interp, Tcl_GetString(handler->signal),
			      handler->interp);

	if (!purple_signal_connect_vargs(handler->instance,
				       Tcl_GetString(handler->signal),
				       (void *)handler->interp,
				       PURPLE_CALLBACK(tcl_signal_callback),
				       (void *)handler))
		return FALSE;

	handler->namespace = new_cb_namespace ();
	Tcl_IncrRefCount(handler->namespace);
	proc = g_string_new("");
	g_string_append_printf(proc, "namespace eval %s { proc cb { %s } { %s } }",
			       Tcl_GetString(handler->namespace),
			       Tcl_GetString(handler->args),
	                       Tcl_GetString(handler->proc));
	if (Tcl_Eval(handler->interp, proc->str) != TCL_OK) {
		Tcl_DecrRefCount(handler->namespace);
		g_string_free(proc, TRUE);
		return FALSE;
	}
	g_string_free(proc, TRUE);

	tcl_callbacks = g_list_append(tcl_callbacks, (gpointer)handler);

	return TRUE;
}

void tcl_signal_disconnect(void *instance, const char *signal, Tcl_Interp *interp)
{
	GList *cur;
	struct tcl_signal_handler *handler;
	gboolean found = FALSE;
	GString *cmd;

	for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
		handler = cur->data;
		if (handler->interp == interp && handler->instance == instance 
		    && !strcmp(signal, Tcl_GetString(handler->signal))) {
			purple_signal_disconnect(instance, signal, handler->interp,
					       PURPLE_CALLBACK(tcl_signal_callback));
			cmd = g_string_sized_new(64);
			g_string_printf(cmd, "namespace delete %s",
					Tcl_GetString(handler->namespace));
			Tcl_EvalEx(interp, cmd->str, -1, TCL_EVAL_GLOBAL);
			tcl_signal_handler_free(handler);
			g_string_free(cmd, TRUE);
			cur->data = NULL;
			found = TRUE;
			break;
		}
	}
	if (found)
		tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
}

static PurpleStringref *ref_type(PurpleSubType type)
{
	switch (type) {
	case PURPLE_SUBTYPE_ACCOUNT:
		return PurpleTclRefAccount;
	case PURPLE_SUBTYPE_CONNECTION:
		return PurpleTclRefConnection;
	case PURPLE_SUBTYPE_CONVERSATION:
		return PurpleTclRefConversation;
	case PURPLE_SUBTYPE_PLUGIN:
		return PurpleTclRefPlugin;
	case PURPLE_SUBTYPE_STATUS:
		return PurpleTclRefStatus;
	case PURPLE_SUBTYPE_XFER:
		return PurpleTclRefXfer;
	default:
		return NULL;
	}
}

static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler)
{
	GString *name, *val;
	PurpleBlistNode *node;
	int error, i;
	void *retval = NULL;
	Tcl_Obj *cmd, *arg, *result;
	void **vals; /* Used for inout parameters */
	char ***strs;

	vals = g_new0(void *, handler->nargs);
	strs = g_new0(char **, handler->nargs);
	name = g_string_sized_new(32);
	val = g_string_sized_new(32);

	cmd = Tcl_NewListObj(0, NULL);
	Tcl_IncrRefCount(cmd);

	arg = Tcl_DuplicateObj(handler->namespace);
	Tcl_AppendStringsToObj(arg, "::cb", NULL);
	Tcl_ListObjAppendElement(handler->interp, cmd, arg);

	for (i = 0; i < handler->nargs; i++) {
		if (purple_value_is_outgoing(handler->argtypes[i]))
			g_string_printf(name, "%s::arg%d",
					Tcl_GetString(handler->namespace), i);

		switch(purple_value_get_type(handler->argtypes[i])) {
		case PURPLE_TYPE_UNKNOWN:	/* What?  I guess just pass the word ... */
			/* treat this as a pointer, but complain first */
			purple_debug(PURPLE_DEBUG_ERROR, "tcl", "unknown PurpleValue type %d\n",
				   purple_value_get_type(handler->argtypes[i]));
		case PURPLE_TYPE_POINTER:
		case PURPLE_TYPE_OBJECT:
		case PURPLE_TYPE_BOXED:
			/* These are all "pointer" types to us */
			if (purple_value_is_outgoing(handler->argtypes[i]))
				purple_debug_error("tcl", "pointer types do not currently support outgoing arguments\n");
			arg = purple_tcl_ref_new(PurpleTclRefPointer, va_arg(args, void *));
			break;
		case PURPLE_TYPE_BOOLEAN:
			if (purple_value_is_outgoing(handler->argtypes[i])) {
				vals[i] = va_arg(args, gboolean *);
				Tcl_LinkVar(handler->interp, name->str,
					    (char *)&vals[i], TCL_LINK_BOOLEAN);
				arg = Tcl_NewStringObj(name->str, -1);
			} else {
				arg = Tcl_NewBooleanObj(va_arg(args, gboolean));
			}
			break;
		case PURPLE_TYPE_CHAR:
		case PURPLE_TYPE_UCHAR:
		case PURPLE_TYPE_SHORT:
		case PURPLE_TYPE_USHORT:
		case PURPLE_TYPE_INT:
		case PURPLE_TYPE_UINT:
		case PURPLE_TYPE_LONG:
		case PURPLE_TYPE_ULONG:
		case PURPLE_TYPE_ENUM:
			/* I should really cast these individually to
			 * preserve as much information as possible ...
			 * but heh */
			if (purple_value_is_outgoing(handler->argtypes[i])) {
				vals[i] = va_arg(args, int *);
				Tcl_LinkVar(handler->interp, name->str,
					    vals[i], TCL_LINK_INT);
				arg = Tcl_NewStringObj(name->str, -1);
			} else {
				arg = Tcl_NewIntObj(va_arg(args, int));
			}
			break;
		case PURPLE_TYPE_INT64:
		case PURPLE_TYPE_UINT64:
			/* Tcl < 8.4 doesn't have wide ints, so we have ugly
			 * ifdefs in here */
			if (purple_value_is_outgoing(handler->argtypes[i])) {
				vals[i] = (void *)va_arg(args, gint64 *);
				#if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
				Tcl_LinkVar(handler->interp, name->str,
					    vals[i], TCL_LINK_WIDE_INT);
				#else
				/* This is going to cause weirdness at best,
				 * but what do you want ... we're losing
				 * precision */
				Tcl_LinkVar(handler->interp, name->str,
					    vals[i], TCL_LINK_INT);
				#endif /* Tcl >= 8.4 */
				arg = Tcl_NewStringObj(name->str, -1);
			} else {
				#if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
				arg = Tcl_NewWideIntObj(va_arg(args, gint64));
				#else
				arg = Tcl_NewIntObj((int)va_arg(args, int));
				#endif /* Tcl >= 8.4 */
			}
			break;
		case PURPLE_TYPE_STRING:
			if (purple_value_is_outgoing(handler->argtypes[i])) {
				strs[i] = va_arg(args, char **);
				if (strs[i] == NULL || *strs[i] == NULL) {
					vals[i] = ckalloc(1);
					*(char *)vals[i] = '\0';
				} else {
					vals[i] = ckalloc(strlen(*strs[i]) + 1);
					strcpy(vals[i], *strs[i]);
				}
				Tcl_LinkVar(handler->interp, name->str,
					    (char *)&vals[i], TCL_LINK_STRING);
				arg = Tcl_NewStringObj(name->str, -1);
			} else {
				arg = Tcl_NewStringObj(va_arg(args, char *), -1);
			}
			break;
		case PURPLE_TYPE_SUBTYPE:
			switch (purple_value_get_subtype(handler->argtypes[i])) {
			case PURPLE_SUBTYPE_UNKNOWN:
				purple_debug(PURPLE_DEBUG_ERROR, "tcl", "subtype unknown\n");
			case PURPLE_SUBTYPE_ACCOUNT:
			case PURPLE_SUBTYPE_CONNECTION:
			case PURPLE_SUBTYPE_CONVERSATION:
			case PURPLE_SUBTYPE_STATUS:
			case PURPLE_SUBTYPE_PLUGIN:
			case PURPLE_SUBTYPE_XFER:
				if (purple_value_is_outgoing(handler->argtypes[i]))
					purple_debug_error("tcl", "pointer subtypes do not currently support outgoing arguments\n");
				arg = purple_tcl_ref_new(ref_type(purple_value_get_subtype(handler->argtypes[i])), va_arg(args, void *));
				break;
			case PURPLE_SUBTYPE_BLIST:
			case PURPLE_SUBTYPE_BLIST_BUDDY:
			case PURPLE_SUBTYPE_BLIST_GROUP:
			case PURPLE_SUBTYPE_BLIST_CHAT:
				/* We're going to switch again for code-deduping */
				if (purple_value_is_outgoing(handler->argtypes[i]))
					node = *va_arg(args, PurpleBlistNode **);
				else
					node = va_arg(args, PurpleBlistNode *);
				switch (purple_blist_node_get_type(node)) {
				case PURPLE_BLIST_GROUP_NODE:
					arg = Tcl_NewListObj(0, NULL);
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj("group", -1));
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj(purple_group_get_name((PurpleGroup *)node), -1));
					break;
				case PURPLE_BLIST_CONTACT_NODE:
					/* g_string_printf(val, "contact {%s}", Contact Name? ); */
					arg = Tcl_NewStringObj("contact", -1);
					break;
				case PURPLE_BLIST_BUDDY_NODE:
					arg = Tcl_NewListObj(0, NULL);
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj("buddy", -1));
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj(purple_buddy_get_name((PurpleBuddy *)node), -1));
					Tcl_ListObjAppendElement(handler->interp, arg,
								 purple_tcl_ref_new(PurpleTclRefAccount,
										    purple_buddy_get_account((PurpleBuddy *)node)));
					break;
				case PURPLE_BLIST_CHAT_NODE:
					arg = Tcl_NewListObj(0, NULL);
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj("chat", -1));
					Tcl_ListObjAppendElement(handler->interp, arg,
								 Tcl_NewStringObj(purple_chat_get_name((PurpleChat *)node), -1));
					Tcl_ListObjAppendElement(handler->interp, arg,
								 purple_tcl_ref_new(PurpleTclRefAccount,
										  purple_chat_get_account((PurpleChat *)node)));
					break;
				case PURPLE_BLIST_OTHER_NODE:
					arg = Tcl_NewStringObj("other", -1);
					break;
				}
				break;
			}
		}
		Tcl_ListObjAppendElement(handler->interp, cmd, arg);
	}

	/* Call the friggin' procedure already */
	if ((error = Tcl_EvalObjEx(handler->interp, cmd, TCL_EVAL_GLOBAL)) != TCL_OK) {
		purple_debug(PURPLE_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n",
			   Tcl_GetString(Tcl_GetObjResult(handler->interp)));
	} else {
		result = Tcl_GetObjResult(handler->interp);
		/* handle return values -- strings and words only */
		if (handler->returntype) {
			if (purple_value_get_type(handler->returntype) == PURPLE_TYPE_STRING) {
				retval = (void *)g_strdup(Tcl_GetString(result));
			} else {
				if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) {
					purple_debug(PURPLE_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n",
						   Tcl_GetString(Tcl_GetObjResult(handler->interp)));
					retval = NULL;
				}
			}
		}
	}

	/* And finally clean up */
	for (i = 0; i < handler->nargs; i++) {
		g_string_printf(name, "%s::arg%d",
				Tcl_GetString(handler->namespace), i);
		if (purple_value_is_outgoing(handler->argtypes[i])
		    && purple_value_get_type(handler->argtypes[i]) != PURPLE_TYPE_SUBTYPE)
			Tcl_UnlinkVar(handler->interp, name->str);

		/* We basically only have to deal with strings on the
		 * way out */
		switch (purple_value_get_type(handler->argtypes[i])) {
		case PURPLE_TYPE_STRING:
			if (purple_value_is_outgoing(handler->argtypes[i])) {
				if (vals[i] != NULL && *(char **)vals[i] != NULL) {
					g_free(*strs[i]);
					*strs[i] = g_strdup(vals[i]);
				}
				ckfree(vals[i]);
			}
			break;
		default:
			/* nothing */
			;
		}
	}

	g_string_free(name, TRUE);
	g_string_free(val, TRUE);
	g_free(vals);
	g_free(strs);

	return retval;
}

static Tcl_Obj *new_cb_namespace ()
{
	static int cbnum;
	char name[32];

	g_snprintf (name, sizeof(name), "::purple::_callback::cb_%d", cbnum++);
	return Tcl_NewStringObj (name, -1);
}