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