Fix segfault when 'script error' handlers fail

Add logic to detect errors in 'script error' handlers, and prevent
them from causing infinite recursion that crashes the entire program.

src/perl/perl-core.c

@@ -35,6 +35,17 @@
 #include "XSUB.h"
 #include "irssi-core.pl.h"
 
+/* Values for script_error_status */
+
+/* No script error */
+#define SES_NO_ERROR 0
+/* Script error being emitted */
+#define SES_EMIT_ERROR 1
+/* Script destroyed; free memory */
+#define SES_DESTROY 2
+/* Used to help detect use-after-free */
+#define SES_DEAD 127
+
 extern char **environ;
 
 GSList *perl_scripts;
@@ -46,6 +57,8 @@ static char *perl_args[] = {"", "-e", "0", NULL};
 #define IS_PERL_SCRIPT(file) \
 	(strlen(file) > 3 && g_strcmp0(file+strlen(file)-3, ".pl") == 0)
 
+static void perl_script_free(PERL_SCRIPT_REC *script);
+
 static void perl_script_destroy_package(PERL_SCRIPT_REC *script)
 {
 	dSP;
@@ -72,6 +85,21 @@ static void perl_script_destroy(PERL_SCRIPT_REC *script)
 
 	signal_emit("script destroyed", 1, script);
 
+	if (script->script_error_status) {
+		/* we're in the middle of a 'script error' signal.
+		 * set the status so perl_report_script_error knows to free
+		 * the script object after everything's finished.
+		 */
+		script->script_error_status = SES_DESTROY;
+	} else
+		perl_script_free(script);
+}
+
+
+static void perl_script_free(PERL_SCRIPT_REC *script)
+{
+	script->script_error_status = SES_DEAD;
+
 	g_free(script->name);
 	g_free(script->package);
         g_free_not_null(script->path);
@@ -250,7 +278,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_report_script_error(script, error);
 			g_free(error);
 		}
 	}
@@ -277,6 +305,8 @@ 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->script_error_status = SES_NO_ERROR;
+	script->disable_signals = FALSE;
 
 	perl_scripts = g_slist_append(perl_scripts, script);
 	signal_emit("script created", 1, script);
@@ -484,3 +514,31 @@ void perl_core_abicheck(int *version)
 {
 	*version = IRSSI_ABI_VERSION;
 }
+
+void perl_report_script_error(PERL_SCRIPT_REC *script, const char *error)
+{
+	if (script->script_error_status) {
+		/* while emitting a script error for this script,
+		 * we got another error, which is a recipe for disaster.
+		 * Nip it in the bud.
+		 */
+		script->disable_signals = TRUE;
+		/* We also need to stop the spread of the current signal,
+		 * because after the next call, our script may be gone. */
+		signal_stop();
+		signal_emit("script error", 2, script, error);
+		return;
+	}
+	/* we are now emitting a script error */
+	script->script_error_status = SES_EMIT_ERROR;
+	signal_emit("script error", 2, script, error);
+	if (script->script_error_status == SES_DESTROY) {
+		/* script was destroyed */
+		perl_script_free(script);
+	} else {
+		/* script was not destroyed, clear emit status */
+		script->script_error_status = SES_NO_ERROR;
+		/* also restore signal handlers if we disabled them */
+		script->disable_signals = FALSE;
+	}
+}

src/perl/perl-core.h

@@ -8,6 +8,10 @@ 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 */
+
+	/* internal bookkeeping */
+	char script_error_status; /* script error status */
+	char disable_signals; /* don't deliver signals to this script */
 } PERL_SCRIPT_REC;
 
 extern GSList *perl_scripts;
@@ -55,4 +59,9 @@ int perl_get_api_version(void);
 void perl_core_init(void);
 void perl_core_deinit(void);
 
+/* Reports script errors.
+ * Upon return, @param script may have been (and probably was) freed.
+ */
+void perl_report_script_error(PERL_SCRIPT_REC *script, const char *error);
+
 #endif

src/perl/perl-signals.c

@@ -304,7 +304,7 @@ static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
 
 	if (SvTRUE(ERRSV)) {
 		char *error = g_strdup(SvPV_nolen(ERRSV));
-		signal_emit("script error", 2, script, error);
+		perl_report_script_error(script, error);
                 g_free(error);
                 rec = NULL;
 	}
@@ -360,6 +360,8 @@ static void sig_func(const void *p1, const void *p2,
 	args[3] = p4; args[4] = p5; args[5] = p6;
 
 	rec = signal_get_user_data();
+	if (rec->script->disable_signals)
+		return;
 	perl_call_signal(rec->script, rec->func, signal_get_emitted_id(), args);
 }
 

src/perl/perl-sources.c

@@ -82,7 +82,7 @@ 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_report_script_error(rec->script, error);
                 g_free(error);
 	}