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