Mailing List Archive: Re: svn commit: r1538005 - in /perl/modperl/branches/httpd24threading: src/modules/perl/ xs/tables/current24/ModPerl/

Go Steve go!

On Fri, Nov 1, 2013 at 10:55 AM, <stevehay@apache.org> wrote:

> Author: stevehay
> Date: Fri Nov 1 17:55:19 2013
> New Revision: 1538005
>
> URL: http://svn.apache.org/r1538005
> Log:
> Corrections to mistakes that I made in the course of merging everything
> from threading that wasn't already in httpd24 into this httpd24threading
> branch. I hope I have it correct now, but it wasn't an easy merge and there
> may still be mistakes. These all came to light in the course of building
> the new branch. More may come to light when I actually get it running.
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c
>
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.h
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_env.c
>
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
>
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
>
> perl/modperl/branches/httpd24threading/xs/tables/current24/ModPerl/FunctionTable.pm
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> --- perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c
> (original)
> +++ perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c Fri
> Nov 1 17:55:19 2013
> @@ -394,7 +394,7 @@ int modperl_init_vhost(server_rec *s, ap
> }
>
> PERL_SET_CONTEXT(perl);
> - MP_THX_INTERP_SET(perl, base_scfg->mip->parent);
> + modperl_thx_interp_set(perl, base_scfg->mip->parent);
>
> #endif /* USE_ITHREADS */
>
> @@ -470,7 +470,7 @@ void modperl_init(server_rec *base_serve
> /* after other parent perls were started in vhosts, make sure that
> * the context is set to the base_perl */
> PERL_SET_CONTEXT(base_perl);
> - MP_THX_INTERP_SET(base_perl, base_scfg->mip->parent);
> + modperl_thx_interp_set(base_perl, base_scfg->mip->parent);
> #endif
>
> }
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.h
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.h?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> ---
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.h
> (original)
> +++
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.h
> Fri Nov 1 17:55:19 2013
> @@ -62,9 +62,9 @@ void modperl_set_perl_module_config(ap_c
>
> #if defined(MP_IN_XS) && defined(WIN32)
> # define modperl_get_module_config(v) \
> - modperl_get_perl_module_config(v)
> + modperl_get_perl_module_config((v))
>
> -# define modperl_set_module_config((v), c) \
> +# define modperl_set_module_config(v, c) \
> modperl_set_perl_module_config((v), (c))
> #else
> # define modperl_get_module_config(v) \
> @@ -95,7 +95,7 @@ void modperl_set_perl_module_config(ap_c
>
> #define modperl_config_con_get(c) \
> (c ? (modperl_config_con_t *) \
> - modperl_get_module_config((C)->conn_config) : NULL)
> + modperl_get_module_config((c)->conn_config) : NULL)
>
> #define MP_dCCFG \
> modperl_config_con_t *ccfg = modperl_config_con_get(c)
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_env.c
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_env.c?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_env.c
> (original)
> +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_env.c
> Fri Nov 1 17:55:19 2013
> @@ -413,7 +413,6 @@ void modperl_env_request_tie(pTHX_ reque
> #ifdef MP_PERL_HV_GMAGICAL_AWARE
> MP_TRACE_e(MP_FUNC, "[0x%lx] tie %%ENV, $r\t (%s%s)",
> modperl_interp_address(aTHX),
> - modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
> modperl_server_desc(r->server, r->pool), r->uri);
> SvGMAGICAL_on((SV*)ENVHV);
> #endif
> @@ -426,7 +425,6 @@ void modperl_env_request_untie(pTHX_ req
> #ifdef MP_PERL_HV_GMAGICAL_AWARE
> MP_TRACE_e(MP_FUNC, "[0x%lx] untie %%ENV; # from r\t (%s%s)",
> modperl_interp_address(aTHX),
> - modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
> modperl_server_desc(r->server, r->pool), r->uri);
> SvGMAGICAL_off((SV*)ENVHV);
> #endif
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> ---
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
> (original)
> +++
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
> Fri Nov 1 17:55:19 2013
> @@ -383,7 +383,7 @@ modperl_interp_t *modperl_interp_pool_se
> /* set context (THX) for this thread */
> PERL_SET_CONTEXT(interp->perl);
> /* let the perl interpreter point back to its interp */
> - MP_THX_INTERP_SET(interp->perl, interp);
> + modperl_thx_interp_set(interp->perl, interp);
>
> return interp;
> }
> @@ -422,7 +422,7 @@ modperl_interp_t *modperl_interp_select(
> /* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip
> this */
> PERL_SET_CONTEXT(interp->perl);
> /* let the perl interpreter point back to its interp */
> - MP_THX_INTERP_SET(interp->perl, interp);
> + modperl_thx_interp_set(interp->perl, interp);
>
> MP_TRACE_i(MP_FUNC,
> "using parent 0x%pp (perl=0x%pp) for %s:%d refcnt set
> to %d",
> @@ -442,7 +442,7 @@ modperl_interp_t *modperl_interp_select(
> (unsigned long)ccfg->interp, ccfg->interp->refcnt);
> /* set context (THX) for this thread */
> PERL_SET_CONTEXT(ccfg->interp->perl);
> - /* MP_THX_INTERP_SET is not called here because the interp
> + /* modperl_thx_interp_set() is not called here because the interp
> * already belongs to the perl interpreter
> */
> return ccfg->interp;
> @@ -458,7 +458,7 @@ modperl_interp_t *modperl_interp_select(
> /* set context (THX) for this thread */
> PERL_SET_CONTEXT(interp->perl);
> /* let the perl interpreter point back to its interp */
> - MP_THX_INTERP_SET(interp->perl, interp);
> + modperl_thx_interp_set(interp->perl, interp);
>
> /* make sure ccfg is initialized */
> modperl_config_con_init(c, ccfg);
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> ---
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
> (original)
> +++
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
> Fri Nov 1 17:55:19 2013
> @@ -356,13 +356,12 @@ static const char *modperl_module_cmd_ta
> modperl_module_info_t *minfo = MP_MODULE_INFO(info->modp);
> modperl_module_cfg_t *srv_cfg;
> int modules_alias = 0;
> -
> - MP_dINTERP_POOLa(p, s);
> -
> int count;
> - PTR_TBL_t *table = modperl_module_config_table_get(aTHX_ TRUE);
> + PTR_TBL_t *table;
> SV *obj = (SV *)NULL;
> - dSP;
> + MP_dINTERP_POOLa(p, s);
> +
> + table = modperl_module_config_table_get(aTHX_ TRUE);
>
> if (s->is_virtual) {
> MP_dSCFG(s);
> @@ -438,32 +437,35 @@ static const char *modperl_module_cmd_ta
> }
> }
>
> - ENTER;SAVETMPS;
> - PUSHMARK(SP);
> - EXTEND(SP, 2);
> + {
> + dSP;
> + ENTER;SAVETMPS;
> + PUSHMARK(SP);
> + EXTEND(SP, 2);
>
> - PUSHs(obj);
> - PUSHs(modperl_bless_cmd_parms(parms));
> + PUSHs(obj);
> + PUSHs(modperl_bless_cmd_parms(parms));
>
> - if (cmd->args_how != NO_ARGS) {
> - PUSH_STR_ARG(one);
> - PUSH_STR_ARG(two);
> - PUSH_STR_ARG(three);
> - }
> + if (cmd->args_how != NO_ARGS) {
> + PUSH_STR_ARG(one);
> + PUSH_STR_ARG(two);
> + PUSH_STR_ARG(three);
> + }
>
> - PUTBACK;
> - count = call_method(info->func_name, G_EVAL|G_SCALAR);
> - SPAGAIN;
> + PUTBACK;
> + count = call_method(info->func_name, G_EVAL|G_SCALAR);
> + SPAGAIN;
>
> - if (count == 1) {
> - SV *sv = POPs;
> - if (SvPOK(sv) && strEQ(SvPVX(sv), DECLINE_CMD)) {
> - retval = DECLINE_CMD;
> + if (count == 1) {
> + SV *sv = POPs;
> + if (SvPOK(sv) && strEQ(SvPVX(sv), DECLINE_CMD)) {
> + retval = DECLINE_CMD;
> + }
> }
> - }
>
> - PUTBACK;
> - FREETMPS;LEAVE;
> + PUTBACK;
> + FREETMPS;LEAVE;
> + }
>
> if (SvTRUE(ERRSV)) {
> retval = SvPVX(ERRSV);
> @@ -777,11 +779,12 @@ const char *modperl_module_add(apr_pool_
> const char *name, SV *mod_cmds)
> {
> MP_dSCFG(s);
> - MP_dINTERPa(NULL, NULL, s);
> const char *errmsg;
> - module *modp = (module *)apr_pcalloc(p, sizeof(*modp));
> - modperl_module_info_t *minfo =
> - (modperl_module_info_t *)apr_pcalloc(p, sizeof(*minfo));
> + module *modp;
> + modperl_module_info_t *minfo;
> + MP_dINTERPa(NULL, NULL, s);
> + modp = (module *)apr_pcalloc(p, sizeof(*modp));
> + minfo = (modperl_module_info_t *)apr_pcalloc(p, sizeof(*minfo));
>
> /* STANDARD20_MODULE_STUFF */
> modp->version = MODULE_MAGIC_NUMBER_MAJOR;
>
> Modified:
> perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
> (original)
> +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
> Fri Nov 1 17:55:19 2013
> @@ -829,36 +829,18 @@ int modperl_restart_count(void)
> return data ? *(int *)data : 0;
> }
>
> -#ifdef USE_ITHREADS
> -typedef struct {
> - HV **pnotes;
> - PerlInterpreter *perl;
> -} modperl_cleanup_pnotes_data_t;
> -#endif
> -
> -/* XXX: This function was highly conflicted in threading vs. httpd24,
> - * so this manually merged version may not be correct.
> - */
> static MP_INLINE
> apr_status_t modperl_cleanup_pnotes(void *data) {
> - HV **pnotes = data;
> + modperl_pnotes_t *pnotes = data;
>
> - if (*pnotes) {
> -#ifdef USE_ITHREADS
> - modperl_cleanup_pnotes_data_t *cleanup_data = data;
> - dTHXa(cleanup_data->perl);
> - MP_ASSERT_CONTEXT(aTHX);
> - pnotes = cleanup_data->pnotes;
> -#else
> - pnotes = data;
> -#endif
> - SvREFCNT_dec(*pnotes);
> - *pnotes = (HV *)NULL;
> - }
> + dTHXa(pnotes->interp->perl);
> + MP_ASSERT_CONTEXT(aTHX);
>
> -#ifdef USE_ITHREADS
> - MP_INTERP_PUTBACK(cleanup_data, aTHX);
> -#endif
> + SvREFCNT_dec(pnotes->pnotes);
> + pnotes->pnotes = NULL;
> + pnotes->pool = NULL;
> +
> + MP_INTERP_PUTBACK(pnotes->interp, aTHX);
> return APR_SUCCESS;
> }
>
> @@ -878,7 +860,7 @@ SV *modperl_pnotes(pTHX_ modperl_pnotes_
> if (!pnotes->pnotes) {
> pnotes->pool = pool;
> #ifdef USE_ITHREADS
> - pnotes->interp = MP_THX_INTERP_GET(aTHX);
> + pnotes->interp = modperl_thx_interp_get(aTHX);
> pnotes->interp->refcnt++;
> MP_TRACE_i(MP_FUNC, "TO: (0x%lx)->refcnt incremented to %ld",
> pnotes->interp, pnotes->interp->refcnt);
> @@ -945,21 +927,23 @@ static authz_status perl_check_authoriza
> AV *args = Nullav;
> const char *key;
> auth_callback *ab;
> - MP_dTHX;
> - dSP;
> + MP_dINTERPa(r, NULL, NULL);
>
> if (global_authz_providers == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> key = apr_table_get(r->notes, AUTHZ_PROVIDER_NAME_NOTE);
> ab = apr_hash_get(global_authz_providers, key, APR_HASH_KEY_STRING);
> if (ab == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> if (ab->cb1 == NULL) {
> if (ab->cb1_handler == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -968,25 +952,31 @@ static authz_status perl_check_authoriza
> ret = modperl_callback(aTHX_ ab->cb1_handler, r->pool, r,
> r->server,
> args);
> SvREFCNT_dec((SV*)args);
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> - ENTER;
> - SAVETMPS;
> - PUSHMARK(SP);
> - XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec", r)));
> - XPUSHs(sv_2mortal(newSVpv(require_args, 0)));
> - PUTBACK;
> - count = call_sv(ab->cb1, G_SCALAR);
> - SPAGAIN;
> -
> - if (count == 1) {
> - ret = (authz_status) POPi;
> - }
> -
> - PUTBACK;
> - FREETMPS;
> - LEAVE;
> + {
> + dSP;
> + ENTER;
> + SAVETMPS;
> + PUSHMARK(SP);
> + XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec",
> r)));
> + XPUSHs(sv_2mortal(newSVpv(require_args, 0)));
> + PUTBACK;
> + count = call_sv(ab->cb1, G_SCALAR);
> + SPAGAIN;
> +
> + if (count == 1) {
> + ret = (authz_status) POPi;
> + }
> +
> + PUTBACK;
> + FREETMPS;
> + LEAVE;
> + }
> +
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -999,25 +989,21 @@ static const char *perl_parse_require_li
> int count;
> void *key;
> auth_callback *ab;
> - modperl_interp_t *interp;
> + MP_dINTERP_POOLa(cmd->server->process->pool, cmd->server);
>
> if (global_authz_providers == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> apr_pool_userdata_get(&key, AUTHZ_PROVIDER_NAME_NOTE, cmd->temp_pool);
> ab = apr_hash_get(global_authz_providers, (char *) key,
> APR_HASH_KEY_STRING);
> if (ab == NULL || ab->cb2 == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> -#ifdef USE_ITHREADS
> - interp = modperl_interp_pool_select(cmd->server->process->pool,
> cmd->server);
> - if (interp) {
> - dTHXa(interp->perl);
> -#else
> {
> -#endif
> dSP;
> ENTER;
> SAVETMPS;
> @@ -1042,6 +1028,8 @@ static const char *perl_parse_require_li
> FREETMPS;
> LEAVE;
> }
> +
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -1053,10 +1041,10 @@ static authn_status perl_check_password(
> AV *args = Nullav;
> const char *key;
> auth_callback *ab;
> - MP_dTHX;
> - dSP;
> + MP_dINTERPa(r, NULL, NULL);
>
> if (global_authn_providers == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -1064,11 +1052,13 @@ static authn_status perl_check_password(
> ab = apr_hash_get(global_authn_providers, key,
> APR_HASH_KEY_STRING);
> if (ab == NULL || ab->cb1) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> if (ab->cb1 == NULL) {
> if (ab->cb1_handler == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -1078,26 +1068,32 @@ static authn_status perl_check_password(
> ret = modperl_callback(aTHX_ ab->cb1_handler, r->pool, r,
> r->server,
> args);
> SvREFCNT_dec((SV*)args);
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> - ENTER;
> - SAVETMPS;
> - PUSHMARK(SP);
> - XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec", r)));
> - XPUSHs(sv_2mortal(newSVpv(user, 0)));
> - XPUSHs(sv_2mortal(newSVpv(password, 0)));
> - PUTBACK;
> - count = call_sv(ab->cb1, G_SCALAR);
> - SPAGAIN;
> -
> - if (count == 1) {
> - ret = (authn_status) POPi;
> - }
> -
> - PUTBACK;
> - FREETMPS;
> - LEAVE;
> + {
> + dSP;
> + ENTER;
> + SAVETMPS;
> + PUSHMARK(SP);
> + XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec",
> r)));
> + XPUSHs(sv_2mortal(newSVpv(user, 0)));
> + XPUSHs(sv_2mortal(newSVpv(password, 0)));
> + PUTBACK;
> + count = call_sv(ab->cb1, G_SCALAR);
> + SPAGAIN;
> +
> + if (count == 1) {
> + ret = (authn_status) POPi;
> + }
> +
> + PUTBACK;
> + FREETMPS;
> + LEAVE;
> + }
> +
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> @@ -1109,42 +1105,48 @@ static authn_status perl_get_realm_hash(
> SV *rh;
> const char *key;
> auth_callback *ab;
> - MP_dTHX;
> - dSP;
> + MP_dINTERPa(r, NULL, NULL);
>
> if (global_authn_providers == NULL) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> key = apr_table_get(r->notes, AUTHN_PROVIDER_NAME_NOTE);
> ab = apr_hash_get(global_authn_providers, key, APR_HASH_KEY_STRING);
> if (ab == NULL || ab->cb2) {
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
> rh = sv_2mortal(newSVpv("", 0));
> - ENTER;
> - SAVETMPS;
> - PUSHMARK(SP);
> - XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec", r)));
> - XPUSHs(sv_2mortal(newSVpv(user, 0)));
> - XPUSHs(sv_2mortal(newSVpv(realm, 0)));
> - XPUSHs(newRV_noinc(rh));
> - PUTBACK;
> - count = call_sv(ab->cb2, G_SCALAR);
> - SPAGAIN;
> -
> - if (count == 1) {
> - const char *tmp = SvPV_nolen(rh);
> - ret = (authn_status) POPi;
> - if (*tmp != '\0') {
> - *rethash = apr_pstrdup(r->pool, tmp);
> + {
> + dSP;
> + ENTER;
> + SAVETMPS;
> + PUSHMARK(SP);
> + XPUSHs(sv_2mortal(modperl_ptr2obj(aTHX_ "Apache2::RequestRec",
> r)));
> + XPUSHs(sv_2mortal(newSVpv(user, 0)));
> + XPUSHs(sv_2mortal(newSVpv(realm, 0)));
> + XPUSHs(newRV_noinc(rh));
> + PUTBACK;
> + count = call_sv(ab->cb2, G_SCALAR);
> + SPAGAIN;
> +
> + if (count == 1) {
> + const char *tmp = SvPV_nolen(rh);
> + ret = (authn_status) POPi;
> + if (*tmp != '\0') {
> + *rethash = apr_pstrdup(r->pool, tmp);
> + }
> }
> +
> + PUTBACK;
> + FREETMPS;
> + LEAVE;
> }
>
> - PUTBACK;
> - FREETMPS;
> - LEAVE;
> + MP_INTERP_PUTBACK(interp, aTHX);
> return ret;
> }
>
>
> Modified:
> perl/modperl/branches/httpd24threading/xs/tables/current24/ModPerl/FunctionTable.pm
> URL:
> http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/xs/tables/current24/ModPerl/FunctionTable.pm?rev=1538005&r1=1538004&r2=1538005&view=diff
>
> ==============================================================================
> ---
> perl/modperl/branches/httpd24threading/xs/tables/current24/ModPerl/FunctionTable.pm
> (original)
> +++
> perl/modperl/branches/httpd24threading/xs/tables/current24/ModPerl/FunctionTable.pm
> Fri Nov 1 17:55:19 2013
> @@ -4476,19 +4476,6 @@ $ModPerl::FunctionTable = [
> ]
> },
> {
> - 'return_type' => 'char *',
> - 'name' => 'modperl_pid_tid',
> - 'attr' => [
> - '__inline__'
> - ],
> - 'args' => [.
> - {
> - 'type' => 'apr_pool_t *',
> - 'name' => 'p'
> - }
> - ]
> - },
> - {
> 'return_type' => 'SV *',
> 'name' => 'modperl_pnotes',
> 'args' => [
>
>
>