Safely store user locks in threads::shared

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510704231021l6989ee0bkd68ab89e99bf8c6b@mail.gmail.com>

p4raw-id: //depot/perl@31079

diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes
index 6ff6f52..ec20c8d 100644 (file)
--- a/ext/threads/shared/Changes
+++ b/ext/threads/shared/Changes
@@ -2,6 +2,7 @@ Revision history for Perl extension threads::shared.
 
 -
        - Modify stress test to be TODO under MSWin32
+       - Store user locks safely
 
 1.09 Mon Apr  9 16:49:30 EDT 2007
        - Modify stress test to not hang under MSWin32

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index aaae9ba..07df9e8 100644 (file)
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.09_01';
+our $VERSION = '1.09_02';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 6f7aabc..b8c057a 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -128,6 +128,9 @@
 
 #ifdef USE_ITHREADS
 
+/* Magic signature(s) for mg_private to make PERL_MAGIC_ext magic safer */
+#define UL_MAGIC_SIG 0x554C  /* UL = user lock */
+
 /*
  * The shared things need an intepreter to live in ...
  */
@@ -338,7 +341,16 @@ S_get_userlock(pTHX_ SV* ssv, bool create)
     /* XXX Redesign the storage of user locks so we don't need a global
      * lock to access them ???? DAPM */
     ENTER_LOCK;
-    mg = mg_find(ssv, PERL_MAGIC_ext);
+
+    /* Version of mg_find that also checks the private signature */
+    for (mg = SvMAGIC(ssv); mg; mg = mg->mg_moremagic) {
+        if ((mg->mg_type == PERL_MAGIC_ext) &&
+            (mg->mg_private == UL_MAGIC_SIG))
+        {
+            break;
+        }
+    }
+
     if (mg) {
         ul = (user_lock*)(mg->mg_ptr);
     } else if (create) {
@@ -347,8 +359,9 @@ S_get_userlock(pTHX_ SV* ssv, bool create)
         ul = (user_lock *) PerlMemShared_malloc(sizeof(user_lock));
         Zero(ul, 1, user_lock);
         /* Attach to shared SV using ext magic */
-        sv_magicext(ssv, NULL, PERL_MAGIC_ext, &sharedsv_userlock_vtbl,
-               (char *)ul, 0);
+        mg = sv_magicext(ssv, NULL, PERL_MAGIC_ext, &sharedsv_userlock_vtbl,
+                            (char *)ul, 0);
+        mg->mg_private = UL_MAGIC_SIG;  /* Set private signature */
         recursive_lock_init(aTHX_ &ul->lock);
         COND_INIT(&ul->user_cond);
         CALLER_CONTEXT;