diff options
author | Jerry D. Hedden <jdhedden@cpan.org> | 2007-04-23 09:21:11 -0400 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-04-25 16:17:01 +0000 |
commit | e21694ed6c3a879be835a8269350acf67b5736f9 (patch) | |
tree | b462749af2228842c56c2e9e6437ebbc04d29277 | |
parent | 3ec1fd4d6641a23e2a652f8e13bfc94b12dc68ab (diff) | |
download | perl-e21694ed6c3a879be835a8269350acf67b5736f9.tar.gz |
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
-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; |