Mercurial > hg > nginx
annotate src/http/modules/perl/ngx_http_perl_module.c @ 7525:575480d3fd01
Perl: propagate errors.
When an error happens, the ctx->error bit is now set, and croak()
is called to terminate further processing. The ctx->error bit is
checked in ngx_http_perl_call_handler() to cancel further processing,
and is also checked in various output functions - to make sure these won't
be called if croak() was handled by an eval{} in perl code.
In particular, this ensures that output chain won't be called after
errors, as filters might not expect this to happen. This fixes some
segmentation faults under low memory conditions. Also this stops
request processing after filter finalization or request body reading
errors.
For cases where an HTTP error status can be additionally returned (for
example, 416 (Requested Range Not Satisfiable) from the range filter),
the ctx->status field is also added.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Fri, 12 Jul 2019 13:56:21 +0300 |
parents | deebe988cbd7 |
children | 0cb693b4cbbb |
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; |
599 | 187 ngx_http_perl_ctx_t *ctx; |
188 ngx_http_perl_loc_conf_t *plcf; | |
189 ngx_http_perl_main_conf_t *pmcf; | |
190 | |
191 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl handler"); | |
192 | |
193 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
194 | |
195 if (ctx == NULL) { | |
196 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
197 if (ctx == NULL) { | |
681 | 198 ngx_http_finalize_request(r, NGX_ERROR); |
1025 | 199 return; |
599 | 200 } |
201 | |
202 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
|
203 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
204 ctx->request = r; |
599 | 205 } |
206 | |
207 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); | |
208 | |
209 { | |
210 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
211 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
212 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
213 PERL_SET_INTERP(pmcf->perl); |
599 | 214 |
681 | 215 if (ctx->next == NULL) { |
216 plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module); | |
217 sub = plcf->sub; | |
218 handler = &plcf->handler; | |
599 | 219 |
681 | 220 } else { |
221 sub = ctx->next; | |
222 handler = &ngx_null_name; | |
223 ctx->next = NULL; | |
224 } | |
225 | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
226 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
|
227 handler, NULL); |
599 | 228 |
229 } | |
230 | |
3082
5e8bf3e983d2
fix request counter handling for perl handler, introduced in r3050
Igor Sysoev <igor@sysoev.ru>
parents:
3050
diff
changeset
|
231 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
|
232 "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
|
233 |
599 | 234 if (rc > 600) { |
235 rc = NGX_OK; | |
236 } | |
237 | |
238 if (ctx->redirect_uri.len) { | |
239 uri = ctx->redirect_uri; | |
240 args = ctx->redirect_args; | |
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) { |
629 | 260 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
|
261 ngx_http_finalize_request(r, NGX_DONE); |
629 | 262 return; |
599 | 263 } |
264 | |
265 if (rc == NGX_OK || rc == NGX_HTTP_OK) { | |
629 | 266 ngx_http_send_special(r, NGX_HTTP_LAST); |
681 | 267 ctx->done = 1; |
599 | 268 } |
269 | |
629 | 270 ngx_http_finalize_request(r, rc); |
599 | 271 } |
272 | |
273 | |
1897 | 274 void |
911 | 275 ngx_http_perl_sleep_handler(ngx_http_request_t *r) |
276 { | |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
277 ngx_event_t *wev; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
278 |
911 | 279 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, |
280 "perl sleep handler"); | |
281 | |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
282 wev = r->connection->write; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
283 |
6961
903fb1ddc07f
Moved handling of wev->delayed to the connection event handler.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6960
diff
changeset
|
284 if (wev->delayed) { |
6960
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 if (ngx_handle_write_event(wev, 0) != NGX_OK) { |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
287 ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR); |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
288 } |
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
289 |
913
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
290 return; |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
291 } |
90ce4d0e3241
fix ngx_http_perl_sleep_handler()
Igor Sysoev <igor@sysoev.ru>
parents:
911
diff
changeset
|
292 |
6960
1c5e5e5b008d
Perl: fixed delaying subrequests.
Maxim Dounin <mdounin@mdounin.ru>
parents:
6820
diff
changeset
|
293 ngx_http_perl_handle_request(r); |
911 | 294 } |
295 | |
296 | |
599 | 297 static ngx_int_t |
298 ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v, | |
299 uintptr_t data) | |
300 { | |
301 ngx_http_perl_variable_t *pv = (ngx_http_perl_variable_t *) data; | |
302 | |
303 ngx_int_t rc; | |
304 ngx_str_t value; | |
305 ngx_http_perl_ctx_t *ctx; | |
306 ngx_http_perl_main_conf_t *pmcf; | |
307 | |
308 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, | |
309 "perl variable handler"); | |
310 | |
311 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
312 | |
313 if (ctx == NULL) { | |
314 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
315 if (ctx == NULL) { | |
316 return NGX_ERROR; | |
317 } | |
318 | |
319 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
|
320 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
321 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
|
322 } |
599 | 323 |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
324 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); |
599 | 325 |
326 value.data = NULL; | |
327 | |
328 { | |
329 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
330 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
331 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
332 PERL_SET_INTERP(pmcf->perl); |
599 | 333 |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
334 rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, pv->sub, NULL, |
599 | 335 &pv->handler, &value); |
336 | |
337 } | |
338 | |
339 if (value.data) { | |
340 v->len = value.len; | |
341 v->valid = 1; | |
1565 | 342 v->no_cacheable = 0; |
599 | 343 v->not_found = 0; |
344 v->data = value.data; | |
345 | |
346 } else { | |
347 v->not_found = 1; | |
348 } | |
349 | |
633 | 350 ctx->filename.data = NULL; |
599 | 351 ctx->redirect_uri.len = 0; |
352 | |
871 | 353 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, |
354 "perl variable done"); | |
355 | |
599 | 356 return rc; |
357 } | |
358 | |
359 | |
617 | 360 #if (NGX_HTTP_SSI) |
361 | |
599 | 362 static ngx_int_t |
363 ngx_http_perl_ssi(ngx_http_request_t *r, ngx_http_ssi_ctx_t *ssi_ctx, | |
364 ngx_str_t **params) | |
365 { | |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
366 SV *sv, **asv; |
599 | 367 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
|
368 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
|
369 ngx_uint_t i; |
599 | 370 ngx_http_perl_ctx_t *ctx; |
371 ngx_http_perl_main_conf_t *pmcf; | |
372 | |
373 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, | |
374 "perl ssi handler"); | |
375 | |
376 ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module); | |
377 | |
378 if (ctx == NULL) { | |
379 ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t)); | |
380 if (ctx == NULL) { | |
381 return NGX_ERROR; | |
382 } | |
383 | |
384 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
|
385 |
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
386 ctx->request = r; |
599 | 387 } |
388 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
389 pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module); |
599 | 390 |
391 ctx->ssi = ssi_ctx; | |
392 | |
393 handler = params[NGX_HTTP_PERL_SSI_SUB]; | |
394 handler->data[handler->len] = '\0'; | |
395 | |
396 { | |
397 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
398 dTHXa(pmcf->perl); |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
399 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
400 PERL_SET_INTERP(pmcf->perl); |
599 | 401 |
651 | 402 #if 0 |
403 | |
404 /* the code is disabled to force the precompiled perl code using only */ | |
405 | |
406 ngx_http_perl_eval_anon_sub(aTHX_ handler, &sv); | |
407 | |
408 if (sv == &PL_sv_undef) { | |
409 ngx_log_error(NGX_LOG_ERR, r->connection->log, 0, | |
410 "eval_pv(\"%V\") failed", handler); | |
411 return NGX_ERROR; | |
412 } | |
413 | |
414 if (sv == NULL) { | |
415 sv = newSVpvn((char *) handler->data, handler->len); | |
416 } | |
417 | |
418 #endif | |
419 | |
599 | 420 sv = newSVpvn((char *) handler->data, handler->len); |
421 | |
1899
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
422 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
|
423 |
6791
cb4a4e9bba8e
Perl: fixed optimization in SSI command handler.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5800
diff
changeset
|
424 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
|
425 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
426 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
|
427 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
428 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
|
429 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
430 if (asv == NULL) { |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
431 SvREFCNT_dec(sv); |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
432 return NGX_ERROR; |
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 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
435 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
|
436 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
437 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
|
438 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
|
439 } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
440 |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
441 } else { |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
442 asv = NULL; |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
443 } |
d24ef26f1205
pass additional arguments in ngx_http_perl_call_handler() as SV
Igor Sysoev <igor@sysoev.ru>
parents:
1897
diff
changeset
|
444 |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
445 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
|
446 handler, NULL); |
599 | 447 |
448 SvREFCNT_dec(sv); | |
449 | |
450 } | |
451 | |
633 | 452 ctx->filename.data = NULL; |
599 | 453 ctx->redirect_uri.len = 0; |
454 ctx->ssi = NULL; | |
455 | |
871 | 456 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl ssi done"); |
457 | |
599 | 458 return rc; |
459 } | |
460 | |
617 | 461 #endif |
462 | |
599 | 463 |
464 static char * | |
465 ngx_http_perl_init_interpreter(ngx_conf_t *cf, ngx_http_perl_main_conf_t *pmcf) | |
466 { | |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
467 ngx_str_t *m; |
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
468 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
|
469 #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
|
470 ngx_pool_cleanup_t *cln; |
599 | 471 |
472 cln = ngx_pool_cleanup_add(cf->pool, 0); | |
473 if (cln == NULL) { | |
474 return NGX_CONF_ERROR; | |
475 } | |
476 | |
649 | 477 #endif |
478 | |
599 | 479 #ifdef NGX_PERL_MODULES |
3175 | 480 if (pmcf->modules == NGX_CONF_UNSET_PTR) { |
481 | |
482 pmcf->modules = ngx_array_create(cf->pool, 1, sizeof(ngx_str_t)); | |
483 if (pmcf->modules == NULL) { | |
484 return NGX_CONF_ERROR; | |
485 } | |
486 | |
487 m = ngx_array_push(pmcf->modules); | |
488 if (m == NULL) { | |
489 return NGX_CONF_ERROR; | |
490 } | |
491 | |
3516
dd1570b6f237
ngx_str_set() and ngx_str_null()
Igor Sysoev <igor@sysoev.ru>
parents:
3448
diff
changeset
|
492 ngx_str_set(m, NGX_PERL_MODULES); |
599 | 493 } |
494 #endif | |
495 | |
3175 | 496 if (pmcf->modules != NGX_CONF_UNSET_PTR) { |
497 m = pmcf->modules->elts; | |
498 for (i = 0; i < pmcf->modules->nelts; i++) { | |
5330
314c3d7cc3a5
Backed out f1a91825730a and 7094bd12c1ff.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5317
diff
changeset
|
499 if (ngx_conf_full_name(cf->cycle, &m[i], 0) != NGX_OK) { |
3175 | 500 return NGX_CONF_ERROR; |
501 } | |
639 | 502 } |
629 | 503 } |
504 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
505 #if !(NGX_HAVE_PERL_MULTIPLICITY) |
649 | 506 |
507 if (perl) { | |
1165 | 508 |
509 if (ngx_set_environment(cf->cycle, NULL) == NULL) { | |
510 return NGX_CONF_ERROR; | |
511 } | |
512 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
513 if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) |
653 | 514 != NGX_OK) |
515 { | |
649 | 516 return NGX_CONF_ERROR; |
517 } | |
518 | |
519 pmcf->perl = perl; | |
1163
8288459f15c9
set nginx_stash after reconfiguration in single interpreter perl
Igor Sysoev <igor@sysoev.ru>
parents:
1069
diff
changeset
|
520 pmcf->nginx = nginx_stash; |
649 | 521 |
522 return NGX_CONF_OK; | |
523 } | |
524 | |
525 #endif | |
526 | |
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
|
527 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
|
528 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
|
529 } |
599 | 530 |
1069 | 531 pmcf->perl = ngx_http_perl_create_interpreter(cf, pmcf); |
599 | 532 |
533 if (pmcf->perl == NULL) { | |
534 return NGX_CONF_ERROR; | |
535 } | |
536 | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
537 pmcf->nginx = nginx_stash; |
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
538 |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
539 #if (NGX_HAVE_PERL_MULTIPLICITY) |
649 | 540 |
599 | 541 cln->handler = ngx_http_perl_cleanup_perl; |
542 cln->data = pmcf->perl; | |
543 | |
649 | 544 #else |
545 | |
546 perl = pmcf->perl; | |
547 | |
548 #endif | |
549 | |
599 | 550 return NGX_CONF_OK; |
551 } | |
552 | |
553 | |
554 static PerlInterpreter * | |
1069 | 555 ngx_http_perl_create_interpreter(ngx_conf_t *cf, |
556 ngx_http_perl_main_conf_t *pmcf) | |
599 | 557 { |
558 int n; | |
775 | 559 STRLEN len; |
560 SV *sv; | |
3175 | 561 char *ver, **embedding; |
562 ngx_str_t *m; | |
563 ngx_uint_t i; | |
599 | 564 PerlInterpreter *perl; |
565 | |
1069 | 566 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0, "create perl interpreter"); |
567 | |
568 if (ngx_set_environment(cf->cycle, NULL) == NULL) { | |
569 return NULL; | |
570 } | |
599 | 571 |
572 perl = perl_alloc(); | |
573 if (perl == NULL) { | |
1069 | 574 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed"); |
599 | 575 return NULL; |
576 } | |
577 | |
578 { | |
579 | |
580 dTHXa(perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
581 PERL_SET_CONTEXT(perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
582 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
|
583 |
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
584 perl_construct(perl); |
599 | 585 |
586 #ifdef PERL_EXIT_DESTRUCT_END | |
587 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; | |
588 #endif | |
589 | |
3175 | 590 n = (pmcf->modules != NGX_CONF_UNSET_PTR) ? pmcf->modules->nelts * 2 : 0; |
591 | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
592 embedding = ngx_palloc(cf->pool, (5 + n) * sizeof(char *)); |
3175 | 593 if (embedding == NULL) { |
594 goto fail; | |
595 } | |
596 | |
599 | 597 embedding[0] = ""; |
598 | |
3175 | 599 if (n++) { |
600 m = pmcf->modules->elts; | |
601 for (i = 0; i < pmcf->modules->nelts; i++) { | |
602 embedding[2 * i + 1] = "-I"; | |
603 embedding[2 * i + 2] = (char *) m[i].data; | |
604 } | |
599 | 605 } |
606 | |
607 embedding[n++] = "-Mnginx"; | |
608 embedding[n++] = "-e"; | |
609 embedding[n++] = "0"; | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
610 embedding[n] = NULL; |
599 | 611 |
612 n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL); | |
613 | |
614 if (n != 0) { | |
1069 | 615 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_parse() failed: %d", n); |
599 | 616 goto fail; |
617 } | |
618 | |
775 | 619 sv = get_sv("nginx::VERSION", FALSE); |
620 ver = SvPV(sv, len); | |
621 | |
622 if (ngx_strcmp(ver, NGINX_VERSION) != 0) { | |
1069 | 623 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, |
775 | 624 "version " NGINX_VERSION " of nginx.pm is required, " |
625 "but %s was found", ver); | |
626 goto fail; | |
627 } | |
628 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
629 if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) != NGX_OK) { |
649 | 630 goto fail; |
599 | 631 } |
632 | |
633 } | |
634 | |
635 return perl; | |
636 | |
637 fail: | |
638 | |
639 (void) perl_destruct(perl); | |
640 | |
641 perl_free(perl); | |
642 | |
643 return NULL; | |
644 } | |
645 | |
646 | |
649 | 647 static ngx_int_t |
653 | 648 ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log) |
649 | 649 { |
3173 | 650 u_char *err; |
649 | 651 STRLEN len; |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
652 ngx_str_t *script; |
649 | 653 ngx_uint_t i; |
654 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
655 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
|
656 return NGX_OK; |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
657 } |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
658 |
649 | 659 script = requires->elts; |
660 for (i = 0; i < requires->nelts; i++) { | |
661 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
662 require_pv((char *) script[i].data); |
649 | 663 |
664 if (SvTRUE(ERRSV)) { | |
665 | |
3173 | 666 err = (u_char *) SvPV(ERRSV, len); |
667 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
649 | 668 |
669 ngx_log_error(NGX_LOG_EMERG, log, 0, | |
3173 | 670 "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
|
671 script[i].data, len + 1, err); |
649 | 672 |
673 return NGX_ERROR; | |
674 } | |
675 } | |
676 | |
677 return NGX_OK; | |
678 } | |
679 | |
680 | |
599 | 681 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
|
682 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
|
683 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
|
684 ngx_str_t *handler, ngx_str_t *rv) |
599 | 685 { |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
686 SV *sv; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
687 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
|
688 char *line; |
3173 | 689 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
|
690 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
|
691 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
|
692 ngx_connection_t *c; |
599 | 693 |
694 dSP; | |
695 | |
696 status = 0; | |
697 | |
7525 | 698 ctx->error = 0; |
699 ctx->status = NGX_OK; | |
700 | |
599 | 701 ENTER; |
702 SAVETMPS; | |
703 | |
704 PUSHMARK(sp); | |
705 | |
7524
deebe988cbd7
Perl: reworked perl module to pass ctx instead of request.
Maxim Dounin <mdounin@mdounin.ru>
parents:
7523
diff
changeset
|
706 sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(ctx))), nginx)); |
599 | 707 XPUSHs(sv); |
708 | |
709 if (args) { | |
1940
6a4c74bea81c
fix building on 64-bit platforms broken in r1900
Igor Sysoev <igor@sysoev.ru>
parents:
1899
diff
changeset
|
710 EXTEND(sp, (intptr_t) args[0]); |
599 | 711 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
712 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
|
713 PUSHs(sv_2mortal(args[i])); |
599 | 714 } |
715 } | |
716 | |
717 PUTBACK; | |
718 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
719 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
|
720 |
599 | 721 n = call_sv(sub, G_EVAL); |
722 | |
723 SPAGAIN; | |
724 | |
725 if (n) { | |
726 if (rv == NULL) { | |
727 status = POPi; | |
728 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
729 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0, |
599 | 730 "call_sv: %d", status); |
731 | |
732 } else { | |
619 | 733 line = SvPVx(POPs, n_a); |
599 | 734 rv->len = n_a; |
735 | |
2049 | 736 rv->data = ngx_pnalloc(r->pool, n_a); |
599 | 737 if (rv->data == NULL) { |
738 return NGX_ERROR; | |
739 } | |
740 | |
741 ngx_memcpy(rv->data, line, n_a); | |
742 } | |
743 } | |
744 | |
745 PUTBACK; | |
746 | |
747 FREETMPS; | |
748 LEAVE; | |
749 | |
7525 | 750 if (ctx->error) { |
751 | |
752 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0, | |
753 "call_sv: error, %d", ctx->status); | |
754 | |
755 if (ctx->status != NGX_OK) { | |
756 return ctx->status; | |
757 } | |
758 | |
759 return NGX_ERROR; | |
760 } | |
761 | |
599 | 762 /* check $@ */ |
763 | |
764 if (SvTRUE(ERRSV)) { | |
765 | |
3173 | 766 err = (u_char *) SvPV(ERRSV, len); |
767 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
599 | 768 |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
769 ngx_log_error(NGX_LOG_ERR, c->log, 0, |
3173 | 770 "call_sv(\"%V\") failed: \"%*s\"", handler, len + 1, err); |
599 | 771 |
772 if (rv) { | |
773 return NGX_ERROR; | |
774 } | |
775 | |
776 return NGX_HTTP_INTERNAL_SERVER_ERROR; | |
777 } | |
778 | |
779 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
|
780 ngx_log_error(NGX_LOG_ALERT, c->log, 0, |
599 | 781 "call_sv(\"%V\") returned %d results", handler, n); |
782 status = NGX_OK; | |
783 } | |
784 | |
785 if (rv) { | |
786 return NGX_OK; | |
787 } | |
788 | |
789 return (ngx_int_t) status; | |
790 } | |
791 | |
792 | |
793 static void | |
794 ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv) | |
795 { | |
623 | 796 u_char *p; |
797 | |
798 for (p = handler->data; *p; p++) { | |
799 if (*p != ' ' && *p != '\t' && *p != CR && *p != LF) { | |
800 break; | |
801 } | |
802 } | |
803 | |
3132 | 804 if (ngx_strncmp(p, "sub ", 4) == 0 |
805 || ngx_strncmp(p, "sub{", 4) == 0 | |
806 || ngx_strncmp(p, "use ", 4) == 0) | |
807 { | |
623 | 808 *sv = eval_pv((char *) p, FALSE); |
874 | 809 |
810 /* eval_pv() does not set ERRSV on failure */ | |
811 | |
599 | 812 return; |
813 } | |
814 | |
815 *sv = NULL; | |
816 } | |
817 | |
818 | |
819 static void * | |
820 ngx_http_perl_create_main_conf(ngx_conf_t *cf) | |
821 { | |
822 ngx_http_perl_main_conf_t *pmcf; | |
823 | |
824 pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t)); | |
825 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
|
826 return NULL; |
599 | 827 } |
828 | |
3175 | 829 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
|
830 pmcf->requires = NGX_CONF_UNSET_PTR; |
599 | 831 |
832 return pmcf; | |
833 } | |
834 | |
835 | |
836 static char * | |
837 ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf) | |
838 { | |
839 ngx_http_perl_main_conf_t *pmcf = conf; | |
840 | |
841 if (pmcf->perl == NULL) { | |
842 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
843 return NGX_CONF_ERROR; | |
844 } | |
845 } | |
846 | |
847 return NGX_CONF_OK; | |
848 } | |
849 | |
850 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
851 #if (NGX_HAVE_PERL_MULTIPLICITY) |
649 | 852 |
599 | 853 static void |
854 ngx_http_perl_cleanup_perl(void *data) | |
855 { | |
649 | 856 PerlInterpreter *perl = data; |
599 | 857 |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
858 PERL_SET_CONTEXT(perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
859 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
|
860 |
599 | 861 (void) perl_destruct(perl); |
862 | |
863 perl_free(perl); | |
2715 | 864 |
865 if (ngx_perl_term) { | |
866 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term"); | |
867 | |
868 PERL_SYS_TERM(); | |
869 } | |
599 | 870 } |
871 | |
649 | 872 #endif |
873 | |
874 | |
599 | 875 static ngx_int_t |
876 ngx_http_perl_preconfiguration(ngx_conf_t *cf) | |
877 { | |
617 | 878 #if (NGX_HTTP_SSI) |
599 | 879 ngx_int_t rc; |
880 ngx_http_ssi_main_conf_t *smcf; | |
881 | |
882 smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module); | |
883 | |
884 rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name, | |
885 &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY); | |
886 | |
887 if (rc != NGX_OK) { | |
888 if (rc == NGX_BUSY) { | |
889 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
890 "conflicting SSI command \"%V\"", | |
891 &ngx_http_perl_ssi_command.name); | |
892 } | |
893 | |
894 return NGX_ERROR; | |
895 } | |
617 | 896 #endif |
599 | 897 |
898 return NGX_OK; | |
899 } | |
900 | |
901 | |
902 static void * | |
903 ngx_http_perl_create_loc_conf(ngx_conf_t *cf) | |
904 { | |
905 ngx_http_perl_loc_conf_t *plcf; | |
906 | |
907 plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t)); | |
908 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
|
909 return NULL; |
599 | 910 } |
911 | |
912 /* | |
913 * set by ngx_pcalloc(): | |
914 * | |
915 * plcf->handler = { 0, NULL }; | |
916 */ | |
917 | |
918 return plcf; | |
919 } | |
920 | |
921 | |
922 static char * | |
923 ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child) | |
924 { | |
925 ngx_http_perl_loc_conf_t *prev = parent; | |
926 ngx_http_perl_loc_conf_t *conf = child; | |
927 | |
928 if (conf->sub == NULL) { | |
929 conf->sub = prev->sub; | |
930 conf->handler = prev->handler; | |
931 } | |
932 | |
933 return NGX_CONF_OK; | |
934 } | |
935 | |
936 | |
937 static char * | |
938 ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
939 { | |
940 ngx_http_perl_loc_conf_t *plcf = conf; | |
941 | |
942 ngx_str_t *value; | |
943 ngx_http_core_loc_conf_t *clcf; | |
944 ngx_http_perl_main_conf_t *pmcf; | |
945 | |
946 value = cf->args->elts; | |
947 | |
948 if (plcf->handler.data) { | |
949 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
950 "duplicate perl handler \"%V\"", &value[1]); | |
951 return NGX_CONF_ERROR; | |
952 } | |
953 | |
954 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
955 | |
956 if (pmcf->perl == NULL) { | |
957 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
958 return NGX_CONF_ERROR; | |
959 } | |
960 } | |
961 | |
962 plcf->handler = value[1]; | |
963 | |
964 { | |
965 | |
966 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
967 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
968 PERL_SET_INTERP(pmcf->perl); |
599 | 969 |
970 ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub); | |
971 | |
972 if (plcf->sub == &PL_sv_undef) { | |
973 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
974 "eval_pv(\"%V\") failed", &value[1]); | |
975 return NGX_CONF_ERROR; | |
976 } | |
977 | |
978 if (plcf->sub == NULL) { | |
979 plcf->sub = newSVpvn((char *) value[1].data, value[1].len); | |
980 } | |
981 | |
982 } | |
983 | |
984 clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module); | |
985 clcf->handler = ngx_http_perl_handler; | |
986 | |
987 return NGX_CONF_OK; | |
988 } | |
989 | |
990 | |
991 static char * | |
992 ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
993 { | |
994 ngx_int_t index; | |
995 ngx_str_t *value; | |
996 ngx_http_variable_t *v; | |
997 ngx_http_perl_variable_t *pv; | |
998 ngx_http_perl_main_conf_t *pmcf; | |
999 | |
1000 value = cf->args->elts; | |
1001 | |
4972
8b635cf36ccc
Added checks that disallow adding a variable with an empty name.
Ruslan Ermilov <ru@nginx.com>
parents:
4963
diff
changeset
|
1002 if (value[1].data[0] != '$') { |
599 | 1003 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, |
1004 "invalid variable name \"%V\"", &value[1]); | |
1005 return NGX_CONF_ERROR; | |
1006 } | |
1007 | |
1008 value[1].len--; | |
1009 value[1].data++; | |
1010 | |
1565 | 1011 v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGEABLE); |
599 | 1012 if (v == NULL) { |
1013 return NGX_CONF_ERROR; | |
1014 } | |
1015 | |
1016 pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t)); | |
1017 if (pv == NULL) { | |
1018 return NGX_CONF_ERROR; | |
1019 } | |
1020 | |
1021 index = ngx_http_get_variable_index(cf, &value[1]); | |
1022 if (index == NGX_ERROR) { | |
1023 return NGX_CONF_ERROR; | |
1024 } | |
1025 | |
1026 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
1027 | |
1028 if (pmcf->perl == NULL) { | |
1029 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
1030 return NGX_CONF_ERROR; | |
1031 } | |
1032 } | |
1033 | |
1034 pv->handler = value[2]; | |
1035 | |
1036 { | |
1037 | |
1038 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
1039 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
1040 PERL_SET_INTERP(pmcf->perl); |
599 | 1041 |
1042 ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub); | |
1043 | |
1044 if (pv->sub == &PL_sv_undef) { | |
1045 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
1046 "eval_pv(\"%V\") failed", &value[2]); | |
1047 return NGX_CONF_ERROR; | |
1048 } | |
1049 | |
1050 if (pv->sub == NULL) { | |
1051 pv->sub = newSVpvn((char *) value[2].data, value[2].len); | |
1052 } | |
1053 | |
1054 } | |
1055 | |
637 | 1056 v->get_handler = ngx_http_perl_variable; |
599 | 1057 v->data = (uintptr_t) pv; |
1058 | |
1059 return NGX_CONF_OK; | |
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 |
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 |
1257 | 1063 static ngx_int_t |
1064 ngx_http_perl_init_worker(ngx_cycle_t *cycle) | |
1065 { | |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1066 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
|
1067 |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1068 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
|
1069 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1070 if (pmcf) { |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1071 dTHXa(pmcf->perl); |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1072 PERL_SET_CONTEXT(pmcf->perl); |
6820
eada22643e8b
Perl: added PERL_SET_INTERP().
Maxim Dounin <mdounin@mdounin.ru>
parents:
6791
diff
changeset
|
1073 PERL_SET_INTERP(pmcf->perl); |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1074 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1075 /* set worker's $$ */ |
1257 | 1076 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1077 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
|
1078 } |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1079 |
1257 | 1080 return NGX_OK; |
1081 } | |
1082 | |
1941 | 1083 |
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
|
1084 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
|
1085 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
|
1086 { |
2715 | 1087 #if (NGX_HAVE_PERL_MULTIPLICITY) |
1088 | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1089 /* |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1090 * 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
|
1091 * therefore just set flag here |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1092 */ |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1093 |
2715 | 1094 ngx_perl_term = 1; |
1095 | |
1096 #else | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1097 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1098 if (nginx_stash) { |
2715 | 1099 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term"); |
1100 | |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1101 (void) perl_destruct(perl); |
2715 | 1102 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1103 perl_free(perl); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1104 |
2714
4dd1773990db
fix segfault on exit if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2713
diff
changeset
|
1105 PERL_SYS_TERM(); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1106 } |
2715 | 1107 |
1108 #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
|
1109 } |