Mercurial > hg > nginx
annotate src/http/modules/perl/ngx_http_perl_module.c @ 6791:cb4a4e9bba8e
Perl: fixed optimization in SSI command handler.
As the pointer to the first argument was tested instead of the argument
itself, array of arguments was always created, even if there were no
arguments. Fix is to test args[0] instead of args.
Found by Coverity (CID 1356862).
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Tue, 01 Nov 2016 20:39:21 +0300 |
parents | 0570e42ffeed |
children | eada22643e8b |
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 |
6791
cb4a4e9bba8e
Perl: fixed optimization in SSI command handler.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5800
diff
changeset
|
413 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
|
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 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
424 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
|
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++) { | |
5330
314c3d7cc3a5
Backed out f1a91825730a and 7094bd12c1ff.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5317
diff
changeset
|
488 if (ngx_conf_full_name(cf->cycle, &m[i], 0) != NGX_OK) { |
3175 | 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 | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
580 embedding = ngx_palloc(cf->pool, (5 + n) * sizeof(char *)); |
3175 | 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"; | |
5800
0570e42ffeed
Perl: NULL-terminate argument list.
Piotr Sikora <piotr@cloudflare.com>
parents:
5362
diff
changeset
|
598 embedding[n] = NULL; |
599 | 599 |
600 n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL); | |
601 | |
602 if (n != 0) { | |
1069 | 603 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_parse() failed: %d", n); |
599 | 604 goto fail; |
605 } | |
606 | |
775 | 607 sv = get_sv("nginx::VERSION", FALSE); |
608 ver = SvPV(sv, len); | |
609 | |
610 if (ngx_strcmp(ver, NGINX_VERSION) != 0) { | |
1069 | 611 ngx_log_error(NGX_LOG_ALERT, cf->log, 0, |
775 | 612 "version " NGINX_VERSION " of nginx.pm is required, " |
613 "but %s was found", ver); | |
614 goto fail; | |
615 } | |
616 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
617 if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) != NGX_OK) { |
649 | 618 goto fail; |
599 | 619 } |
620 | |
621 } | |
622 | |
623 return perl; | |
624 | |
625 fail: | |
626 | |
627 (void) perl_destruct(perl); | |
628 | |
629 perl_free(perl); | |
630 | |
631 return NULL; | |
632 } | |
633 | |
634 | |
649 | 635 static ngx_int_t |
653 | 636 ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log) |
649 | 637 { |
3173 | 638 u_char *err; |
649 | 639 STRLEN len; |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
640 ngx_str_t *script; |
649 | 641 ngx_uint_t i; |
642 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
643 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
|
644 return NGX_OK; |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
645 } |
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
646 |
649 | 647 script = requires->elts; |
648 for (i = 0; i < requires->nelts; i++) { | |
649 | |
3174
479fd46cd1c4
use ngx_conf_set_str_array_slot() for perl_require
Igor Sysoev <igor@sysoev.ru>
parents:
3173
diff
changeset
|
650 require_pv((char *) script[i].data); |
649 | 651 |
652 if (SvTRUE(ERRSV)) { | |
653 | |
3173 | 654 err = (u_char *) SvPV(ERRSV, len); |
655 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
649 | 656 |
657 ngx_log_error(NGX_LOG_EMERG, log, 0, | |
3173 | 658 "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
|
659 script[i].data, len + 1, err); |
649 | 660 |
661 return NGX_ERROR; | |
662 } | |
663 } | |
664 | |
665 return NGX_OK; | |
666 } | |
667 | |
668 | |
599 | 669 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
|
670 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
|
671 SV **args, ngx_str_t *handler, ngx_str_t *rv) |
599 | 672 { |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
673 SV *sv; |
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
674 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
|
675 char *line; |
3173 | 676 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
|
677 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
|
678 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
|
679 ngx_connection_t *c; |
599 | 680 |
681 dSP; | |
682 | |
683 status = 0; | |
684 | |
685 ENTER; | |
686 SAVETMPS; | |
687 | |
688 PUSHMARK(sp); | |
689 | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
690 sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(r))), nginx)); |
599 | 691 XPUSHs(sv); |
692 | |
693 if (args) { | |
1940
6a4c74bea81c
fix building on 64-bit platforms broken in r1900
Igor Sysoev <igor@sysoev.ru>
parents:
1899
diff
changeset
|
694 EXTEND(sp, (intptr_t) args[0]); |
599 | 695 |
5362
79b9101cecf4
Handling of ngx_int_t != intptr_t case.
Maxim Dounin <mdounin@mdounin.ru>
parents:
5330
diff
changeset
|
696 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
|
697 PUSHs(sv_2mortal(args[i])); |
599 | 698 } |
699 } | |
700 | |
701 PUTBACK; | |
702 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
703 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
|
704 |
599 | 705 n = call_sv(sub, G_EVAL); |
706 | |
707 SPAGAIN; | |
708 | |
709 if (n) { | |
710 if (rv == NULL) { | |
711 status = POPi; | |
712 | |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
713 ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0, |
599 | 714 "call_sv: %d", status); |
715 | |
716 } else { | |
619 | 717 line = SvPVx(POPs, n_a); |
599 | 718 rv->len = n_a; |
719 | |
2049 | 720 rv->data = ngx_pnalloc(r->pool, n_a); |
599 | 721 if (rv->data == NULL) { |
722 return NGX_ERROR; | |
723 } | |
724 | |
725 ngx_memcpy(rv->data, line, n_a); | |
726 } | |
727 } | |
728 | |
729 PUTBACK; | |
730 | |
731 FREETMPS; | |
732 LEAVE; | |
733 | |
734 /* check $@ */ | |
735 | |
736 if (SvTRUE(ERRSV)) { | |
737 | |
3173 | 738 err = (u_char *) SvPV(ERRSV, len); |
739 while (--len && (err[len] == CR || err[len] == LF)) { /* void */ } | |
599 | 740 |
1702
86bb52e28ce0
fix segfault when $r->has_request_body() is called with ready body
Igor Sysoev <igor@sysoev.ru>
parents:
1565
diff
changeset
|
741 ngx_log_error(NGX_LOG_ERR, c->log, 0, |
3173 | 742 "call_sv(\"%V\") failed: \"%*s\"", handler, len + 1, err); |
599 | 743 |
744 if (rv) { | |
745 return NGX_ERROR; | |
746 } | |
747 | |
748 return NGX_HTTP_INTERNAL_SERVER_ERROR; | |
749 } | |
750 | |
751 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
|
752 ngx_log_error(NGX_LOG_ALERT, c->log, 0, |
599 | 753 "call_sv(\"%V\") returned %d results", handler, n); |
754 status = NGX_OK; | |
755 } | |
756 | |
757 if (rv) { | |
758 return NGX_OK; | |
759 } | |
760 | |
761 return (ngx_int_t) status; | |
762 } | |
763 | |
764 | |
765 static void | |
766 ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv) | |
767 { | |
623 | 768 u_char *p; |
769 | |
770 for (p = handler->data; *p; p++) { | |
771 if (*p != ' ' && *p != '\t' && *p != CR && *p != LF) { | |
772 break; | |
773 } | |
774 } | |
775 | |
3132 | 776 if (ngx_strncmp(p, "sub ", 4) == 0 |
777 || ngx_strncmp(p, "sub{", 4) == 0 | |
778 || ngx_strncmp(p, "use ", 4) == 0) | |
779 { | |
623 | 780 *sv = eval_pv((char *) p, FALSE); |
874 | 781 |
782 /* eval_pv() does not set ERRSV on failure */ | |
783 | |
599 | 784 return; |
785 } | |
786 | |
787 *sv = NULL; | |
788 } | |
789 | |
790 | |
791 static void * | |
792 ngx_http_perl_create_main_conf(ngx_conf_t *cf) | |
793 { | |
794 ngx_http_perl_main_conf_t *pmcf; | |
795 | |
796 pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t)); | |
797 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
|
798 return NULL; |
599 | 799 } |
800 | |
3175 | 801 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
|
802 pmcf->requires = NGX_CONF_UNSET_PTR; |
599 | 803 |
804 return pmcf; | |
805 } | |
806 | |
807 | |
808 static char * | |
809 ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf) | |
810 { | |
811 ngx_http_perl_main_conf_t *pmcf = conf; | |
812 | |
813 if (pmcf->perl == NULL) { | |
814 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
815 return NGX_CONF_ERROR; | |
816 } | |
817 } | |
818 | |
819 return NGX_CONF_OK; | |
820 } | |
821 | |
822 | |
872
1c4a5b3f9110
Axe several perl interpreter instances: they may be useful in currently
Igor Sysoev <igor@sysoev.ru>
parents:
871
diff
changeset
|
823 #if (NGX_HAVE_PERL_MULTIPLICITY) |
649 | 824 |
599 | 825 static void |
826 ngx_http_perl_cleanup_perl(void *data) | |
827 { | |
649 | 828 PerlInterpreter *perl = data; |
599 | 829 |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
830 PERL_SET_CONTEXT(perl); |
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
831 |
599 | 832 (void) perl_destruct(perl); |
833 | |
834 perl_free(perl); | |
2715 | 835 |
836 if (ngx_perl_term) { | |
837 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term"); | |
838 | |
839 PERL_SYS_TERM(); | |
840 } | |
599 | 841 } |
842 | |
649 | 843 #endif |
844 | |
845 | |
599 | 846 static ngx_int_t |
847 ngx_http_perl_preconfiguration(ngx_conf_t *cf) | |
848 { | |
617 | 849 #if (NGX_HTTP_SSI) |
599 | 850 ngx_int_t rc; |
851 ngx_http_ssi_main_conf_t *smcf; | |
852 | |
853 smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module); | |
854 | |
855 rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name, | |
856 &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY); | |
857 | |
858 if (rc != NGX_OK) { | |
859 if (rc == NGX_BUSY) { | |
860 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
861 "conflicting SSI command \"%V\"", | |
862 &ngx_http_perl_ssi_command.name); | |
863 } | |
864 | |
865 return NGX_ERROR; | |
866 } | |
617 | 867 #endif |
599 | 868 |
869 return NGX_OK; | |
870 } | |
871 | |
872 | |
873 static void * | |
874 ngx_http_perl_create_loc_conf(ngx_conf_t *cf) | |
875 { | |
876 ngx_http_perl_loc_conf_t *plcf; | |
877 | |
878 plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t)); | |
879 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
|
880 return NULL; |
599 | 881 } |
882 | |
883 /* | |
884 * set by ngx_pcalloc(): | |
885 * | |
886 * plcf->handler = { 0, NULL }; | |
887 */ | |
888 | |
889 return plcf; | |
890 } | |
891 | |
892 | |
893 static char * | |
894 ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child) | |
895 { | |
896 ngx_http_perl_loc_conf_t *prev = parent; | |
897 ngx_http_perl_loc_conf_t *conf = child; | |
898 | |
899 if (conf->sub == NULL) { | |
900 conf->sub = prev->sub; | |
901 conf->handler = prev->handler; | |
902 } | |
903 | |
904 return NGX_CONF_OK; | |
905 } | |
906 | |
907 | |
908 static char * | |
909 ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
910 { | |
911 ngx_http_perl_loc_conf_t *plcf = conf; | |
912 | |
913 ngx_str_t *value; | |
914 ngx_http_core_loc_conf_t *clcf; | |
915 ngx_http_perl_main_conf_t *pmcf; | |
916 | |
917 value = cf->args->elts; | |
918 | |
919 if (plcf->handler.data) { | |
920 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, | |
921 "duplicate perl handler \"%V\"", &value[1]); | |
922 return NGX_CONF_ERROR; | |
923 } | |
924 | |
925 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
926 | |
927 if (pmcf->perl == NULL) { | |
928 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
929 return NGX_CONF_ERROR; | |
930 } | |
931 } | |
932 | |
933 plcf->handler = value[1]; | |
934 | |
935 { | |
936 | |
937 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
938 PERL_SET_CONTEXT(pmcf->perl); |
599 | 939 |
940 ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub); | |
941 | |
942 if (plcf->sub == &PL_sv_undef) { | |
943 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
944 "eval_pv(\"%V\") failed", &value[1]); | |
945 return NGX_CONF_ERROR; | |
946 } | |
947 | |
948 if (plcf->sub == NULL) { | |
949 plcf->sub = newSVpvn((char *) value[1].data, value[1].len); | |
950 } | |
951 | |
952 } | |
953 | |
954 clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module); | |
955 clcf->handler = ngx_http_perl_handler; | |
956 | |
957 return NGX_CONF_OK; | |
958 } | |
959 | |
960 | |
961 static char * | |
962 ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf) | |
963 { | |
964 ngx_int_t index; | |
965 ngx_str_t *value; | |
966 ngx_http_variable_t *v; | |
967 ngx_http_perl_variable_t *pv; | |
968 ngx_http_perl_main_conf_t *pmcf; | |
969 | |
970 value = cf->args->elts; | |
971 | |
4972
8b635cf36ccc
Added checks that disallow adding a variable with an empty name.
Ruslan Ermilov <ru@nginx.com>
parents:
4963
diff
changeset
|
972 if (value[1].data[0] != '$') { |
599 | 973 ngx_conf_log_error(NGX_LOG_EMERG, cf, 0, |
974 "invalid variable name \"%V\"", &value[1]); | |
975 return NGX_CONF_ERROR; | |
976 } | |
977 | |
978 value[1].len--; | |
979 value[1].data++; | |
980 | |
1565 | 981 v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGEABLE); |
599 | 982 if (v == NULL) { |
983 return NGX_CONF_ERROR; | |
984 } | |
985 | |
986 pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t)); | |
987 if (pv == NULL) { | |
988 return NGX_CONF_ERROR; | |
989 } | |
990 | |
991 index = ngx_http_get_variable_index(cf, &value[1]); | |
992 if (index == NGX_ERROR) { | |
993 return NGX_CONF_ERROR; | |
994 } | |
995 | |
996 pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module); | |
997 | |
998 if (pmcf->perl == NULL) { | |
999 if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) { | |
1000 return NGX_CONF_ERROR; | |
1001 } | |
1002 } | |
1003 | |
1004 pv->handler = value[2]; | |
1005 | |
1006 { | |
1007 | |
1008 dTHXa(pmcf->perl); | |
873
f92ad15c2db1
fix segfaults in future workers those will use old configuration,
Igor Sysoev <igor@sysoev.ru>
parents:
872
diff
changeset
|
1009 PERL_SET_CONTEXT(pmcf->perl); |
599 | 1010 |
1011 ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub); | |
1012 | |
1013 if (pv->sub == &PL_sv_undef) { | |
1014 ngx_conf_log_error(NGX_LOG_ERR, cf, 0, | |
1015 "eval_pv(\"%V\") failed", &value[2]); | |
1016 return NGX_CONF_ERROR; | |
1017 } | |
1018 | |
1019 if (pv->sub == NULL) { | |
1020 pv->sub = newSVpvn((char *) value[2].data, value[2].len); | |
1021 } | |
1022 | |
1023 } | |
1024 | |
637 | 1025 v->get_handler = ngx_http_perl_variable; |
599 | 1026 v->data = (uintptr_t) pv; |
1027 | |
1028 return NGX_CONF_OK; | |
1029 } | |
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
|
1030 |
aa653367028e
PERL_SYS_TERM() should be called once on exit only, this fixes the message
Igor Sysoev <igor@sysoev.ru>
parents:
1165
diff
changeset
|
1031 |
1257 | 1032 static ngx_int_t |
1033 ngx_http_perl_init_worker(ngx_cycle_t *cycle) | |
1034 { | |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1035 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
|
1036 |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1037 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
|
1038 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1039 if (pmcf) { |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1040 dTHXa(pmcf->perl); |
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1041 PERL_SET_CONTEXT(pmcf->perl); |
1258
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1042 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1043 /* set worker's $$ */ |
1257 | 1044 |
2713
b4d8aef4a1ad
fix segfault if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2388
diff
changeset
|
1045 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
|
1046 } |
5076d97b9cf0
fix building on threaded or multiplicity interpreter perl,
Igor Sysoev <igor@sysoev.ru>
parents:
1257
diff
changeset
|
1047 |
1257 | 1048 return NGX_OK; |
1049 } | |
1050 | |
1941 | 1051 |
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
|
1052 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
|
1053 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
|
1054 { |
2715 | 1055 #if (NGX_HAVE_PERL_MULTIPLICITY) |
1056 | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1057 /* |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1058 * 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
|
1059 * therefore just set flag here |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1060 */ |
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1061 |
2715 | 1062 ngx_perl_term = 1; |
1063 | |
1064 #else | |
3351
b759cf8f6000
add comment from r2716 commit message
Igor Sysoev <igor@sysoev.ru>
parents:
3350
diff
changeset
|
1065 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1066 if (nginx_stash) { |
2715 | 1067 ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term"); |
1068 | |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1069 (void) perl_destruct(perl); |
2715 | 1070 |
3350
67da53a19e02
use global perl variable in perl_destruct()/perl_free()
Igor Sysoev <igor@sysoev.ru>
parents:
3175
diff
changeset
|
1071 perl_free(perl); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1072 |
2714
4dd1773990db
fix segfault on exit if no http section is defined in confguraiton,
Igor Sysoev <igor@sysoev.ru>
parents:
2713
diff
changeset
|
1073 PERL_SYS_TERM(); |
1946
171a283af56b
some perl builds require my_perl for PERL_SYS_TERM()
Igor Sysoev <igor@sysoev.ru>
parents:
1941
diff
changeset
|
1074 } |
2715 | 1075 |
1076 #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
|
1077 } |