You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by "Philippe M. Chiasson" <go...@cpan.org> on 2001/12/03 10:59:53 UTC

[patch] $r->document_root & thread mutex locking

Added per-server configuration mutex locking, when changing things
like document_root.

I had to pick between Perl mutex and APR mutex. Since the tipool
stuff already uses one Perl mutex, I decided to stay consistent.

Works fine for me.

/home/gozer/sources/mod_perl2/deps/perl-13432/bin/perl build/cvsdiff 
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_config.c,v
retrieving revision 1.51
diff -u -I'$Id' -I'$Revision' -r1.51 modperl_config.c
--- src/modules/perl/modperl_config.c	20 Nov 2001 02:39:02 -0000	1.51
+++ src/modules/perl/modperl_config.c	3 Dec 2001 09:50:32 -0000
@@ -115,6 +115,8 @@
     scfg->SetEnv = apr_table_make(p, 2);
     
     modperl_config_srv_argv_push((char *)ap_server_argv0);
+    
+    MP_MUTEX_INIT(scfg);
 
     MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)scfg);
 

Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.11
diff -u -I'$Id' -I'$Revision' -r1.11 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h	13 Nov 2001 17:42:49 -0000	1.11
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h	3 Dec 2001 09:50:32 -0000
@@ -214,3 +214,21 @@
 
     return dcfg->location;
 }
+
+static MP_INLINE
+const char *mpxs_Apache__RequestRec_document_root(request_rec *r, 
+                                                  char *document_root)
+{
+    MP_dSCFG(r->server);
+    core_server_config *sconf = 
+            ap_get_module_config(r->server->module_config,              
+                                 &core_module);
+
+    if (document_root) {
+        MP_MUTEX_LOCK(scfg);
+        sconf->ap_document_root = document_root;
+        MP_MUTEX_UNLOCK(scfg);
+    }
+    
+    return sconf->ap_document_root;
+}

Index: src/modules/perl/modperl_types.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_types.h,v
retrieving revision 1.54
diff -u -I'$Id' -I'$Revision' -r1.54 modperl_types.h
--- src/modules/perl/modperl_types.h	19 Nov 2001 00:07:28 -0000	1.54
+++ src/modules/perl/modperl_types.h	3 Dec 2001 09:50:32 -0000
@@ -36,6 +36,7 @@
 typedef struct modperl_interp_t modperl_interp_t;
 typedef struct modperl_interp_pool_t modperl_interp_pool_t;
 typedef struct modperl_tipool_t modperl_tipool_t;
