Return-Path: Delivered-To: apmail-perl-modperl-cvs-archive@www.apache.org Received: (qmail 73976 invoked from network); 9 Dec 2004 01:04:43 -0000 Received: from hermes.apache.org (HELO mail.apache.org) (209.237.227.199) by minotaur-2.apache.org with SMTP; 9 Dec 2004 01:04:43 -0000 Received: (qmail 13525 invoked by uid 500); 9 Dec 2004 01:04:42 -0000 Delivered-To: apmail-perl-modperl-cvs-archive@perl.apache.org Received: (qmail 13497 invoked by uid 500); 9 Dec 2004 01:04:42 -0000 Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Reply-To: dev@perl.apache.org Delivered-To: mailing list modperl-cvs@perl.apache.org Received: (qmail 13483 invoked by uid 99); 9 Dec 2004 01:04:42 -0000 X-ASF-Spam-Status: No, hits=-10.0 required=10.0 tests=ALL_TRUSTED,NO_REAL_NAME X-Spam-Check-By: apache.org Date: 9 Dec 2004 01:04:40 -0000 Message-ID: <20041209010440.73938.qmail@minotaur.apache.org> From: stas@apache.org To: modperl-cvs@perl.apache.org Subject: svn commit: r111330 - in perl/modperl/trunk: . src/modules/perl t/conf t/response/TestAPI xs/Apache/ServerUtil xs/maps xs/tables/current/ModPerl MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Virus-Checked: Checked X-Spam-Rating: minotaur-2.apache.org 1.6.2 0/1000/N Author: stas Date: Wed Dec 8 17:04:38 2004 New Revision: 111330 URL: http://svn.apache.org/viewcvs?view=rev&rev=111330 Log: a new function Apache::ServerUtil::server_shutdown_register_cleanup to register cleanups to be run at server shutdown. Modified: perl/modperl/trunk/Changes perl/modperl/trunk/src/modules/perl/mod_perl.c perl/modperl/trunk/src/modules/perl/mod_perl.h perl/modperl/trunk/t/conf/modperl_extra.pl perl/modperl/trunk/t/response/TestAPI/server_util.pm perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h perl/modperl/trunk/xs/maps/modperl_functions.map perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm Modified: perl/modperl/trunk/Changes Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=111330&p1=perl/modperl/trunk/Changes&r1=111329&p2=perl/modperl/trunk/Changes&r2=111330 ============================================================================== --- perl/modperl/trunk/Changes (original) +++ perl/modperl/trunk/Changes Wed Dec 8 17:04:38 2004 @@ -12,6 +12,9 @@ =item 1.99_18-dev +a new function Apache::ServerUtil::server_shutdown_register_cleanup to +register cleanups to be run at server shutdown. [Stas] + $bb->cleanup is no more segfaulting (was segfaulting due to a broken prototype in APR, and consequently invalid XS glue code) [Randy Kobes, Stas] @@ -39,8 +42,8 @@ Apache::SizeLimit ported [Perrin Harkins ] create a new subpool modperl_server_user_pool (from -modperl_server_pool), which is handed to users via -Apache::ServerUtil::base_server_pool(). This ensures that +modperl_server_pool), which is used internally by +Apache::ServerUtil::server_restart_register. This ensures that user-registered cleanups are run *before* perl's internals cleanups are run. (previously there was a problem with non-threaded perls which were segfaulting on user cleanups, since perl was already gone by that @@ -58,9 +61,6 @@ restarting/etc. Based on this feature implement $Apache::Server::Starting and $Apache::Server::ReStarting in Apache::compat [Stas] - -provide perl glue for the mod_perl's base_server_pool -via Apache::ServerUtil::base_server_pool() [Geoff, Stas] Apache::Resource ported to mp2 [Stas] Modified: perl/modperl/trunk/src/modules/perl/mod_perl.c Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/mod_perl.c?view=diff&rev=111330&p1=perl/modperl/trunk/src/modules/perl/mod_perl.c&r1=111329&p2=perl/modperl/trunk/src/modules/perl/mod_perl.c&r2=111330 ============================================================================== --- perl/modperl/trunk/src/modules/perl/mod_perl.c (original) +++ perl/modperl/trunk/src/modules/perl/mod_perl.c Wed Dec 8 17:04:38 2004 @@ -42,6 +42,15 @@ return MP_threaded_mpm; } +/* sometimes non-threaded mpm also needs to know whether it's still + * starting up or after post_config) */ +static int MP_post_post_config_phase = 0; + +int modperl_post_post_config_phase(void) +{ + return MP_post_post_config_phase; +} + #ifndef USE_ITHREADS static apr_status_t modperl_shutdown(void *data) { @@ -551,6 +560,7 @@ { MP_init_status = 0; MP_threads_started = 0; + MP_post_post_config_phase = 0; MP_TRACE_i(MP_FUNC, "mod_perl sys term\n"); @@ -680,6 +690,8 @@ if (modperl_threaded_mpm()) { MP_threads_started = 1; } + + MP_post_post_config_phase = 1; return OK; } Modified: perl/modperl/trunk/src/modules/perl/mod_perl.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/mod_perl.h?view=diff&rev=111330&p1=perl/modperl/trunk/src/modules/perl/mod_perl.h&r1=111329&p2=perl/modperl/trunk/src/modules/perl/mod_perl.h&r2=111330 ============================================================================== --- perl/modperl/trunk/src/modules/perl/mod_perl.h (original) +++ perl/modperl/trunk/src/modules/perl/mod_perl.h Wed Dec 8 17:04:38 2004 @@ -108,6 +108,12 @@ what); \ } +#define MP_CROAK_IF_POST_POST_CONFIG_PHASE(what) \ + if (modperl_post_post_config_phase()) { \ + Perl_croak(aTHX_ "Can't run '%s' after server startup", \ + what); \ + } + int modperl_init_vhost(server_rec *s, apr_pool_t *p, server_rec *base_server); void modperl_init(server_rec *s, apr_pool_t *p); Modified: perl/modperl/trunk/t/conf/modperl_extra.pl Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/conf/modperl_extra.pl?view=diff&rev=111330&p1=perl/modperl/trunk/t/conf/modperl_extra.pl&r1=111329&p2=perl/modperl/trunk/t/conf/modperl_extra.pl&r2=111330 ============================================================================== --- perl/modperl/trunk/t/conf/modperl_extra.pl (original) +++ perl/modperl/trunk/t/conf/modperl_extra.pl Wed Dec 8 17:04:38 2004 @@ -52,7 +52,7 @@ test_perl_ithreads(); -test_base_server_pool(); +test_server_shutdown_register_cleanup(); @@ -200,24 +200,21 @@ } } -sub test_base_server_pool { +sub test_server_shutdown_register_cleanup { # we can't really test the functionality since it happens at # server shutdown, when the test suite has finished its run # so just check that we can register the cleanup and that it # doesn't segfault - my $base_server_pool = Apache::ServerUtil::base_server_pool(); - $base_server_pool->cleanup_register(sub { Apache::OK }); + Apache::ServerUtil::server_shutdown_register_cleanup(sub { Apache::OK }); + # replace the sub with the following to get some visual debug # should log cnt:1 on -start, oncand cnt: 2 -stop followed by cnt: 1) - #$base_server_pool->cleanup_register( sub { + #Apache::ServerUtil::server_shutdown_register( sub { # my $cnt = Apache::ServerUtil::restart_count(); # open my $fh, ">>/tmp/out" or die "$!"; # print $fh "cnt: $cnt\n"; # close $fh; #}); - # - # also remember that cleanup_register() called on this pool will - # work only when registered at the server startup } Modified: perl/modperl/trunk/t/response/TestAPI/server_util.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/server_util.pm?view=diff&rev=111330&p1=perl/modperl/trunk/t/response/TestAPI/server_util.pm&r1=111329&p2=perl/modperl/trunk/t/response/TestAPI/server_util.pm&r2=111330 ============================================================================== --- perl/modperl/trunk/t/response/TestAPI/server_util.pm (original) +++ perl/modperl/trunk/t/response/TestAPI/server_util.pm Wed Dec 8 17:04:38 2004 @@ -29,7 +29,7 @@ sub handler { my $r = shift; - plan $r, tests => 18; + plan $r, tests => 17; { my $s = $r->server; @@ -48,13 +48,12 @@ server_root_relative_tests($r); - my $base_server_pool = Apache::ServerUtil::base_server_pool(); - ok $base_server_pool->isa('APR::Pool'); - - # this will never run since it's not registered in the parent - # process - $base_server_pool->cleanup_register(sub { Apache::OK }); - ok 1; + eval { Apache::ServerUtil::server_shutdown_register_cleanup( + sub { Apache::OK }); + }; + my $sub = "server_shutdown_register_cleanup"; + ok t_cmp $@, qr/Can't run '$sub' after server startup/, + "can't register server_shutdown cleanup after server startup"; # on start we get 1, and immediate restart gives 2 ok t_cmp Apache::ServerUtil::restart_count, 2, "restart count"; Modified: perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h?view=diff&rev=111330&p1=perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h&r1=111329&p2=perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h&r2=111330 ============================================================================== --- perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h (original) +++ perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h Wed Dec 8 17:04:38 2004 @@ -15,13 +15,94 @@ #define mpxs_Apache__ServerUtil_restart_count modperl_restart_count -#define mpxs_Apache__ServerUtil_base_server_pool modperl_server_user_pool - #define mpxs_Apache__ServerRec_method_register(s, methname) \ ap_method_register(s->process->pconf, methname); #define mpxs_Apache__ServerRec_add_version_component(s, component) \ ap_add_version_component(s->process->pconf, component); + +/* XXX: the mpxs_cleanup_t and mpxs_cleanup_run are almost dups with + * code in APR__Pool.h (minus interpr member which is not used + * here. They should be moved to modperl_common_util - the problem is + * modperl_interp_t *, which can't live in modperl_common_* since it + * creates a dependency on mod_perl. A possible solution is to use + * void * for that slot and cast it to modperl_interp_t * when used + */ + +typedef struct { + SV *cv; + SV *arg; + apr_pool_t *p; + PerlInterpreter *perl; +} mpxs_cleanup2_t; + +/** + * callback wrapper for Perl cleanup subroutines + * @param data internal storage + */ +static apr_status_t mpxs_cleanup_run(void *data) +{ + int count; + mpxs_cleanup2_t *cdata = (mpxs_cleanup2_t *)data; + dTHXa(cdata->perl); + dSP; + + ENTER;SAVETMPS; + PUSHMARK(SP); + if (cdata->arg) { + XPUSHs(cdata->arg); + } + PUTBACK; + + count = call_sv(cdata->cv, G_SCALAR|G_EVAL); + + SPAGAIN; + + if (count == 1) { + (void)POPs; /* the return value is ignored */ + } + + PUTBACK; + FREETMPS;LEAVE; + + SvREFCNT_dec(cdata->cv); + if (cdata->arg) { + SvREFCNT_dec(cdata->arg); + } + + if (SvTRUE(ERRSV)) { + Perl_croak(aTHX_ SvPV_nolen(ERRSV)); + } + + /* the return value is ignored by apr_pool_destroy anyway */ + return APR_SUCCESS; +} + +/* this cleanups registered by this function are run only by the + * parent interpreter */ +static MP_INLINE +void mpxs_Apache__ServerUtil_server_shutdown_register_cleanup(pTHX_ SV *cv, + SV *arg) +{ + mpxs_cleanup2_t *data; + apr_pool_t *p; + + MP_CROAK_IF_POST_POST_CONFIG_PHASE("server_shutdown_register_cleanup"); + + p = modperl_server_user_pool(); + /* must use modperl_server_user_pool here to make sure that it's run + * before parent perl is destroyed */ + data = (mpxs_cleanup2_t *)apr_pcalloc(p, sizeof(*data)); + data->cv = SvREFCNT_inc(cv); + data->arg = arg ? SvREFCNT_inc(arg) : Nullsv; + data->p = p; +#ifdef USE_ITHREADS + data->perl = aTHX; +#endif /* USE_ITHREADS */ + + apr_pool_cleanup_register(p, data, mpxs_cleanup_run, + apr_pool_cleanup_null); +} static MP_INLINE int mpxs_Apache__ServerRec_push_handlers(pTHX_ server_rec *s, Modified: perl/modperl/trunk/xs/maps/modperl_functions.map Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/maps/modperl_functions.map?view=diff&rev=111330&p1=perl/modperl/trunk/xs/maps/modperl_functions.map&r1=111329&p2=perl/modperl/trunk/xs/maps/modperl_functions.map&r2=111330 ============================================================================== --- perl/modperl/trunk/xs/maps/modperl_functions.map (original) +++ perl/modperl/trunk/xs/maps/modperl_functions.map Wed Dec 8 17:04:38 2004 @@ -82,7 +82,7 @@ MODULE=Apache::ServerUtil PACKAGE=Apache::ServerUtil mpxs_Apache__ServerUtil_server_root_relative | | p, fname="" - apr_pool_t:DEFINE_base_server_pool + mpxs_Apache__ServerUtil_server_shutdown_register_cleanup | | cv, arg=Nullsv int:DEFINE_restart_count PACKAGE=Apache Modified: perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm?view=diff&rev=111330&p1=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r1=111329&p2=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r2=111330 ============================================================================== --- perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm (original) +++ perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm Wed Dec 8 17:04:38 2004 @@ -2,7 +2,7 @@ # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # ! WARNING: generated by ModPerl::ParseSource/0.01 -# ! Tue Dec 7 13:02:32 2004 +# ! Wed Dec 8 19:43:35 2004 # ! do NOT edit, any changes will be lost ! # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -7127,6 +7127,24 @@ { 'type' => 'const char *', 'name' => 'fname' + } + ] + }, + { + 'return_type' => 'void', + 'name' => 'mpxs_Apache__ServerUtil_server_shutdown_register_cleanup', + 'args' => [ + { + 'type' => 'PerlInterpreter *', + 'name' => 'my_perl' + }, + { + 'type' => 'SV *', + 'name' => 'cv' + }, + { + 'type' => 'SV *', + 'name' => 'arg' } ] },