diff --git a/src/fe-common/core/fe-settings.c b/src/fe-common/core/fe-settings.c index abbd45a8..f1706d23 100644 --- a/src/fe-common/core/fe-settings.c +++ b/src/fe-common/core/fe-settings.c @@ -191,9 +191,9 @@ static void cmd_set(char *data) /* Unpossible! */ break; } - signal_emit("setup changed", 0); printformat(NULL, NULL, MSGLEVEL_CLIENTCRAP, TXT_SET_TITLE, rec->section); set_print(rec); + signal_emit("setup changed", 0); } else printformat(NULL, NULL, MSGLEVEL_CLIENTERROR, TXT_SET_UNKNOWN, key); } diff --git a/src/perl/perl-core.c b/src/perl/perl-core.c index 39389157..8b524fc9 100644 --- a/src/perl/perl-core.c +++ b/src/perl/perl-core.c @@ -35,6 +35,12 @@ #include "XSUB.h" #include "irssi-core.pl.h" +#ifdef TRACE_SCRIPT_UNLOADS +#define SCRIPT_UNLOAD_DEBUG g_message +#else +#define SCRIPT_UNLOAD_DEBUG while(0)g_message +#endif + extern char **environ; GSList *perl_scripts; @@ -72,6 +78,14 @@ static void perl_script_destroy(PERL_SCRIPT_REC *script) signal_emit("script destroyed", 1, script); + perl_script_unref(script); +} + + +static void perl_script_free(PERL_SCRIPT_REC *script) +{ + g_return_if_fail(script->refcount == 0); + g_free(script->name); g_free(script->package); g_free_not_null(script->path); @@ -250,7 +264,7 @@ static int perl_script_eval(PERL_SCRIPT_REC *script) if (error != NULL) { error = g_strdup(error); - signal_emit("script error", 2, script, error); + perl_script_error(script, error); g_free(error); } } @@ -258,7 +272,7 @@ static int perl_script_eval(PERL_SCRIPT_REC *script) FREETMPS; LEAVE; - return error == NULL; + return (!script->destroyed); } /* NOTE: name must not be free'd */ @@ -277,12 +291,18 @@ static PERL_SCRIPT_REC *script_load(char *name, const char *path, script->package = g_strdup_printf("Irssi::Script::%s", name); script->path = g_strdup(path); script->data = g_strdup(data); + script->destroyed = FALSE; + script->disable_signals = -1; + /* two references: one for the script itself, one for our caller */ + script->refcount = 2; perl_scripts = g_slist_append(perl_scripts, script); signal_emit("script created", 1, script); - if (!perl_script_eval(script)) + if (!perl_script_eval(script)) { + perl_script_unref(script); script = NULL; /* the script is destroyed in "script error" signal */ + } return script; } @@ -313,6 +333,13 @@ void perl_script_unload(PERL_SCRIPT_REC *script) { g_return_if_fail(script != NULL); + g_return_if_fail(script->refcount > 0); + + if (script->destroyed) + return; + + script->destroyed = 1; + perl_script_destroy_package(script); perl_script_destroy(script); } @@ -414,7 +441,7 @@ void perl_scripts_autorun(void) fname = g_strdup_printf("%s/%s", path, dp->d_name); if (stat(fname, &statbuf) == 0 && !S_ISDIR(statbuf.st_mode)) - perl_script_load_file(fname); + perl_script_unref(perl_script_load_file(fname)); g_free(fname); } closedir(dirp); @@ -484,3 +511,64 @@ void perl_core_abicheck(int *version) { *version = IRSSI_ABI_VERSION; } + +int perl_script_ref(PERL_SCRIPT_REC *script) +{ + g_return_val_if_fail(script != NULL, FALSE); + g_return_val_if_fail(script->refcount > 0, FALSE); + + /* If the script's been destroyed, there's no point calling into it. */ + + if (script->destroyed) { + g_warning("rejecting attempt to reference destroyed script %p (%s)\n", script, script->name); + return FALSE; + } + + if (++script->refcount == UINT8_MAX) { + --script->refcount; + /* something is almost certainly wrong here. */ + /* Report an error; that'll most likely cause the offending script to be unloaded. */ + perl_script_error(script, "Too much signal/command recursion"); + return FALSE; + } + + SCRIPT_UNLOAD_DEBUG("reference count for %p (%s) is now %d\n", script, script->name, script->refcount); + return TRUE; +} + +void perl_script_unref(PERL_SCRIPT_REC *script) +{ + /* this makes it easier to use perl_load_script_data() and perl_load_script_file() */ + if (script == NULL) + return; + + g_return_if_fail(script->refcount > 0); + + if (--script->refcount == 0) { + SCRIPT_UNLOAD_DEBUG("freeing script %p (%s)\n", script, script->name); + perl_script_free(script); + } else { + SCRIPT_UNLOAD_DEBUG("not freeing script %p (%s); refcount is now %d\n", + script, script->name, script->refcount); + } +} + +void perl_script_error(PERL_SCRIPT_REC *script, const char *error) +{ + g_return_if_fail(script != NULL); + g_return_if_fail(script->refcount > 0); + + /* Don't bother reporting errors in destroyed scripts */ + if (script->destroyed) { + SCRIPT_UNLOAD_DEBUG("suppressing script error notification for destroyed script"); + return; + } + + if (++script->disable_signals > 0) { + g_warning("Recursive error detected in script %s", script->name); + } + + signal_emit("script error", 2, script, error); + + --script->disable_signals; +} diff --git a/src/perl/perl-core.h b/src/perl/perl-core.h index 7390a6fd..b66ab65b 100644 --- a/src/perl/perl-core.h +++ b/src/perl/perl-core.h @@ -1,6 +1,8 @@ #ifndef __PERL_CORE_H #define __PERL_CORE_H +#include + typedef struct { char *name; /* unique name */ char *package; /* package name */ @@ -8,6 +10,17 @@ typedef struct { /* Script can be loaded from a file, or from some data in memory */ char *path; /* FILE: full path for file */ char *data; /* DATA: data used for the script */ + + /** Script destruction flag. If TRUE, the script has been + * destroyed/unloaded. + */ + uint8_t destroyed; + /** Script signal suppression counter. If greater than zero, + * signals and commands should not be delivered to the script. + */ + int8_t disable_signals; + /** PERL_SCRIPT_REC reference counter. */ + uint8_t refcount; } PERL_SCRIPT_REC; extern GSList *perl_scripts; @@ -19,9 +32,17 @@ void perl_scripts_deinit(void); /* Load all the scripts in the autorun/ folder */ void perl_scripts_autorun(void); -/* Load a perl script, path must be a full path. */ +/** Load a perl script, path must be a full path. + * If an error occurs while loading the script, the return value is NULL. + * Otherwise, the returned pointer has an extra reference that must be + * released with perl_script_unref(). + */ PERL_SCRIPT_REC *perl_script_load_file(const char *path); -/* Load a perl script from given data */ +/** Load a perl script from given data. + * If an error occurs while loading the script, the return value is NULL. + * Otherwise, the returned pointer has an extra reference that must be + * released with perl_script_unref(). + */ PERL_SCRIPT_REC *perl_script_load_data(const char *data); /* Unload perl script */ void perl_script_unload(PERL_SCRIPT_REC *script); @@ -55,4 +76,26 @@ int perl_get_api_version(void); void perl_core_init(void); void perl_core_deinit(void); +/** Attempts to reference a PERL_SCRIPT_REC structure, preventing it from + * being freed. + * + * Returns TRUE if a reference was taken; each reference must be released + * by calling perl_script_unref(). + * Returns FALSE if a reference was not made (this can happen if the + * if the associated script has already been destroyed.) + */ + +int perl_script_ref(PERL_SCRIPT_REC *script); + +/** Releases a PERL_SCRIPT_REC structure, potentially allowing it to be + * freed. + * If @param script is NULL, this function does nothing. + */ + +void perl_script_unref(PERL_SCRIPT_REC *script); + +/** Used to report that an error occurred while calling into a script. + */ +void perl_script_error(PERL_SCRIPT_REC *script, const char *error); + #endif diff --git a/src/perl/perl-fe.c b/src/perl/perl-fe.c index 396c80b7..a11034f5 100644 --- a/src/perl/perl-fe.c +++ b/src/perl/perl-fe.c @@ -59,7 +59,7 @@ static void cmd_script_exec(const char *data) /* not a permanent script, unload immediately */ perl_script_unload(script); } - + perl_script_unref(script); cmd_params_free(free_arg); } @@ -87,6 +87,7 @@ static void cmd_script_load(const char *data) TXT_SCRIPT_LOADED, script->name, script->path); } + perl_script_unref(script); g_free(fname); } cmd_params_free(free_arg); diff --git a/src/perl/perl-signals.c b/src/perl/perl-signals.c index 8f993660..0ff3eb65 100644 --- a/src/perl/perl-signals.c +++ b/src/perl/perl-signals.c @@ -302,9 +302,13 @@ static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func, perl_call_sv(func, G_EVAL|G_DISCARD); SPAGAIN; + /* if script->destroyed is nonzero, rec is no longer valid */ + if (script->destroyed) + rec = NULL; + if (SvTRUE(ERRSV)) { char *error = g_strdup(SvPV_nolen(ERRSV)); - signal_emit("script error", 2, script, error); + perl_script_error(script, error); g_free(error); rec = NULL; } @@ -354,13 +358,23 @@ static void sig_func(const void *p1, const void *p2, const void *p5, const void *p6) { PERL_SIGNAL_REC *rec; + PERL_SCRIPT_REC *script; const void *args[6]; args[0] = p1; args[1] = p2; args[2] = p3; args[3] = p4; args[4] = p5; args[5] = p6; rec = signal_get_user_data(); - perl_call_signal(rec->script, rec->func, signal_get_emitted_id(), args); + + /* save off rec->script; after perl_call_signal, rec may be gone */ + script = rec->script; + + if (script->disable_signals > 0) + return; + if (!perl_script_ref(script)) + return; + perl_call_signal(script, rec->func, signal_get_emitted_id(), args); + perl_script_unref(script); } static void perl_signal_add_full_int(const char *signal, SV *func, diff --git a/src/perl/perl-sources.c b/src/perl/perl-sources.c index 0b49a608..99453f0d 100644 --- a/src/perl/perl-sources.c +++ b/src/perl/perl-sources.c @@ -70,6 +70,11 @@ static int perl_source_event(PERL_SOURCE_REC *rec) { dSP; + if (!perl_script_ref(rec->script)) { + g_error("Unexpected event for destroyed script %s", rec->script->name); + return G_SOURCE_CONTINUE; + } + ENTER; SAVETMPS; @@ -82,10 +87,12 @@ static int perl_source_event(PERL_SOURCE_REC *rec) if (SvTRUE(ERRSV)) { char *error = g_strdup(SvPV_nolen(ERRSV)); - signal_emit("script error", 2, rec->script, error); + perl_script_error(rec->script, error); g_free(error); } + perl_script_unref(rec->script); + if (perl_source_unref(rec) && rec->once) perl_source_destroy(rec);