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