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