diff options
| -rw-r--r-- | ext/threads/shared/Changes | 1 | ||||
| -rw-r--r-- | ext/threads/shared/shared.pm | 2 | ||||
| -rw-r--r-- | ext/threads/shared/shared.xs | 19 |
3 files changed, 18 insertions, 4 deletions
diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes index 6ff6f52b9d..ec20c8d48e 100644 --- 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 aaae9ba6ea..07df9e874f 100644 --- 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 6f7aabcc04..b8c057a0a2 100644 --- 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; |