Merge bbf52fa7fa into 24ad80177b

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);
 	}

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;
+}

src/perl/perl-core.h

@@ -1,6 +1,8 @@
 #ifndef __PERL_CORE_H
 #define __PERL_CORE_H
 
+#include <inttypes.h>
+
 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

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);

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,

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);