Mercurial > hg > nginx-quic
annotate src/http/modules/perl/ngx_http_perl_module.c @ 8515:c860f0b7010c
Core: disabled cloning sockets when testing config (ticket #2188).
Since we anyway do not set SO_REUSEPORT when testing configuration
(see ecb5cd305b06), trying to open additional sockets does not make much
sense, as all these additional sockets are expected to result in EADDRINUSE
errors from bind(). On the other hand, there are reports that trying
to open these sockets takes significant time under load: total configuration
testing time greater than 15s was observed in ticket #2188, compared to less
than 1s without load.
With this change, no additional sockets are opened during testing
configuration.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Mon, 31 May 2021 16:36:37 +0300 |
parents | 5f642712e7ad |
children |
rev | line source |
---|---|
599 | 1 |
2 /* | |
3 * Copyright (C) Igor Sysoev | |
4412 | 4 * Copyright (C) Nginx, Inc. |
599 | 5 */ |
6 | |
7 | |
8 #include <ngx_config.h> | |
9 #include <ngx_core.h> | |
10 #include <ngx_http.h> | |
11 #include <ngx_http_perl_module.h> | |
12 | |
13 | |
14 typedef struct { | |
15 PerlInterpreter *perl; | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
16 HV *nginx; |
3175 | 17 ngx_array_t *modules; |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
18 ngx_array_t *requires; |
599 | 19 } ngx_http_perl_main_conf_t; |
20 | |
21 | |
22 typedef struct { | |
23 SV *sub; | |
24 ngx_str_t handler; | |
25 } ngx_http_perl_loc_conf_t; | |
26 | |
27 | |
28 typedef struct { | |
29 SV *sub; | |
30 ngx_str_t handler; | |
31 } ngx_http_perl_variable_t; | |
32 | |
33 | |
617 | 34 #if (NGX_HTTP_SSI) |
599 | 35 static ngx_int_t ngx_http_perl_ssi(ngx_http_request_t *r, |
36 ngx_http_ssi_ctx_t *ssi_ctx, ngx_str_t **params); | |
617 | 37 #endif |
38 | |
599 | 39 static char *ngx_http_perl_init_interpreter(ngx_conf_t *cf, |
40 ngx_http_perl_main_conf_t *pmcf); | |
1069 | 41 static PerlInterpreter *ngx_http_perl_create_interpreter(ngx_conf_t *cf, |
42 ngx_http_perl_main_conf_t *pmcf); | |
653 | 43 static ngx_int_t ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, |
649 | 44 ngx_log_t *log); |
599 | 45 static ngx_int_t ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
46 ngx_http_perl_ctx_t *ctx, HV *nginx, SV *sub, SV **args, |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
47 ngx_str_t *handler, ngx_str_t *rv); |
599 | 48 static void ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv); |
49 | |
50 static ngx_int_t ngx_http_perl_preconfiguration(ngx_conf_t *cf); | |
51 static void *ngx_http_perl_create_main_conf(ngx_conf_t *cf); | |
52 static char *ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf); | |
53 static void *ngx_http_perl_create_loc_conf(ngx_conf_t *cf); | |
54 static char *ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, | |
55 void *child); | |
56 static char *ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf); | |
57 static char *ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf); | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
58 |
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
59 #if (NGX_HAVE_PERL_MULTIPLICITY) |
599 | 60 static void ngx_http_perl_cleanup_perl(void *data); |
649 | 61 #endif |
599 | 62 |
1257 | 63 static ngx_int_t ngx_http_perl_init_worker(ngx_cycle_t *cycle); |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
64 static void ngx_http_perl_exit(ngx_cycle_t *cycle); |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
65 |
599 | 66 |
67 static ngx_command_t ngx_http_perl_commands[] = { | |
68 | |
69 { ngx_string("perl_modules"), | |
70 NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1, | |
3175 | 71 ngx_conf_set_str_array_slot, |
599 | 72 NGX_HTTP_MAIN_CONF_OFFSET, |
73 offsetof(ngx_http_perl_main_conf_t, modules), | |
74 NULL }, | |
75 | |
76 { ngx_string("perl_require"), | |
77 NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1, | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
78 ngx_conf_set_str_array_slot, |
599 | 79 NGX_HTTP_MAIN_CONF_OFFSET, |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
80 offsetof(ngx_http_perl_main_conf_t, requires), |
599 | 81 NULL }, |
82 | |
83 { ngx_string("perl"), | |
922
a5b9cdfe3e19
allow "perl" inside "limit_except"
Igor Sysoev <igor@sysoev.ru>
parents:
913
diff
changeset
|
84 NGX_HTTP_LOC_CONF|NGX_HTTP_LMT_CONF|NGX_CONF_TAKE1, |
599 | 85 ngx_http_perl, |
86 NGX_HTTP_LOC_CONF_OFFSET, | |
87 0, | |
88 NULL }, | |
89 | |
90 { ngx_string("perl_set"), | |
91 NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE2, | |
92 ngx_http_perl_set, | |
93 NGX_HTTP_LOC_CONF_OFFSET, | |
94 0, | |
95 NULL }, | |
96 | |
97 ngx_null_command | |
98 }; | |
99 | |
100 | |
101 static ngx_http_module_t ngx_http_perl_module_ctx = { | |
102 ngx_http_perl_preconfiguration, /* preconfiguration */ | |
103 NULL, /* postconfiguration */ | |
104 | |
105 ngx_http_perl_create_main_conf, /* create main configuration */ | |
106 ngx_http_perl_init_main_conf, /* init main configuration */ | |
107 | |
108 NULL, /* create server configuration */ | |
109 NULL, /* merge server configuration */ | |
110 | |
111 ngx_http_perl_create_loc_conf, /* create location configuration */ | |
112 ngx_http_perl_merge_loc_conf /* merge location configuration */ | |
113 }; | |
114 | |
115 | |
116 ngx_module_t ngx_http_perl_module = { | |
117 NGX_MODULE_V1, | |
118 &ngx_http_perl_module_ctx, /* module context */ | |
119 ngx_http_perl_commands, /* module directives */ | |
120 NGX_HTTP_MODULE, /* module type */ | |
121 NULL, /* init master */ | |
122 NULL, /* init module */ | |
1257 | 123 ngx_http_perl_init_worker, /* init process */ |
599 | 124 NULL, /* init thread */ |
125 NULL, /* exit thread */ | |
126 NULL, /* exit process */ | |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
127 ngx_http_perl_exit, /* exit master */ |
599 | 128 NGX_MODULE_V1_PADDING |
129 }; | |
130 | |
131 | |
617 | 132 #if (NGX_HTTP_SSI) |
133 | |
599 | 134 #define NGX_HTTP_PERL_SSI_SUB 0 |
135 #define NGX_HTTP_PERL_SSI_ARG 1 | |
136 | |
137 | |
138 static ngx_http_ssi_param_t ngx_http_perl_ssi_params[] = { | |
139 { ngx_string("sub"), NGX_HTTP_PERL_SSI_SUB, 1, 0 }, | |
140 { ngx_string("arg"), NGX_HTTP_PERL_SSI_ARG, 0, 1 }, | |
141 { ngx_null_string, 0, 0, 0 } | |
142 }; | |
143 | |
144 static ngx_http_ssi_command_t ngx_http_perl_ssi_command = { | |
667 | 145 ngx_string("perl"), ngx_http_perl_ssi, ngx_http_perl_ssi_params, 0, 0, 1 |
599 | 146 }; |
147 | |
617 | 148 #endif |
149 | |
599 | 150 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
151 static ngx_str_t ngx_null_name = ngx_null_string; |
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
152 static HV *nginx_stash; |
681 | 153 |
2715 | 154 #if (NGX_HAVE_PERL_MULTIPLICITY) |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
155 static ngx_uint_t ngx_perl_term; |
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
156 #else |
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
157 static PerlInterpreter *perl; |
2715 | 158 #endif |
681 | 159 |
633 | 160 |
599 | 161 static void |
162 ngx_http_perl_xs_init(pTHX) | |
163 { | |
164 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); | |
633 | 165 |
166 nginx_stash = gv_stashpv("nginx", TRUE); | |
599 | 167 } |
168 | |
169 | |
170 static ngx_int_t | |
171 ngx_http_perl_handler(ngx_http_request_t *r) | |
172 { | |
3082
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
173 r->main->count++; |
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
174 |
681 | 175 ngx_http_perl_handle_request(r); |
176 | |
177 return NGX_DONE; | |
629 | 178 } |
179 | |
180 | |
681 | 181 void |
629 | 182 ngx_http_perl_handle_request(ngx_http_request_t *r) |
183 { | |
681 | 184 SV *sub; |
599 | 185 ngx_int_t rc; |
681 | 186 ngx_str_t uri, args, *handler; |
7532
975d7ab37b39
Perl: expect escaped URIs in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7531
diff
changeset
|
187 ngx_uint_t flags; |
599 | 188 ngx_http_perl_ctx_t *ctx; |
189 ngx_http_perl_loc_conf_t *plcf; | |
190 ngx_http_perl_main_conf_t *pmcf; | |
191 | |
192 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl handler"); | |
193 | |
194 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
195 | |
196 if (ctx == NULL) { | |
197 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
198 if (ctx == NULL) { | |
681 | 199 ngx_http_finalize_request(r, NGX_ERROR); |
1025 | 200 return; |
599 | 201 } |
202 | |
203 ngx_http_set_ctx(r, ctx, ngx_http_perl_module); | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
204 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
205 ctx->request = r; |
599 | 206 } |
207 | |
208 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); | |
209 | |
210 { | |
211 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
212 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
213 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
214 PERL_SET_INTERP(pmcf->perl); |
599 | 215 |
681 | 216 if (ctx->next == NULL) { |
217 plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module); | |
218 sub = plcf->sub; | |
219 handler = &plcf->handler; | |
599 | 220 |
681 | 221 } else { |
222 sub = ctx->next; | |
223 handler = &ngx_null_name; | |
224 ctx->next = NULL; | |
225 } | |
226 | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
227 rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, sub, NULL, |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
228 handler, NULL); |
599 | 229 |
230 } | |
231 | |
3082
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
232 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, |
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
233 "perl handler done: %i", rc); |
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
234 |
599 | 235 if (rc > 600) { |
236 rc = NGX_OK; | |
237 } | |
238 | |
239 if (ctx->redirect_uri.len) { | |
240 uri = ctx->redirect_uri; | |
629 | 241 |
242 } else { | |
243 uri.len = 0; | |
599 | 244 } |
245 | |
633 | 246 ctx->filename.data = NULL; |
599 | 247 ctx->redirect_uri.len = 0; |
248 | |
7525 | 249 if (rc == NGX_ERROR) { |
250 ngx_http_finalize_request(r, rc); | |
251 return; | |
252 } | |
253 | |
681 | 254 if (ctx->done || ctx->next) { |
3111
4a2d3f571de6
fix request counter handling in perl module for $r->internal_redirect()
Igor Sysoev <igor@sysoev.ru>
parents:
3082
diff
changeset
|
255 ngx_http_finalize_request(r, NGX_DONE); |
681 | 256 return; |
257 } | |
258 | |
599 | 259 if (uri.len) { |
7533
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
260 if (uri.data[0] == '@') { |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
261 ngx_http_named_location(r, &uri); |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
262 |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
263 } else { |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
264 ngx_str_null(&args); |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
265 flags = NGX_HTTP_LOG_UNSAFE; |
7532
975d7ab37b39
Perl: expect escaped URIs in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7531
diff
changeset
|
266 |
7533
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
267 if (ngx_http_parse_unsafe_uri(r, &uri, &args, &flags) != NGX_OK) { |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
268 ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR); |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
269 return; |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
270 } |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
271 |
5f642712e7ad
Perl: named locations in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7532
diff
changeset
|
272 ngx_http_internal_redirect(r, &uri, &args); |
7532
975d7ab37b39
Perl: expect escaped URIs in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7531
diff
changeset
|
273 } |
975d7ab37b39
Perl: expect escaped URIs in $r->internal_redirect().
Maxim Dounin <mdounin@mdounin.ru>
parents:
7531
diff
changeset
|
274 |
3111
4a2d3f571de6
fix request counter handling in perl module for $r->internal_redirect()
Igor Sysoev <igor@sysoev.ru>
parents:
3082
diff
changeset
|
275 ngx_http_finalize_request(r, NGX_DONE); |
629 | 276 return; |
599 | 277 } |
278 | |
279 if (rc == NGX_OK || rc == NGX_HTTP_OK) { | |
629 | 280 ngx_http_send_special(r, NGX_HTTP_LAST); |
681 | 281 ctx->done = 1; |
599 | 282 } |
283 | |
629 | 284 ngx_http_finalize_request(r, rc); |
599 | 285 } |
286 | |
287 | |
1897 | 288 void |
911 | 289 ngx_http_perl_sleep_handler(ngx_http_request_t *r) |
290 { | |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
291 ngx_event_t *wev; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
292 |
911 | 293 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, |
294 "perl sleep handler"); | |
295 | |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
296 wev = r->connection->write; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
297 |
6961
903fb1ddc07f
Moved handling of wev->delayed to the connection event handler.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6960
diff
changeset
|
298 if (wev->delayed) { |
6960
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
299 |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
300 if (ngx_handle_write_event(wev, 0) != NGX_OK) { |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
301 ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR); |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
302 } |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
303 |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
304 return; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
305 } |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
306 |
6960
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
307 ngx_http_perl_handle_request(r); |
911 | 308 } |
309 | |
310 | |
599 | 311 static ngx_int_t |
312 ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v, | |
313 uintptr_t data) | |
314 { | |
315 ngx_http_perl_variable_t *pv = (ngx_http_perl_variable_t *) data; | |
316 | |
317 ngx_int_t rc; | |
318 ngx_str_t value; | |
7528
0cb693b4cbbb
Perl: disabled unrelated calls from variable handlers.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7525
diff
changeset
|
319 ngx_uint_t saved; |
599 | 320 ngx_http_perl_ctx_t *ctx; |
321 ngx_http_perl_main_conf_t *pmcf; | |
322 | |
323 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, | |
324 "perl variable handler"); | |
325 | |
326 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
327 | |
328 if (ctx == NULL) { | |
329 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
330 if (ctx == NULL) { | |
331 return NGX_ERROR; | |
332 } | |
333 | |
334 ngx_http_set_ctx(r, ctx, ngx_http_perl_module); | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
335 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
336 ctx->request = r; |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
337 } |
599 | 338 |
7528
0cb693b4cbbb
Perl: disabled unrelated calls from variable handlers.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7525
diff
changeset
|
339 saved = ctx->variable; |
0cb693b4cbbb
Perl: disabled unrelated calls from variable handlers.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7525
diff
changeset
|
340 ctx->variable = 1; |
0cb693b4cbbb
Perl: disabled unrelated calls from variable handlers.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7525
diff
changeset
|
341 |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
342 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); |
599 | 343 |
344 value.data = NULL; | |
345 | |
346 { | |
347 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
348 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
349 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
350 PERL_SET_INTERP(pmcf->perl); |
599 | 351 |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
352 rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, pv->sub, NULL, |
599 | 353 &pv->handler, &value); |
354 | |
355 } | |
356 | |
357 if (value.data) { | |
358 v->len = value.len; | |
359 v->valid = 1; | |
1565 | 360 v->no_cacheable = 0; |
599 | 361 v->not_found = 0; |
362 v->data = value.data; | |
363 | |
364 } else { | |
365 v->not_found = 1; | |
366 } | |
367 | |
7528
0cb693b4cbbb
Perl: disabled unrelated calls from variable handlers.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7525
diff
changeset
|
368 ctx->variable = saved; |
633 | 369 ctx->filename.data = NULL; |
599 | 370 ctx->redirect_uri.len = 0; |
371 | |
871 | 372 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, |
373 "perl variable done"); | |
374 | |
599 | 375 return rc; |
376 } | |
377 | |
378 | |
617 | 379 #if (NGX_HTTP_SSI) |
380 | |
599 | 381 static ngx_int_t |
382 ngx_http_perl_ssi(ngx_http_request_t *r, ngx_http_ssi_ctx_t *ssi_ctx, | |
383 ngx_str_t **params) | |
384 { | |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
385 SV *sv, **asv; |
599 | 386 ngx_int_t rc; |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
387 ngx_str_t *handler, **args; |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
388 ngx_uint_t i; |
599 | 389 ngx_http_perl_ctx_t *ctx; |
390 ngx_http_perl_main_conf_t *pmcf; | |
391 | |
392 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, | |
393 "perl ssi handler"); | |
394 | |
395 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
396 | |
397 if (ctx == NULL) { | |
398 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
399 if (ctx == NULL) { | |
400 return NGX_ERROR; | |
401 } | |
402 | |
403 ngx_http_set_ctx(r, ctx, ngx_http_perl_module); | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
404 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
405 ctx->request = r; |
599 | 406 } |
407 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
408 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); |
599 | 409 |
410 ctx->ssi = ssi_ctx; | |
7531
ede052c67512
Perl: additional ctx->header_sent checks.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7530
diff
changeset
|
411 ctx->header_sent = 1; |
599 | 412 |
413 handler = params[NGX_HTTP_PERL_SSI_SUB]; | |
414 handler->data[handler->len] = '\0'; | |
415 | |
416 { | |
417 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
418 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
419 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
420 PERL_SET_INTERP(pmcf->perl); |
599 | 421 |
651 | 422 #if 0 |
423 | |
424 /* the code is disabled to force the precompiled perl code using only */ | |
425 | |
426 ngx_http_perl_eval_anon_sub(aTHX_ handler, &sv); | |
427 | |
428 if (sv == &PL_sv_undef) { | |
429 ngx_log_error(NGX_LOG_ERR, r->connection->log, 0, | |
430 "eval_pv(\"%V\") failed", handler); | |
431 return NGX_ERROR; | |
432 } | |
433 | |
434 if (sv == NULL) { | |
435 sv = newSVpvn((char *) handler->data, handler->len); | |
436 } | |
437 | |
438 #endif | |
439 | |
599 | 440 sv = newSVpvn((char *) handler->data, handler->len); |
441 | |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
442 args = ¶ms[NGX_HTTP_PERL_SSI_ARG]; |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
443 |
6791
cb4a4e9bba8e
Perl: fixed optimization in SSI command handler.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5800
diff
changeset
|
444 if (args[0]) { |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
445 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
446 for (i = 0; args[i]; i++) { /* void */ } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
447 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
448 asv = ngx_pcalloc(r->pool, (i + 1) * sizeof(SV *)); |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
449 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
450 if (asv == NULL) { |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
451 SvREFCNT_dec(sv); |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
452 return NGX_ERROR; |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
453 } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
454 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
455 asv[0] = (SV *) (uintptr_t) i; |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
456 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
457 for (i = 0; args[i]; i++) { |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
458 asv[i + 1] = newSVpvn((char *) args[i]->data, args[i]->len); |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
459 } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
460 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
461 } else { |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
462 asv = NULL; |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
463 } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
464 |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
465 rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, sv, asv, |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
466 handler, NULL); |
599 | 467 |
468 SvREFCNT_dec(sv); | |
469 | |
470 } | |
471 | |
633 | 472 ctx->filename.data = NULL; |
599 | 473 ctx->redirect_uri.len = 0; |
474 ctx->ssi = NULL; | |
475 | |
871 | 476 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl ssi done"); |
477 | |
599 | 478 return rc; |
479 } | |
480 | |
617 | 481 #endif |
482 | |
599 | 483 |
484 static char * | |
485 ngx_http_perl_init_interpreter(ngx_conf_t *cf, ngx_http_perl_main_conf_t *pmcf) | |
486 { | |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
487 ngx_str_t *m; |
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
488 ngx_uint_t i; |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
489 #if (NGX_HAVE_PERL_MULTIPLICITY) |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
490 ngx_pool_cleanup_t *cln; |
599 | 491 |
492 cln = ngx_pool_cleanup_add(cf->pool, 0); | |
493 if (cln == NULL) { | |
494 return NGX_CONF_ERROR; | |
495 } | |
496 | |
649 | 497 #endif |
498 | |
599 | 499 #ifdef NGX_PERL_MODULES |
3175 | 500 if (pmcf->modules == NGX_CONF_UNSET_PTR) { |
501 | |
502 pmcf->modules = ngx_array_create(cf->pool, 1, sizeof(ngx_str_t)); | |
503 if (pmcf->modules == NULL) { | |
504 return NGX_CONF_ERROR; | |
505 } | |
506 | |
507 m = ngx_array_push(pmcf->modules); | |
508 if (m == NULL) { | |
509 return NGX_CONF_ERROR; | |
510 } | |
511 | |
3516
dd1570b6f237
ngx_str_set() and ngx_str_null()
Igor Sysoev <igor@sysoev.ru>
parents:
3448
diff
changeset
|
512 ngx_str_set(m, NGX_PERL_MODULES); |
599 | 513 } |
514 #endif | |
515 | |
3175 | 516 if (pmcf->modules != NGX_CONF_UNSET_PTR) { |
517 m = pmcf->modules->elts; | |
518 for (i = 0; i < pmcf->modules->nelts; i++) { | |
5330
314c3d7cc3a5
Backed out f1a91825730a and 7094bd12c1ff.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5317
diff
changeset
|
519 if (ngx_conf_full_name(cf->cycle, &m[i], 0) != NGX_OK) { |
3175 | 520 return NGX_CONF_ERROR; |
521 } | |
639 | 522 } |
629 | 523 } |
524 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
525 #if !(NGX_HAVE_PERL_MULTIPLICITY) |
649 | 526 |
527 if (perl) { | |
1165 | 528 |
529 if (ngx_set_environment(cf->cycle, NULL) == NULL) { | |
530 return NGX_CONF_ERROR; | |
531 } | |
532 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
533 if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) |
653 | 534 != NGX_OK) |
535 { | |
649 | 536 return NGX_CONF_ERROR; |
537 } | |
538 | |
539 pmcf->perl = perl; | |
1163
8288459f15c9
set nginx_stash after reconfiguration in single interpreter perl
Igor Sysoev <igor@sysoev.ru>
parents:
1069
diff
changeset
|
540 pmcf->nginx = nginx_stash; |
649 | 541 |
542 return NGX_CONF_OK; | |
543 } | |
544 | |
545 #endif | |
546 | |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
547 if (nginx_stash == NULL) { |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
548 PERL_SYS_INIT(&ngx_argc, &ngx_argv); |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
549 } |
599 | 550 |
1069 | 551 pmcf->perl = ngx_http_perl_create_interpreter(cf, pmcf); |
599 | 552 |
553 if (pmcf->perl == NULL) { | |
554 return NGX_CONF_ERROR; | |
555 } | |
556 | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
557 pmcf->nginx = nginx_stash; |
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
558 |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
559 #if (NGX_HAVE_PERL_MULTIPLICITY) |
649 | 560 |
599 | 561 cln->handler = ngx_http_perl_cleanup_perl; |
562 cln->data = pmcf->perl; | |
563 | |
649 | 564 #else |
565 | |
566 perl = pmcf->perl; | |
567 | |
568 #endif | |
569 | |
599 | 570 return NGX_CONF_OK; |
571 } | |
572 | |
573 | |
574 static PerlInterpreter * | |
1069 | 575 ngx_http_perl_create_interpreter(ngx_conf_t *cf, |
576 ngx_http_perl_main_conf_t *pmcf) | |
599 | 577 { |
578 int n; | |
775 | 579 STRLEN len; |
580 SV *sv; | |
3175 | 581 char *ver, **embedding; |
582 ngx_str_t *m; | |
583 ngx_uint_t i; | |
599 | 584 PerlInterpreter *perl; |
585 | |
1069 | 586 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0, "create perl interpreter"); |
587 | |
588 if (ngx_set_environment(cf->cycle, NULL) == NULL) { | |
589 return NULL; | |
590 } | |
599 | 591 |
592 perl = perl_alloc(); | |
593 if (perl == NULL) { | |
1069 | 594 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed"); |
599 | 595 return NULL; |
596 } | |
597 | |
598 { | |
599 | |
600 dTHXa(perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
601 PERL_SET_CONTEXT(perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
602 PERL_SET_INTERP(perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
603 |
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
604 perl_construct(perl); |
599 | 605 |
606 #ifdef PERL_EXIT_DESTRUCT_END | |
607 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; | |
608 #endif | |
609 | |
3175 | 610 n = (pmcf->modules != NGX_CONF_UNSET_PTR) ? pmcf->modules->nelts * 2 : 0; |
611 | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
612 embedding = ngx_palloc(cf->pool, (5 + n) * sizeof(char *)); |
3175 | 613 if (embedding == NULL) { |
614 goto fail; | |
615 } | |
616 | |
599 | 617 embedding[0] = ""; |
618 | |
3175 | 619 if (n++) { |
620 m = pmcf->modules->elts; | |
621 for (i = 0; i < pmcf->modules->nelts; i++) { | |
622 embedding[2 * i + 1] = "-I"; | |
623 embedding[2 * i + 2] = (char *) m[i].data; | |
624 } | |
599 | 625 } |
626 | |
627 embedding[n++] = "-Mnginx"; | |
628 embedding[n++] = "-e"; | |
629 embedding[n++] = "0"; | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
630 embedding[n] = NULL; |
599 | 631 |
632 n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL); | |
633 | |
634 if (n != 0) { | |
1069 | 635 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_parse() failed: %d", n); |
599 | 636 goto fail; |
637 } | |
638 | |
775 | 639 sv = get_sv("nginx::VERSION", FALSE); |
640 ver = SvPV(sv, len); | |
641 | |
642 if (ngx_strcmp(ver, NGINX_VERSION) != 0) { | |
1069 | 643 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, |
775 | 644 "version " NGINX_VERSION " of nginx.pm is required, " |
645 "but %s was found", ver); | |
646 goto fail; | |
647 } | |
648 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
649 if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) != NGX_OK) { |
649 | 650 goto fail; |
599 | 651 } |
652 | |
653 } | |
654 | |
655 return perl; | |
656 | |
657 fail: | |
658 | |
659 (void) perl_destruct(perl); | |
660 | |
661 perl_free(perl); | |
662 | |
663 return NULL; | |
664 } | |
665 | |
666 | |
649 | 667 static ngx_int_t |
653 | 668 ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log) |
649 | 669 { |
3173 | 670 u_char *err; |
649 | 671 STRLEN len; |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
672 ngx_str_t *script; |
649 | 673 ngx_uint_t i; |
674 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
675 if (requires == NGX_CONF_UNSET_PTR) { |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
676 return NGX_OK; |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
677 } |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
678 |
649 | 679 script = requires->elts; |
680 for (i = 0; i < requires->nelts; i++) { | |
681 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
682 require_pv((char *) script[i].data); |
649 | 683 |
684 if (SvTRUE(ERRSV)) { | |
685 | |
3173 | 686 err = (u_char *) SvPV(ERRSV, len); |
687 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
649 | 688 |
689 ngx_log_error(NGX_LOG_EMERG, log, 0, | |
3173 | 690 "require_pv(\"%s\") failed: \"%*s\"", |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
691 script[i].data, len + 1, err); |
649 | 692 |
693 return NGX_ERROR; | |
694 } | |
695 } | |
696 | |
697 return NGX_OK; | |
698 } | |
699 | |
700 | |
599 | 701 static ngx_int_t |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
702 ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
703 ngx_http_perl_ctx_t *ctx, HV *nginx, SV *sub, SV **args, |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
704 ngx_str_t *handler, ngx_str_t *rv) |
599 | 705 { |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
706 SV *sv; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
707 int n, status; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
708 char *line; |
3173 | 709 u_char *err; |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
710 STRLEN len, n_a; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
711 ngx_uint_t i; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
712 ngx_connection_t *c; |
599 | 713 |
714 dSP; | |
715 | |
716 status = 0; | |
717 | |
7525 | 718 ctx->error = 0; |
719 ctx->status = NGX_OK; | |
720 | |
599 | 721 ENTER; |
722 SAVETMPS; | |
723 | |
724 PUSHMARK(sp); | |
725 | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
726 sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(ctx))), nginx)); |
599 | 727 XPUSHs(sv); |
728 | |
729 if (args) { | |
1940
6a4c74bea81c
fix building on 64-bit platforms broken in r1900
Igor Sysoev <igor@sysoev.ru>
parents:
1899
diff
changeset
|
730 EXTEND(sp, (intptr_t) args[0]); |
599 | 731 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
732 for (i = 1; i <= (uintptr_t) args[0]; i++) { |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
733 PUSHs(sv_2mortal(args[i])); |
599 | 734 } |
735 } | |
736 | |
737 PUTBACK; | |
738 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
739 c = r->connection; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
740 |
599 | 741 n = call_sv(sub, G_EVAL); |
742 | |
743 SPAGAIN; | |
744 | |
745 if (n) { | |
746 if (rv == NULL) { | |
747 status = POPi; | |
748 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
749 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0, |
599 | 750 "call_sv: %d", status); |
751 | |
752 } else { | |
619 | 753 line = SvPVx(POPs, n_a); |
599 | 754 rv->len = n_a; |
755 | |
2049 | 756 rv->data = ngx_pnalloc(r->pool, n_a); |
599 | 757 if (rv->data == NULL) { |
758 return NGX_ERROR; | |
759 } | |
760 | |
761 ngx_memcpy(rv->data, line, n_a); | |
762 } | |
763 } | |
764 | |
765 PUTBACK; | |
766 | |
767 FREETMPS; | |
768 LEAVE; | |
769 | |
7525 | 770 if (ctx->error) { |
771 | |
772 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0, | |
773 "call_sv: error, %d", ctx->status); | |
774 | |
775 if (ctx->status != NGX_OK) { | |
776 return ctx->status; | |
777 } | |
778 | |
779 return NGX_ERROR; | |
780 } | |
781 | |
599 | 782 /* check $@ */ |
783 | |
784 if (SvTRUE(ERRSV)) { | |
785 | |
3173 | 786 err = (u_char *) SvPV(ERRSV, len); |
787 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
599 | 788 |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
789 ngx_log_error(NGX_LOG_ERR, c->log, 0, |
3173 | 790 "call_sv(\"%V\") failed: \"%*s\"", handler, len + 1, err); |
599 | 791 |
792 if (rv) { | |
793 return NGX_ERROR; | |
794 } | |
795 | |
7529
d758d04e0790
Perl: avoid redirects on errors.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7528
diff
changeset
|
796 ctx->redirect_uri.len = 0; |
d758d04e0790
Perl: avoid redirects on errors.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7528
diff
changeset
|
797 |
7530
fd9252844ec1
Perl: avoid returning 500 if header was already sent.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7529
diff
changeset
|
798 if (ctx->header_sent) { |
fd9252844ec1
Perl: avoid returning 500 if header was already sent.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7529
diff
changeset
|
799 return NGX_ERROR; |
fd9252844ec1
Perl: avoid returning 500 if header was already sent.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7529
diff
changeset
|
800 } |
fd9252844ec1
Perl: avoid returning 500 if header was already sent.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7529
diff
changeset
|
801 |
599 | 802 return NGX_HTTP_INTERNAL_SERVER_ERROR; |
803 } | |
804 | |
805 if (n != 1) { | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
806 ngx_log_error(NGX_LOG_ALERT, c->log, 0, |
599 | 807 "call_sv(\"%V\") returned %d results", handler, n); |
808 status = NGX_OK; | |
809 } | |
810 | |
811 if (rv) { | |
812 return NGX_OK; | |
813 } | |
814 | |
815 return (ngx_int_t) status; | |
816 } | |
817 | |
818 | |
819 static void | |
820 ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv) | |
821 { | |
623 | 822 u_char *p; |
823 | |
824 for (p = handler->data; *p; p++) { | |
825 if (*p != ' ' && *p != '\t' && *p != CR && *p != LF) { | |
826 break; | |
827 } | |
828 } | |
829 | |
3132 | 830 if (ngx_strncmp(p, "sub ", 4) == 0 |
831 || ngx_strncmp(p, "sub{", 4) == 0 | |
832 || ngx_strncmp(p, "use ", 4) == 0) | |
833 { | |
623 | 834 *sv = eval_pv((char *) p, FALSE); |
874 | 835 |
836 /* eval_pv() does not set ERRSV on failure */ | |
837 | |
599 | 838 return; |
839 } | |
840 | |
841 *sv = NULL; | |
842 } | |
843 | |
844 | |
845 static void * | |
846 ngx_http_perl_create_main_conf(ngx_conf_t *cf) | |
847 { | |
848 ngx_http_perl_main_conf_t *pmcf; | |
849 | |
850 pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t)); | |
851 if (pmcf == NULL) { | |
2912
c7d57b539248
return NULL instead of NGX_CONF_ERROR on a create conf failure
Igor Sysoev <igor@sysoev.ru>
parents:
2721
diff
changeset
|
852 return NULL; |
599 | 853 } |
854 | |
3175 | 855 pmcf->modules = NGX_CONF_UNSET_PTR; |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
856 pmcf->requires = NGX_CONF_UNSET_PTR; |
599 | 857 |
858 return pmcf; | |
859 } | |
860 | |
861 | |
862 static char * | |
863 ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf) | |
864 { | |
865 ngx_http_perl_main_conf_t *pmcf = conf; | |
866 | |
867 if (pmcf->perl == NULL) { | |
868 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
869 return NGX_CONF_ERROR; | |
870 } | |
871 } | |
872 | |
873 return NGX_CONF_OK; | |
874 } | |
875 | |
876 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
877 #if (NGX_HAVE_PERL_MULTIPLICITY) |
649 | 878 |
599 | 879 static void |
880 ngx_http_perl_cleanup_perl(void *data) | |
881 { | |
649 | 882 PerlInterpreter *perl = data; |
599 | 883 |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
884 PERL_SET_CONTEXT(perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
885 PERL_SET_INTERP(perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
886 |
599 | 887 (void) perl_destruct(perl); |
888 | |
889 perl_free(perl); | |
2715 | 890 |
891 if (ngx_perl_term) { | |
892 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term"); | |
893 | |
894 PERL_SYS_TERM(); | |
895 } | |
599 | 896 } |
897 | |
649 | 898 #endif |
899 | |
900 | |
599 | 901 static ngx_int_t |
902 ngx_http_perl_preconfiguration(ngx_conf_t *cf) | |
903 { | |
617 | 904 #if (NGX_HTTP_SSI) |
599 | 905 ngx_int_t rc; |
906 ngx_http_ssi_main_conf_t *smcf; | |
907 | |
908 smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module); | |
909 | |
910 rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name, | |
911 &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY); | |
912 | |
913 if (rc != NGX_OK) { | |
914 if (rc == NGX_BUSY) { | |
915 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
916 "conflicting SSI command \"%V\"", | |
917 &ngx_http_perl_ssi_command.name); | |
918 } | |
919 | |
920 return NGX_ERROR; | |
921 } | |
617 | 922 #endif |
599 | 923 |
924 return NGX_OK; | |
925 } | |
926 | |
927 | |
928 static void * | |
929 ngx_http_perl_create_loc_conf(ngx_conf_t *cf) | |
930 { | |
931 ngx_http_perl_loc_conf_t *plcf; | |
932 | |
933 plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t)); | |
934 if (plcf == NULL) { | |
2912
c7d57b539248
return NULL instead of NGX_CONF_ERROR on a create conf failure
Igor Sysoev <igor@sysoev.ru>
parents:
2721
diff
changeset
|
935 return NULL; |
599 | 936 } |
937 | |
938 /* | |
939 * set by ngx_pcalloc(): | |
940 * | |
941 * plcf->handler = { 0, NULL }; | |
942 */ | |
943 | |
944 return plcf; | |
945 } | |
946 | |
947 | |
948 static char * | |
949 ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child) | |
950 { | |
951 ngx_http_perl_loc_conf_t *prev = parent; | |
952 ngx_http_perl_loc_conf_t *conf = child; | |
953 | |
954 if (conf->sub == NULL) { | |
955 conf->sub = prev->sub; | |
956 conf->handler = prev->handler; | |
957 } | |
958 | |
959 return NGX_CONF_OK; | |
960 } | |
961 | |
962 | |
963 static char * | |
964 ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
965 { | |
966 ngx_http_perl_loc_conf_t *plcf = conf; | |
967 | |
968 ngx_str_t *value; | |
969 ngx_http_core_loc_conf_t *clcf; | |
970 ngx_http_perl_main_conf_t *pmcf; | |
971 | |
972 value = cf->args->elts; | |
973 | |
974 if (plcf->handler.data) { | |
975 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
976 "duplicate perl handler \"%V\"", &value[1]); | |
977 return NGX_CONF_ERROR; | |
978 } | |
979 | |
980 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
981 | |
982 if (pmcf->perl == NULL) { | |
983 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
984 return NGX_CONF_ERROR; | |
985 } | |
986 } | |
987 | |
988 plcf->handler = value[1]; | |
989 | |
990 { | |
991 | |
992 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
993 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
994 PERL_SET_INTERP(pmcf->perl); |
599 | 995 |
996 ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub); | |
997 | |
998 if (plcf->sub == &PL_sv_undef) { | |
999 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
1000 "eval_pv(\"%V\") failed", &value[1]); | |
1001 return NGX_CONF_ERROR; | |
1002 } | |
1003 | |
1004 if (plcf->sub == NULL) { | |
1005 plcf->sub = newSVpvn((char *) value[1].data, value[1].len); | |
1006 } | |
1007 | |
1008 } | |
1009 | |
1010 clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module); | |
1011 clcf->handler = ngx_http_perl_handler; | |
1012 | |
1013 return NGX_CONF_OK; | |
1014 } | |
1015 | |
1016 | |
1017 static char * | |
1018 ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
1019 { | |
1020 ngx_int_t index; | |
1021 ngx_str_t *value; | |
1022 ngx_http_variable_t *v; | |
1023 ngx_http_perl_variable_t *pv; | |
1024 ngx_http_perl_main_conf_t *pmcf; | |
1025 | |
1026 value = cf->args->elts; | |
1027 | |
4972
8b635cf36ccc
Added checks that disallow adding a variable with an empty name.
Ruslan Ermilov <ru@nginx.com>
parents:
4963
diff
changeset
|
1028 if (value[1].data[0] != '$') { |
599 | 1029 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, |
1030 "invalid variable name \"%V\"", &value[1]); | |
1031 return NGX_CONF_ERROR; | |
1032 } | |
1033 | |
1034 value[1].len--; | |
1035 value[1].data++; | |
1036 | |
1565 | 1037 v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGEABLE); |
599 | 1038 if (v == NULL) { |
1039 return NGX_CONF_ERROR; | |
1040 } | |
1041 | |
1042 pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t)); | |
1043 if (pv == NULL) { | |
1044 return NGX_CONF_ERROR; | |
1045 } | |
1046 | |
1047 index = ngx_http_get_variable_index(cf, &value[1]); | |
1048 if (index == NGX_ERROR) { | |
1049 return NGX_CONF_ERROR; | |
1050 } | |
1051 | |
1052 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
1053 | |
1054 if (pmcf->perl == NULL) { | |
1055 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
1056 return NGX_CONF_ERROR; | |
1057 } | |
1058 } | |
1059 | |
1060 pv->handler = value[2]; | |
1061 | |
1062 { | |
1063 | |
1064 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
1065 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
1066 PERL_SET_INTERP(pmcf->perl); |
599 | 1067 |
1068 ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub); | |
1069 | |
1070 if (pv->sub == &PL_sv_undef) { | |
1071 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
1072 "eval_pv(\"%V\") failed", &value[2]); | |
1073 return NGX_CONF_ERROR; | |
1074 } | |
1075 | |
1076 if (pv->sub == NULL) { | |
1077 pv->sub = newSVpvn((char *) value[2].data, value[2].len); | |
1078 } | |
1079 | |
1080 } | |
1081 | |
637 | 1082 v->get_handler = ngx_http_perl_variable; |
599 | 1083 v->data = (uintptr_t) pv; |
1084 | |
1085 return NGX_CONF_OK; | |
1086 } | |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1087 |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1088 |
1257 | 1089 static ngx_int_t |
1090 ngx_http_perl_init_worker(ngx_cycle_t *cycle) | |
1091 { | |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1092 ngx_http_perl_main_conf_t *pmcf; |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1093 |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1094 pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module); |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1095 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1096 if (pmcf) { |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1097 dTHXa(pmcf->perl); |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1098 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
1099 PERL_SET_INTERP(pmcf->perl); |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1100 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1101 /* set worker's $$ */ |
1257 | 1102 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1103 sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid); |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1104 } |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1105 |
1257 | 1106 return NGX_OK; |
1107 } | |
1108 | |
1941 | 1109 |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1110 static void |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1111 ngx_http_perl_exit(ngx_cycle_t *cycle) |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1112 { |
2715 | 1113 #if (NGX_HAVE_PERL_MULTIPLICITY) |
1114 | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1115 /* |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1116 * the master exit hook is run before global pool cleanup, |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1117 * therefore just set flag here |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1118 */ |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1119 |
2715 | 1120 ngx_perl_term = 1; |
1121 | |
1122 #else | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1123 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1124 if (nginx_stash) { |
2715 | 1125 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term"); |
1126 | |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1127 (void) perl_destruct(perl); |
2715 | 1128 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1129 perl_free(perl); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1130 |
2714
4dd1773990db
fix segfault on exit if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2713
diff
changeset
|
1131 PERL_SYS_TERM(); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1132 } |
2715 | 1133 |
1134 #endif | |
1221
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1135 } |