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 <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
msg02058/pgp00000.pgp
Description: PGP signature
