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