Mercurial > hg > nginx
comparison src/http/modules/perl/ngx_http_perl_module.c @ 6820:eada22643e8b
Perl: added PERL_SET_INTERP().
For Perl compiled with threads, without PERL_SET_INTERP() the PL_curinterp
remains set to the first interpreter created (that is, one created at
original start). As a result after a reload Perl thinks that operations
are done withing a thread, and, most notably, denies to change environment.
For example, the following code properly works on original start,
but fails after a reload:
perl 'sub {
my $r = shift;
$r->send_http_header("text/plain");
$ENV{TZ} = "UTC";
$r->print("tz: " . $ENV{TZ} . " (localtime " . (localtime()) . ")\n");
$ENV{TZ} = "Europe/Moscow";
$r->print("tz: " . $ENV{TZ} . " (localtime " . (localtime()) . ")\n");
return OK;
}';
To fix this, PERL_SET_INTERP() added anywhere where PERL_SET_CONTEXT()
was previously used.
Note that PERL_SET_INTERP() doesn't seem to be documented anywhere.
Yet it is used in some other software, and also seems to be the only
solution possible.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Wed, 07 Dec 2016 19:03:19 +0300 |
parents | cb4a4e9bba8e |
children | 1c5e5e5b008d |
comparison
equal
deleted
inserted
replaced
6819:4395758d08e6 | 6820:eada22643e8b |
---|---|
205 | 205 |
206 { | 206 { |
207 | 207 |
208 dTHXa(pmcf->perl); | 208 dTHXa(pmcf->perl); |
209 PERL_SET_CONTEXT(pmcf->perl); | 209 PERL_SET_CONTEXT(pmcf->perl); |
210 PERL_SET_INTERP(pmcf->perl); | |
210 | 211 |
211 if (ctx->next == NULL) { | 212 if (ctx->next == NULL) { |
212 plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module); | 213 plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module); |
213 sub = plcf->sub; | 214 sub = plcf->sub; |
214 handler = &plcf->handler; | 215 handler = &plcf->handler; |
320 | 321 |
321 { | 322 { |
322 | 323 |
323 dTHXa(pmcf->perl); | 324 dTHXa(pmcf->perl); |
324 PERL_SET_CONTEXT(pmcf->perl); | 325 PERL_SET_CONTEXT(pmcf->perl); |
326 PERL_SET_INTERP(pmcf->perl); | |
325 | 327 |
326 rc = ngx_http_perl_call_handler(aTHX_ r, pmcf->nginx, pv->sub, NULL, | 328 rc = ngx_http_perl_call_handler(aTHX_ r, pmcf->nginx, pv->sub, NULL, |
327 &pv->handler, &value); | 329 &pv->handler, &value); |
328 | 330 |
329 } | 331 } |
385 | 387 |
386 { | 388 { |
387 | 389 |
388 dTHXa(pmcf->perl); | 390 dTHXa(pmcf->perl); |
389 PERL_SET_CONTEXT(pmcf->perl); | 391 PERL_SET_CONTEXT(pmcf->perl); |
392 PERL_SET_INTERP(pmcf->perl); | |
390 | 393 |
391 #if 0 | 394 #if 0 |
392 | 395 |
393 /* the code is disabled to force the precompiled perl code using only */ | 396 /* the code is disabled to force the precompiled perl code using only */ |
394 | 397 |
566 | 569 |
567 { | 570 { |
568 | 571 |
569 dTHXa(perl); | 572 dTHXa(perl); |
570 PERL_SET_CONTEXT(perl); | 573 PERL_SET_CONTEXT(perl); |
574 PERL_SET_INTERP(perl); | |
571 | 575 |
572 perl_construct(perl); | 576 perl_construct(perl); |
573 | 577 |
574 #ifdef PERL_EXIT_DESTRUCT_END | 578 #ifdef PERL_EXIT_DESTRUCT_END |
575 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; | 579 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
826 ngx_http_perl_cleanup_perl(void *data) | 830 ngx_http_perl_cleanup_perl(void *data) |
827 { | 831 { |
828 PerlInterpreter *perl = data; | 832 PerlInterpreter *perl = data; |
829 | 833 |
830 PERL_SET_CONTEXT(perl); | 834 PERL_SET_CONTEXT(perl); |
835 PERL_SET_INTERP(perl); | |
831 | 836 |
832 (void) perl_destruct(perl); | 837 (void) perl_destruct(perl); |
833 | 838 |
834 perl_free(perl); | 839 perl_free(perl); |
835 | 840 |
934 | 939 |
935 { | 940 { |
936 | 941 |
937 dTHXa(pmcf->perl); | 942 dTHXa(pmcf->perl); |
938 PERL_SET_CONTEXT(pmcf->perl); | 943 PERL_SET_CONTEXT(pmcf->perl); |
944 PERL_SET_INTERP(pmcf->perl); | |
939 | 945 |
940 ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub); | 946 ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub); |
941 | 947 |
942 if (plcf->sub == &PL_sv_undef) { | 948 if (plcf->sub == &PL_sv_undef) { |
943 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | 949 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, |
1005 | 1011 |
1006 { | 1012 { |
1007 | 1013 |
1008 dTHXa(pmcf->perl); | 1014 dTHXa(pmcf->perl); |
1009 PERL_SET_CONTEXT(pmcf->perl); | 1015 PERL_SET_CONTEXT(pmcf->perl); |
1016 PERL_SET_INTERP(pmcf->perl); | |
1010 | 1017 |
1011 ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub); | 1018 ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub); |
1012 | 1019 |
1013 if (pv->sub == &PL_sv_undef) { | 1020 if (pv->sub == &PL_sv_undef) { |
1014 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | 1021 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, |
1037 pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module); | 1044 pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module); |
1038 | 1045 |
1039 if (pmcf) { | 1046 if (pmcf) { |
1040 dTHXa(pmcf->perl); | 1047 dTHXa(pmcf->perl); |
1041 PERL_SET_CONTEXT(pmcf->perl); | 1048 PERL_SET_CONTEXT(pmcf->perl); |
1049 PERL_SET_INTERP(pmcf->perl); | |
1042 | 1050 |
1043 /* set worker's $$ */ | 1051 /* set worker's $$ */ |
1044 | 1052 |
1045 sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid); | 1053 sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid); |
1046 } | 1054 } |