# HG changeset patch # User Christian Hammond # Date 1064361788 0 # Node ID 13f78c350cd3caaaa35706ae48706036dab3a2b8 # Parent 1aa7719901887a8e121e10ca6a927e530608ad65 [gaim-migrate @ 7467] Fixed problems with the wrong data being sent to signal callbacks in perl plugins. The resulting code has more sanity checks, but is extremely ugly, and is therefore rated R. Parents, don't let your children see perl-common.c. committer: Tailor Script diff -r 1aa771990188 -r 13f78c350cd3 plugins/perl/perl-common.c --- a/plugins/perl/perl-common.c Tue Sep 23 22:35:00 2003 +0000 +++ b/plugins/perl/perl-common.c Wed Sep 24 00:03:08 2003 +0000 @@ -356,6 +356,31 @@ } #endif +void * +gaim_perl_data_from_sv(GaimValue *value, SV *sv) +{ + STRLEN na; + + switch (gaim_value_get_type(value)) + { + case GAIM_TYPE_BOOLEAN: return (void *)SvIV(sv); + case GAIM_TYPE_INT: return (void *)SvIV(sv); + case GAIM_TYPE_UINT: return (void *)SvUV(sv); + case GAIM_TYPE_LONG: return (void *)SvIV(sv); + case GAIM_TYPE_ULONG: return (void *)SvUV(sv); + case GAIM_TYPE_INT64: return (void *)SvIV(sv); + case GAIM_TYPE_UINT64: return (void *)SvUV(sv); + case GAIM_TYPE_STRING: return (void *)SvPV(sv, na); + case GAIM_TYPE_POINTER: return (void *)SvIV(sv); + case GAIM_TYPE_BOXED: return (void *)SvIV(sv); + + default: + return NULL; + } + + return NULL; +} + static SV * gaim_perl_sv_from_subtype(const GaimValue *value, void *arg) { @@ -381,46 +406,80 @@ } SV * -gaim_perl_sv_from_vargs(const GaimValue *value, va_list args) +gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, + void **copy_arg) { if (gaim_value_is_outgoing(value)) { switch (gaim_value_get_type(value)) { case GAIM_TYPE_SUBTYPE: - return gaim_perl_sv_from_subtype(value, *va_arg(args, void **)); + if ((*copy_arg = va_arg(*args, void **)) == NULL) + return &PL_sv_undef; + + return gaim_perl_sv_from_subtype(value, *(void **)*copy_arg); case GAIM_TYPE_BOOLEAN: - return newSViv(*va_arg(args, gboolean *)); + if ((*copy_arg = va_arg(*args, gboolean *)) == NULL) + return &PL_sv_undef; + + return newSViv(*(gboolean *)*copy_arg); case GAIM_TYPE_INT: - return newSViv(*va_arg(args, int *)); + if ((*copy_arg = va_arg(*args, int *)) == NULL) + return &PL_sv_undef; + + return newSViv(*(int *)*copy_arg); case GAIM_TYPE_UINT: - return newSVuv(*va_arg(args, unsigned int *)); + if ((*copy_arg = va_arg(*args, unsigned int *)) == NULL) + return &PL_sv_undef; + + return newSVuv(*(unsigned int *)*copy_arg); case GAIM_TYPE_LONG: - return newSViv(*va_arg(args, long *)); + if ((*copy_arg = va_arg(*args, long *)) == NULL) + return &PL_sv_undef; + + return newSViv(*(long *)*copy_arg); case GAIM_TYPE_ULONG: - return newSVuv(*va_arg(args, unsigned long *)); + if ((*copy_arg = va_arg(*args, unsigned long *)) == NULL) + return &PL_sv_undef; + + return newSVuv(*(unsigned long *)*copy_arg); case GAIM_TYPE_INT64: - return newSViv(*va_arg(args, gint64 *)); + if ((*copy_arg = va_arg(*args, gint64 *)) == NULL) + return &PL_sv_undef; + + return newSViv(*(gint64 *)*copy_arg); case GAIM_TYPE_UINT64: - return newSVuv(*va_arg(args, guint64 *)); + if ((*copy_arg = va_arg(*args, guint64 *)) == NULL) + return &PL_sv_undef; + + return newSVuv(*(guint64 *)*copy_arg); case GAIM_TYPE_STRING: - return newSVGChar(*va_arg(args, char **)); + if ((*copy_arg = va_arg(*args, char **)) == NULL) + return &PL_sv_undef; + + return newSVGChar(*(char **)*copy_arg); case GAIM_TYPE_POINTER: - return newSViv((IV)*va_arg(args, void **)); + if ((*copy_arg = va_arg(*args, void **)) == NULL) + return &PL_sv_undef; + + return newSViv((IV)*(void **)*copy_arg); case GAIM_TYPE_BOXED: /* Uh.. I dunno. Try this? */ + if ((*copy_arg = va_arg(*args, void **)) == NULL) + return &PL_sv_undef; + return sv_2mortal(gaim_perl_bless_object( - va_arg(args, void **), + *(void **)*copy_arg, gaim_value_get_specific_type(value))); default: @@ -433,39 +492,72 @@ switch (gaim_value_get_type(value)) { case GAIM_TYPE_SUBTYPE: - return gaim_perl_sv_from_subtype(value, va_arg(args, void *)); + if ((*copy_arg = va_arg(*args, void *)) == NULL) + return &PL_sv_undef; + + return gaim_perl_sv_from_subtype(value, *copy_arg); case GAIM_TYPE_BOOLEAN: - return newSViv(va_arg(args, gboolean)); + *copy_arg = (void *)va_arg(*args, gboolean); + + return newSViv((gboolean)*copy_arg); case GAIM_TYPE_INT: - return newSViv(va_arg(args, int)); + *copy_arg = (void *)va_arg(*args, int); + + return newSViv((int)*copy_arg); case GAIM_TYPE_UINT: - return newSVuv(va_arg(args, unsigned int)); + *copy_arg = (void *)va_arg(*args, unsigned int); + + return newSVuv((unsigned int)*copy_arg); case GAIM_TYPE_LONG: - return newSViv(va_arg(args, long)); + *copy_arg = (void *)va_arg(*args, long); + + return newSViv((long)*copy_arg); case GAIM_TYPE_ULONG: - return newSVuv(va_arg(args, unsigned long)); + *copy_arg = (void *)va_arg(*args, unsigned long); + + return newSVuv((unsigned long)*copy_arg); case GAIM_TYPE_INT64: - return newSViv(va_arg(args, gint64)); +#if 0 + /* XXX This yells and complains. */ + *copy_arg = va_arg(*args, gint64); + + return newSViv(*copy_arg); +#endif + break; case GAIM_TYPE_UINT64: - return newSVuv(va_arg(args, guint64)); + /* XXX This also yells and complains. */ +#if 0 + *copy_arg = (void *)va_arg(*args, guint64); + + return newSVuv(*copy_arg); +#endif + break; case GAIM_TYPE_STRING: - return newSVGChar(va_arg(args, char *)); + if ((*copy_arg = (void *)va_arg(*args, char *)) == NULL) + return &PL_sv_undef; + + return newSVGChar(*copy_arg); case GAIM_TYPE_POINTER: - return newSViv((IV)va_arg(args, void *)); + if ((*copy_arg = (void *)va_arg(*args, void *)) == NULL) + return &PL_sv_undef; + + return newSViv((IV)*copy_arg); case GAIM_TYPE_BOXED: /* Uh.. I dunno. Try this? */ - return sv_2mortal(gaim_perl_bless_object( - va_arg(args, void *), + if ((*copy_arg = (void *)va_arg(*args, void *)) == NULL) + return &PL_sv_undef; + + return sv_2mortal(gaim_perl_bless_object(*copy_arg, gaim_value_get_specific_type(value))); default: @@ -473,4 +565,6 @@ return NULL; } } + + return NULL; } diff -r 1aa771990188 -r 13f78c350cd3 plugins/perl/perl-common.h --- a/plugins/perl/perl-common.h Tue Sep 23 22:35:00 2003 +0000 +++ b/plugins/perl/perl-common.h Wed Sep 24 00:03:08 2003 +0000 @@ -38,6 +38,8 @@ SV *gaim_perl_sv_from_value(const GaimValue *value); #endif -SV *gaim_perl_sv_from_vargs(const GaimValue *value, va_list args); +void *gaim_perl_data_from_sv(GaimValue *value, SV *sv); +SV *gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, + void **copy_arg); #endif /* _GAIM_PERL_COMMON_H_ */ diff -r 1aa771990188 -r 13f78c350cd3 plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Tue Sep 23 22:35:00 2003 +0000 +++ b/plugins/perl/perl-handlers.c Wed Sep 24 00:03:08 2003 +0000 @@ -71,7 +71,7 @@ int value_count; GaimValue *ret_value, **values; SV **sv_args; - STRLEN na; + void **copy_args; dSP; ENTER; @@ -81,15 +81,14 @@ gaim_signal_get_values(handler->instance, handler->signal, &ret_value, &value_count, &values); - sv_args = g_new(SV *, value_count); + sv_args = g_new(SV *, value_count); + copy_args = g_new(void *, value_count); for (i = 0; i < value_count; i++) { - SV *sv = gaim_perl_sv_from_vargs(values[i], args); + sv_args[i] = gaim_perl_sv_from_vargs(values[i], &args, ©_args[i]); - sv_args[i] = sv; - - XPUSHs(sv); + XPUSHs(sv_args[i]); } XPUSHs((SV *)handler->data); @@ -105,55 +104,7 @@ if (count != 1) croak("Uh oh! call_sv returned %i != 1", i); else - { - SV *temp_ret_val = POPs; - - switch (gaim_value_get_type(ret_value)) - { - case GAIM_TYPE_BOOLEAN: - ret_val = (void *)SvIV(temp_ret_val); - break; - - case GAIM_TYPE_INT: - ret_val = (void *)SvIV(temp_ret_val); - break; - - case GAIM_TYPE_UINT: - ret_val = (void *)SvUV(temp_ret_val); - break; - - case GAIM_TYPE_LONG: - ret_val = (void *)SvIV(temp_ret_val); - break; - - case GAIM_TYPE_ULONG: - ret_val = (void *)SvUV(temp_ret_val); - break; - - case GAIM_TYPE_INT64: - ret_val = (void *)SvIV(temp_ret_val); - break; - - case GAIM_TYPE_UINT64: - ret_val = (void *)SvUV(temp_ret_val); - break; - - case GAIM_TYPE_STRING: - ret_val = (void *)SvPV(temp_ret_val, na); - break; - - case GAIM_TYPE_POINTER: - ret_val = (void *)SvIV(temp_ret_val); - break; - - case GAIM_TYPE_BOXED: - ret_val = (void *)SvIV(temp_ret_val); - break; - - default: - ret_val = NULL; - } - } + ret_val = gaim_perl_data_from_sv(ret_value, POPs); } else call_sv(handler->callback, G_SCALAR); @@ -163,55 +114,8 @@ { if (gaim_value_is_outgoing(values[i])) { - switch (gaim_value_get_type(values[i])) - { - case GAIM_TYPE_BOOLEAN: - *va_arg(args, gboolean *) = SvIV(sv_args[i]); - break; - - case GAIM_TYPE_INT: - *va_arg(args, int *) = SvIV(sv_args[i]); - break; - - case GAIM_TYPE_UINT: - *va_arg(args, unsigned int *) = SvUV(sv_args[i]); - break; - - case GAIM_TYPE_LONG: - *va_arg(args, long *) = SvIV(sv_args[i]); - break; - - case GAIM_TYPE_ULONG: - *va_arg(args, unsigned long *) = SvUV(sv_args[i]); - break; - - case GAIM_TYPE_INT64: - *va_arg(args, gint64 *) = SvIV(sv_args[i]); - break; - - case GAIM_TYPE_UINT64: - *va_arg(args, guint64 *) = SvUV(sv_args[i]); - break; - - case GAIM_TYPE_STRING: - /* XXX Memory leak! */ - *va_arg(args, char **) = SvPV(sv_args[i], na); - break; - - case GAIM_TYPE_POINTER: - /* XXX Possible memory leak! */ - *va_arg(args, void **) = (void *)SvIV(sv_args[i]); - break; - - case GAIM_TYPE_BOXED: - /* Uh.. I dunno. Try this? Likely won't work. Heh. */ - /* XXX Possible memory leak! */ - *va_arg(args, void **) = (void *)SvIV(sv_args[i]); - break; - - default: - return FALSE; - } + *((void **)copy_args[i]) = gaim_perl_data_from_sv(values[i], + sv_args[i]); } } @@ -219,6 +123,7 @@ LEAVE; g_free(sv_args); + g_free(copy_args); gaim_debug_misc("perl", "ret_val = %p\n", ret_val);