+typedef perl_mutex modperl_mutex_t;
 
 struct modperl_interp_t {
     modperl_interp_pool_t *mip;
@@ -125,6 +126,7 @@
     modperl_interp_pool_t *mip;
     modperl_tipool_config_t *interp_pool_cfg;
     modperl_interp_scope_e interp_scope;
+    modperl_mutex_t mutex;
 #else
     PerlInterpreter *perl;
 #endif

Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_config.h,v
retrieving revision 1.30
diff -u -I'$Id' -I'$Revision' -r1.30 modperl_config.h
--- src/modules/perl/modperl_config.h	5 Nov 2001 05:19:01 -0000	1.30
+++ src/modules/perl/modperl_config.h	3 Dec 2001 09:50:32 -0000
@@ -89,6 +89,16 @@
 #   define MP_dSCFG_dTHX dTHXa(scfg->perl)
 #endif
 
+#ifdef USE_ITHREADS
+#   define MP_MUTEX_LOCK(m) MUTEX_LOCK(&m->mutex)
+#   define MP_MUTEX_UNLOCK(m) MUTEX_UNLOCK(&m->mutex);
+#   define MP_MUTEX_INIT(m) MUTEX_INIT(&m->mutex)
+#else
+#   define MP_MUTEX_LOCK(m) NOOP
+#   define MP_MUTEX_UNLOCK(m) MUTEX_UNLOCK(m) NOOP
+#   define MP_MUTEX_INIT(m) NOOP
+#endif
+
 /* hopefully this macro will not need to be used often */
 #ifdef USE_ITHREADS
 #   define MP_dTHX \

Index: t/response/TestAPI/rutil.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPI/rutil.pm,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 rutil.pm
--- t/response/TestAPI/rutil.pm	22 May 2001 20:57:44 -0000	1.2
+++ t/response/TestAPI/rutil.pm	3 Dec 2001 09:50:32 -0000
@@ -27,11 +27,19 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 17;
+    plan $r, tests => 19;
 
     ok $r->default_type;
 
     ok $r->document_root;
+    
+    my $document_root = $r->document_root;
+    
+    ok $r->document_root("/foo/bar") && 
+        ( $r->document_root eq "/foo/bar" );
+        
+    ok $r->document_root($document_root) &&
+        ( $r->document_root eq $document_root );
 
     ok $r->get_server_name;
 

Index: docs/src/api/mod_perl-2.0/Apache/RequestRec.pod
===================================================================
RCS file: /home/anoncvs/mod_perl-docs-cvs/src/api/mod_perl-2.0/Apache/RequestRec.pod,v
retrieving revision 1.2
diff -u -I'$Id' -I'$Revision' -r1.2 RequestRec.pod
--- docs/src/api/mod_perl-2.0/Apache/RequestRec.pod	10 Oct 2001 05:06:36 -0000	1.2
+++ docs/src/api/mod_perl-2.0/Apache/RequestRec.pod	3 Dec 2001 09:50:32 -0000
@@ -8,6 +8,7 @@
   sub handler{
       my $r = shift;
       
+      my $dir = $r->document_root;
       my $s = $r->server;
       my $dir_config = $r->dir_config;
       ...
@@ -23,6 +24,21 @@
 function's synopsis.
 
 =over
+
+=item * document_root()
+
+  $dir = $r->document_root;
+  $r->document_root("/new/document/root");
+  
+Returns the current value of the per server  configuration directive 
+B<DocumentRoot>. To quote the Apache server documentation, "Unless matched
+by a directive like Alias, the server appends the path from the 
+requested URL to the document root to make the path to the document." 
+This same value is passed to CGI scripts in the `DOCUMENT_ROOT' 
+environment variable.
+
+If passed an argument, sets the B<DocumentRoot> of the current server 
+or virtual host.
 
 =item * server()
 

Index: todo/api.txt
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
retrieving revision 1.16
diff -u -I'$Id' -I'$Revision' -r1.16 api.txt
--- todo/api.txt	13 Nov 2001 17:42:49 -0000	1.16
+++ todo/api.txt	3 Dec 2001 09:50:33 -0000
@@ -43,10 +43,6 @@
 exists as Apache::exists_config_define, which should stay,
 Apache::compat could implement a wrapper.
 
-$r->document_root:
-cannot currently be modified.  requires locking since it is part of
-the per-server config structure which is shared between threads
-
 $r->send_fd:
 need to figure out howto map PerlIO <-> apr_file_t
 at the moment $r->send_fd is implement in Apache::compat, functions,

Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apache_functions.map,v
retrieving revision 1.39
diff -u -I'$Id' -I'$Revision' -r1.39 apache_functions.map
--- xs/maps/apache_functions.map	19 Nov 2001 23:46:48 -0000	1.39
+++ xs/maps/apache_functions.map	3 Dec 2001 09:50:33 -0000
@@ -48,7 +48,7 @@
 >ap_process_request_internal
 
 #MODULE=Apache::RequestConfig
- ap_document_root
+ mpxs_Apache__RequestRec_document_root | | r, document_root=NULL
  ap_get_limit_req_body
 ?ap_get_limit_xml_body
 >ap_core_translate


-- 
Philippe M. Chiasson  <go...@cpan.org>
  Extropia's Resident System Guru
     http://www.eXtropia.com/


perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl Hacker!\n$/&&print||$$++&&redo}'

Re: [patch] $r->document_root & thread mutex locking

Posted by Doug MacEachern <do...@covalent.net>.
On Mon, 3 Dec 2001, Philippe M. Chiasson wrote:

> Added per-server configuration mutex locking, when changing things
> like document_root.
> 
> I had to pick between Perl mutex and APR mutex. Since the tipool
> stuff already uses one Perl mutex, I decided to stay consistent.

there have been changes to the apr locking api since, might be worth
looking to see if apr is lighter weight than the perl api.

in any case, we need to think about this some more.  there is a race
condition in you patch.  only locking when writing to the value means one
reading could get trounced.  we don't want the overhead of locking all the
time for reads, since most apps probably won't be updating these fields.
and without a doubt, we don't want to do any locking if the mpm is
prefork.




---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org