dev-perl/SDL: try more memory safety fixes

Debian are using these. I still get a UAF in the tests though.

Bug: https://bugs.gentoo.org/907609
Signed-off-by: Sam James <sam@gentoo.org>

3 files changed, 212 insertions, 0 deletions

diff --git a/dev-perl/SDL/SDL-2.548.0-r3.ebuild b/dev-perl/SDL/SDL-2.548.0-r3.ebuild
new file mode 100644
index 000000000000..51fadb44ea35
--- /dev/null
+++ b/dev-perl/SDL/SDL-2.548.0-r3.ebuild
@@ -0,0 +1,58 @@
+# Copyright 1999-2024 Gentoo Authors
+# Distributed under the terms of the GNU General Public License v2
+
+EAPI=8
+
+DIST_AUTHOR=FROGGS
+DIST_VERSION=2.548
+inherit perl-module
+
+DESCRIPTION="Simple DirectMedia Layer (SDL) bindings for perl"
+HOMEPAGE="http://sdl.perl.org/ https://search.cpan.org/dist/SDL/ https://github.com/PerlGameDev/SDL"
+
+LICENSE="GPL-2 OFL-1.1"
+SLOT="0"
+KEYWORDS="~amd64 ~hppa ~x86"
+
+RDEPEND="
+	>=dev-perl/Alien-SDL-1.446
+	dev-perl/Capture-Tiny
+	>=virtual/perl-CPAN-1.920.0
+	>=virtual/perl-ExtUtils-CBuilder-0.260.301
+	>=dev-perl/File-ShareDir-1.0.0
+	>=dev-perl/Module-Build-0.400.0
+	media-libs/libjpeg-turbo
+	virtual/perl-Scalar-List-Utils
+	dev-perl/Tie-Simple
+	media-libs/libpng:0
+	media-libs/libsdl
+	media-libs/sdl-gfx
+	media-libs/sdl-image
+	media-libs/sdl-mixer
+	media-libs/sdl-pango
+	media-libs/sdl-ttf
+	media-libs/smpeg
+	media-libs/tiff:0
+	virtual/glu
+	virtual/opengl
+"
+BDEPEND="${RDEPEND}
+	test? (
+		>=dev-perl/Test-Most-0.210.0
+	)
+"
+
+mydoc='CHANGELOG README TODO'
+
+PERL_RM_FILES=(
+	# Hangs, see bug #892011 and https://aur.archlinux.org/packages/perl-sdl#comment-903413.
+	t/core_video.t
+)
+
+PATCHES=(
+	"${FILESDIR}"/${PN}-2.546-pointer.patch
+	"${FILESDIR}"/${PN}-2.546-implicit-func-decl.patch
+	"${FILESDIR}"/${PN}-2.548-perl537_sv_nv.patch
+	"${FILESDIR}"/${PN}-2.548-refcount.patch
+	"${FILESDIR}"/${PN}-2.548-uaf-surface.patch
+)
diff --git a/dev-perl/SDL/files/SDL-2.548-refcount.patch b/dev-perl/SDL/files/SDL-2.548-refcount.patch
new file mode 100644
index 000000000000..af150e35d2ba
--- /dev/null
+++ b/dev-perl/SDL/files/SDL-2.548-refcount.patch
@@ -0,0 +1,27 @@
+https://github.com/PerlGameDev/SDL/pull/308
+
+From fbf151a7481a5fda88bfe766d826fe55476cf4af Mon Sep 17 00:00:00 2001
+From: Colin Watson <cjwatson@debian.org>
+Date: Thu, 28 Mar 2024 13:21:47 +0000
+Subject: [PATCH] Fix reference-counting in set_event_filter
+
+This previously resulted in the following test failure with Perl 5.38.2
+on Debian unstable (https://bugs.debian.org/1064761):
+
+    t/core_events.t ................. 1/? Can't use an undefined value as a subroutine reference during global destruction.
+    t/core_events.t ................. Dubious, test returned 22 (wstat 5632, 0x1600)
+    All 691 subtests passed
+            (less 1 skipped subtest: 690 okay)
+--- a/src/Core/Events.xs
++++ b/src/Core/Events.xs
+@@ -102,7 +102,8 @@ void
+ events_set_event_filter(callback)
+ 	SV* callback
+ 	CODE:
+-		eventfiltersv = callback;
++		SvREFCNT_dec(eventfiltersv);
++		eventfiltersv = SvREFCNT_inc_simple(callback);
+ 		SDL_SetEventFilter((SDL_EventFilter) eventfilter_cb);
+ 
+ AV *
+
diff --git a/dev-perl/SDL/files/SDL-2.548-uaf-surface.patch b/dev-perl/SDL/files/SDL-2.548-uaf-surface.patch
new file mode 100644
index 000000000000..d64d27eab89b
--- /dev/null
+++ b/dev-perl/SDL/files/SDL-2.548-uaf-surface.patch
@@ -0,0 +1,127 @@
+https://github.com/PerlGameDev/SDL/pull/306
+https://github.com/PerlGameDev/SDL/issues/305
+https://github.com/libsdl-org/sdl12-compat/issues/305
+
+From e9b907c08d9fcce4fccb3084ff38e65cb5c6828b Mon Sep 17 00:00:00 2001
+From: Simon McVittie <smcv@debian.org>
+Date: Tue, 18 Jul 2023 18:00:12 +0100
+Subject: [PATCH] Distinguish between owned and borrowed references to a
+ SDL_Surface
+
+In many SDL APIs that return a SDL_Surface *, the surface is considered
+to be owned by the caller, and must be freed by the caller.
+
+However, SDL_SetVideoMode and presumably SDL_GetVideoSurface return
+a pointer to SDL's internal video surface, which will be freed by SDL
+if necessary, and must not be freed by library users.
+Incorrectly freeing this surface can lead to a use-after-free crash,
+manifesting as a test failure in t/core_video.t.
+
+See also https://github.com/libsdl-org/sdl12-compat/issues/305
+
+Resolves: https://github.com/PerlGameDev/SDL/issues/305
+Signed-off-by: Simon McVittie <smcv@debian.org>
+---
+ src/Core/Video.xs |  6 ++++--
+ src/helper.h      |  7 ++++---
+ typemap           | 23 +++++++++++++++++++++++
+ 3 files changed, 31 insertions(+), 5 deletions(-)
+
+diff --git a/src/Core/Video.xs b/src/Core/Video.xs
+index 8efa4b4a..e0d1a679 100644
+--- a/src/Core/Video.xs
++++ b/src/Core/Video.xs
+@@ -10,6 +10,8 @@
+ 
+ #include <SDL.h>
+ 
++typedef SDL_Surface SDL_Surface_borrowed;
++
+ void _uinta_free(Uint16* av, int len_from_av_len)
+ {
+ 	if( av != NULL)
+@@ -56,7 +58,7 @@ See: L<http:/*www.libsdl.org/cgi/docwiki.cgi/SDL_API#head-813f033ec44914f267f321
+ 
+ =cut
+ 
+-SDL_Surface *
++SDL_Surface_borrowed *
+ video_get_video_surface()
+ 	PREINIT:
+ 		char* CLASS = "SDL::Surface";
+@@ -125,7 +127,7 @@ video_video_mode_ok ( width, height, bpp, flags )
+ 		RETVAL
+ 
+ 
+-SDL_Surface *
++SDL_Surface_borrowed *
+ video_set_video_mode ( width, height, bpp, flags )
+ 	int width
+ 	int height
+diff --git a/src/helper.h b/src/helper.h
+index 1d2ee9a5..6b8e4ab5 100644
+--- a/src/helper.h
++++ b/src/helper.h
+@@ -58,12 +58,13 @@ void objDESTROY(SV *bag, void (* callback)(void *object))
+         Uint32 *threadid = (Uint32*)(pointers[2]);
+         
+         if(PERL_GET_CONTEXT == pointers[1]
+-        && *threadid == SDL_ThreadID())
++        && (threadid == NULL || *threadid == SDL_ThreadID()))
+         {
+             pointers[0] = NULL;
+-            if(object)
++            if(object && threadid != NULL)
+                 callback(object);
+-            safefree(threadid);
++            if (threadid != NULL)
++                safefree(threadid);
+             safefree(pointers);
+         }
+     }
+diff --git a/typemap b/typemap
+index c3ba997a..85a19265 100644
+--- a/typemap
++++ b/typemap
+@@ -34,6 +34,7 @@ SDL_UserEvent * 	O_OBJECT
+ SDL_QuitEvent * 	O_OBJECT
+ SDL_keysym *		O_OBJECT
+ SDL_Surface *		O_OBJECT
++SDL_Surface_borrowed *	O_BORROWED
+ SDL_SysWMmsg *		T_PTR
+ SDL_CD *		O_OBJECT
+ SDL_CDtrack *		O_OBJECT
+@@ -122,6 +123,17 @@ O_OBJECT
+         XSRETURN_UNDEF;
+     }
+ 
++O_BORROWED
++    if ($var) {
++        void** pointers  = malloc(3 * sizeof(void*));
++        pointers[0]      = (void*)$var;
++        pointers[1]      = (void*)PERL_GET_CONTEXT;
++        pointers[2]      = NULL;
++        sv_setref_pv( $arg, CLASS, (void*)pointers );
++    } else {
++        XSRETURN_UNDEF;
++    }
++
+ INPUT
+ 
+ O_OBJECT_NPGC
+@@ -136,3 +148,14 @@ O_OBJECT
+     } else {
+         XSRETURN_UNDEF;
+     }
++
++O_BORROWED
++    /* Same as O_OBJECT */
++    if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) {
++        void** pointers = (void**)INT2PTR(void *, SvIV((SV *)SvRV( $arg )));
++        $var = ($type)(pointers[0]);
++    } else if ($arg == 0) {
++        XSRETURN(0);
++    } else {
++        XSRETURN_UNDEF;
++    }
+