Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 585 lines (519 sloc) 15.287 kB
f61f188 @spiritloose Initial commit
authored
1 /*
2 * Copyright 2009 Jiro Nishiguchi <jiro@cpan.org>
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 */
16 #include "httpd.h"
17 #include "http_log.h"
18 #include "http_config.h"
19 #include "http_protocol.h"
20 #include "util_script.h"
21 #include "ap_config.h"
22 #include "ap_mpm.h"
23 #include "apr_strings.h"
24
25 #include "EXTERN.h"
26 #include "perl.h"
27 #include "XSUB.h"
28 #define NEED_eval_pv
29 #define NEED_newRV_noinc
30 #define NEED_sv_2pv_flags
31 #include "ppport.h"
32
33 #ifdef DEBUG
34 #define TRACE(...) ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, NULL, __VA_ARGS__)
35 #endif
36
37 module AP_MODULE_DECLARE_DATA psgi_module;
38
39 typedef struct {
40 char *psgi_app;
41 } psgi_dir_config;
42
e284234 @spiritloose Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
43 static int argc = 0;
44 static char *argv[] = { "", NULL };
45 static char **envp = NULL;
46
f61f188 @spiritloose Initial commit
authored
47 static void server_error(request_rec *r, const char *fmt, ...)
48 {
49 va_list argp;
50 const char *msg;
51 va_start(argp, fmt);
52 msg = apr_pvsprintf(r->pool, fmt, argp);
53 va_end(argp);
54 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "%s", msg);
55 }
56
57 EXTERN_C void xs_init (pTHX);
58
59 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
60
61 XS(ModPSGI_exit);
62 XS(ModPSGI_exit)
63 {
64 dXSARGS;
65 croak("exit");
66 XSRETURN(0);
67 }
68
69 XS(ModPSGI_Input_read);
70 XS(ModPSGI_Input_read)
71 {
72 dXSARGS;
73 SV *self = ST(0);
74 SV *buf = ST(1);
75 request_rec *r = (request_rec *) mg_find(SvRV(self), PERL_MAGIC_ext)->mg_obj;
76 apr_size_t len = SvIV(ST(2));
77 apr_size_t offset = items >= 4 ? SvIV(ST(3)) : 0;
78 apr_status_t rv;
79 apr_bucket_brigade *bb;
80 apr_bucket *bucket;
81 int eos = 0;
82 SV *ret;
83 dXSTARG;
84
85 ret = newSVpv("", 0);
86 bb = apr_brigade_create(r->pool, r->connection->bucket_alloc);
87 rv = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES, APR_BLOCK_READ, len);
88 if (rv != APR_SUCCESS) {
89 ST(0) = &PL_sv_undef;
90 XSRETURN(1);
91 }
92
93 for (bucket = APR_BRIGADE_FIRST(bb);
94 bucket != APR_BRIGADE_SENTINEL(bb);
95 bucket = APR_BUCKET_NEXT(bucket)) {
96 const char *bbuf;
97 apr_size_t blen;
98 if (APR_BUCKET_IS_EOS(bucket)) {
99 eos = 1;
100 break;
101 }
102 if (APR_BUCKET_IS_METADATA(bucket)) {
103 continue;
104 }
105 apr_bucket_read(bucket, &bbuf, &blen, APR_BLOCK_READ);
106 sv_catpvn(ret, bbuf, blen);
107 }
108
109 sv_setsv(buf, ret);
110 ST(0) = sv_2mortal(newSViv(SvCUR(buf)));
111 XSRETURN(1);
112 }
113
114 XS(ModPSGI_Errors_print);
115 XS(ModPSGI_Errors_print)
116 {
117 dXSARGS;
118 SV *self = ST(0);
119 SV *msg = ST(1);
120 dXSTARG;
121 request_rec *r = (request_rec *) mg_find(SvRV(self), PERL_MAGIC_ext)->mg_obj;
122 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "%s", SvPV_nolen(msg));
123 ST(0) = newSViv(1);
124 XSRETURN(1);
125 }
126
127 EXTERN_C void
128 xs_init(pTHX)
129 {
130 char *file = __FILE__;
131 dXSUB_SYS;
132
133 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
134 newXS("ModPSGI::exit", ModPSGI_exit, file);
135 newXSproto("ModPSGI::Input::read", ModPSGI_Input_read, file, "$$$;$");
136 newXSproto("ModPSGI::Errors::print", ModPSGI_Errors_print, file, "$$");
137 }
138
139 static int copy_env(void *rec, const char *key, const char *val)
140 {
fe98cae @spiritloose use dTHX
authored
141 dTHX;
f61f188 @spiritloose Initial commit
authored
142 HV *env = (HV *) rec;
143 hv_store(env, key, strlen(key), newSVpv(val, 0), 0);
144 return 1;
145 }
146
147 static SV *make_env(request_rec *r)
148 {
fe98cae @spiritloose use dTHX
authored
149 dTHX;
f61f188 @spiritloose Initial commit
authored
150 HV *env;
151 AV *version;
152 char *url_scheme;
153 SV *input, *errors;
154
155 env = newHV();
156
157 ap_add_cgi_vars(r);
158 ap_add_common_vars(r);
159 if (apr_table_get(r->subprocess_env, "PATH_INFO") == NULL) {
160 apr_table_set(r->subprocess_env, "PATH_INFO", "");
161 }
162 if (strcmp(apr_table_get(r->subprocess_env, "SCRIPT_NAME"), "/") == 0
163 && strcmp(apr_table_get(r->subprocess_env, "PATH_INFO"), "") == 0) {
164 apr_table_set(r->subprocess_env, "PATH_INFO", "/");
165 apr_table_set(r->subprocess_env, "SCRIPT_NAME", "");
166 }
167 apr_table_do(copy_env, env, r->subprocess_env, NULL);
168
169 version = newAV();
170 av_push(version, newSViv(1));
171 av_push(version, newSViv(0));
172 hv_store(env, "psgi.version", 12, newRV_inc((SV *) version), 0);
173
174 url_scheme = apr_table_get(r->subprocess_env, "HTTPS") == NULL ? "http" : "https";
175 hv_store(env, "psgi.url_scheme", 15, newSVpv(url_scheme, 0), 0);
176
177 input = newRV_noinc(newSV(0));
178 sv_magic(SvRV(input), NULL, PERL_MAGIC_ext, NULL, 0);
179 mg_find(SvRV(input), PERL_MAGIC_ext)->mg_obj = (void *) r;
180 sv_bless(input, gv_stashpv("ModPSGI::Input", 1));
181 hv_store(env, "psgi.input", 10, input, 0);
182
183 errors = newRV_noinc(newSV(0));
184 sv_magic(SvRV(errors), NULL, PERL_MAGIC_ext, NULL, 0);
185 mg_find(SvRV(errors), PERL_MAGIC_ext)->mg_obj = (void *) r;
186 sv_bless(errors, gv_stashpv("ModPSGI::Errors", 1));
187 hv_store(env, "psgi.errors", 11, errors, 0);
188
189 hv_store(env, "psgi.multithread", 16, newSViv(0), 0);
190 hv_store(env, "psgi.multiprocess", 17, newSViv(1), 0);
191 hv_store(env, "psgi.run_once", 13, newSViv(1), 0);
192 hv_store(env, "psgi.async", 10, newSViv(0), 0);
193
194 return newRV_inc((SV *) env);
195 }
196
197 static SV *load_psgi(request_rec *r, const char *file)
198 {
fe98cae @spiritloose use dTHX
authored
199 dTHX;
f61f188 @spiritloose Initial commit
authored
200 SV *app;
201 char *code;
202
203 code = apr_psprintf(r->pool, "do q\"%s\" or die $@",
204 ap_escape_quotes(r->pool, file));
205 app = eval_pv(code, FALSE);
206
207 if (SvTRUE(ERRSV)) {
208 server_error(r, "%s", SvPV_nolen(ERRSV));
209 return NULL;
210 }
211 if (!SvOK(app) || !SvROK(app) || SvTYPE(SvRV(app)) != SVt_PVCV) {
212 server_error(r, "%s does not return an application code reference", file);
213 return NULL;
214 }
215 return app;
216 }
217
218 static SV *run_app(request_rec *r, SV *app, SV *env)
219 {
fe98cae @spiritloose use dTHX
authored
220 dTHX;
f61f188 @spiritloose Initial commit
authored
221 int count;
222 SV *res;
223 dSP;
224 ENTER;
225 SAVETMPS;
226 PUSHMARK(SP) ;
227 XPUSHs(sv_2mortal(env));
228 PUTBACK;
229
230 count = call_sv(app, G_EVAL|G_KEEPERR|G_SCALAR);
231 SPAGAIN;
232 if (SvTRUE(ERRSV)) {
233 res = NULL;
234 server_error(r, "%s", SvPV_nolen(ERRSV));
235 POPs;
236 } else if (count > 0) {
237 res = POPs;
238 SvREFCNT_inc(res);
239 } else {
240 res = NULL;
241 }
242 PUTBACK;
243 FREETMPS;
244 LEAVE;
245 return res;
246 }
247
248 static int output_status(request_rec *r, SV *status)
249 {
fe98cae @spiritloose use dTHX
authored
250 dTHX;
f61f188 @spiritloose Initial commit
authored
251 int s = SvIV(status);
252 if (s < 100) {
253 server_error(r, "invalid response status %d", s);
254 return HTTP_INTERNAL_SERVER_ERROR;
255 }
256 r->status = s;
257 return OK;
258 }
259
260 static int check_header_value(const char *value)
261 {
262 int i;
263 int len = strlen(value);
264 for (i = 0; i < len; i++) {
265 if (value[i] < 37) {
266 return 1;
267 }
268 }
269 return 0;
270 }
271
272 static int output_headers(request_rec *r, AV *headers)
273 {
fe98cae @spiritloose use dTHX
authored
274 dTHX;
f61f188 @spiritloose Initial commit
authored
275 SV *key_sv, *val_sv;
276 char *key, *val;
277 while (av_len(headers) > -1) {
278 key_sv = av_shift(headers);
279 val_sv = av_shift(headers);
280 if (key_sv == NULL || val_sv == NULL) break;
281 key = SvPV_nolen(key_sv);
282 val = SvPV_nolen(val_sv);
283 if (check_header_value(val) != 0) {
284 server_error(r, "value string must not contain characters below chr(37)");
285 return HTTP_INTERNAL_SERVER_ERROR;
286 } else if (strcmp(key, "Content-Type") == 0) {
287 r->content_type = apr_pstrdup(r->pool, val);
288 } else if (strcmp(key, "Status") == 0) {
289 server_error(r, "headers must not contain a Status");
290 return HTTP_INTERNAL_SERVER_ERROR;
291 } else {
292 apr_table_add(r->headers_out, key, val);
293 }
294 }
295 return OK;
296 }
297
298 static int respond_to(SV *obj, const char *method)
299 {
fe98cae @spiritloose use dTHX
authored
300 dTHX;
f61f188 @spiritloose Initial commit
authored
301 int res;
302 dSP;
303 ENTER;
304 SAVETMPS;
305 PUSHMARK(SP);
306 XPUSHs(obj);
307 XPUSHs(sv_2mortal(newSVpv(method, 0)));
308 PUTBACK;
309
310 call_method("can", G_SCALAR);
311 SPAGAIN;
312 res = SvROK(POPs);
313 PUTBACK;
314 FREETMPS;
315 LEAVE;
316 return res;
317 }
318
319 static void set_content_length(request_rec *r, apr_off_t length)
320 {
321 if (apr_table_get(r->headers_out, "Content-Length") == NULL) {
322 apr_table_add(r->headers_out, "Content-Length", apr_off_t_toa(r->pool, length));
323 }
324 }
325
326 static int output_body_ary(request_rec *r, AV *bodys)
327 {
fe98cae @spiritloose use dTHX
authored
328 dTHX;
f61f188 @spiritloose Initial commit
authored
329 SV **body;
330 I32 i;
331 I32 lastidx;
332 char *buf;
333 STRLEN len;
334 apr_off_t clen;
335
336 lastidx = av_len(bodys);
337 for (i = 0; i <= lastidx; i++) {
338 body = av_fetch(bodys, i, 0);
339 if (SvOK(*body)) {
340 buf = SvPV(*body, len);
341 ap_rwrite(buf, len, r);
342 clen += len;
343 }
344 }
345 set_content_length(r, clen);
346 return OK;
347 }
348
349 static int output_body_obj(request_rec *r, SV *obj, int type)
350 {
fe98cae @spiritloose use dTHX
authored
351 dTHX;
f61f188 @spiritloose Initial commit
authored
352 SV *buf_sv, *rs;
353 apr_off_t clen = 0;
354 STRLEN len;
355 char *buf;
356 int count;
357
358 if (type == SVt_PVMG && !respond_to(obj, "getline")) {
359 server_error(r, "response body object must be able to getline");
360 return HTTP_INTERNAL_SERVER_ERROR;
361 }
362
363 dSP;
364 ENTER;
365 SAVETMPS;
366 SAVESPTR(PL_rs);
367 PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE));
368 while (1) {
369 PUSHMARK(SP);
370 XPUSHs(obj);
371 PUTBACK;
372 count = call_method("getline", G_SCALAR);
373 if (count != 1) croak("Big trouble\n");
374 SPAGAIN;
375 buf_sv = POPs;
376 if (SvOK(buf_sv)) {
377 buf = SvPV(buf_sv, len);
378 clen += len;
379 ap_rwrite(buf, len, r);
380 } else {
381 break;
382 }
383 }
384 set_content_length(r, len);
385 PUSHMARK(SP);
386 XPUSHs(obj);
387 PUTBACK;
388 call_method("close", G_DISCARD);
389 SPAGAIN;
390 PUTBACK;
391 FREETMPS;
392 LEAVE;
393 return OK;
394 }
395
396 static int output_body(request_rec *r, SV *body)
397 {
fe98cae @spiritloose use dTHX
authored
398 dTHX;
f61f188 @spiritloose Initial commit
authored
399 int rc, type;
400 switch (type = SvTYPE(SvRV(body))) {
401 case SVt_PVAV:
402 rc = output_body_ary(r, (AV *) SvRV(body));
403 break;
404 case SVt_PVGV:
405 require_pv("IO/Handle.pm");
406 case SVt_PVMG:
407 rc = output_body_obj(r, body, type);
408 break;
409 default:
410 server_error(r, "response body must be an array reference or object");
411 rc = HTTP_INTERNAL_SERVER_ERROR;
412 break;
413 }
414 return rc;
415 }
416
417 static int output_response(request_rec *r, SV *res)
418 {
fe98cae @spiritloose use dTHX
authored
419 dTHX;
f61f188 @spiritloose Initial commit
authored
420 AV *res_av;
421 SV **status;
422 SV **headers;
423 AV *headers_av;
424 SV **body;
425 int rc;
426
427 if (!SvROK(res) || SvTYPE(SvRV(res)) != SVt_PVAV) {
428 server_error(r, "response must be an array reference");
429 return HTTP_INTERNAL_SERVER_ERROR;
430 }
431 res_av = (AV *) SvRV(res);
432 if (av_len(res_av) != 2) {
433 server_error(r, "response must have 3 elements");
434 return HTTP_INTERNAL_SERVER_ERROR;
435 }
436
437 status = av_fetch(res_av, 0, 0);
438 if (!SvOK(*status)) {
439 server_error(r, "response status must be a scalar value");
440 return HTTP_INTERNAL_SERVER_ERROR;
441 }
442 rc = output_status(r, *status);
443 if (rc != OK) return rc;
444
445 headers = av_fetch(res_av, 1, 0);
446 if (!SvROK(*headers) || SvTYPE(SvRV(*headers)) != SVt_PVAV) {
447 server_error(r, "response headers must be an array reference");
448 return HTTP_INTERNAL_SERVER_ERROR;
449 }
450 headers_av = (AV *) SvRV(*headers);
451 if ((av_len(headers_av) + 1) % 2 != 0) {
452 server_error(r, "num of response headers must be even");
453 return HTTP_INTERNAL_SERVER_ERROR;
454 }
455 rc = output_headers(r, headers_av);
456 if (rc != OK) return rc;
457
458 body = av_fetch(res_av, 2, 0);
459 if (!SvROK(*body)) {
460 server_error(r, "response body must be a reference");
461 return HTTP_INTERNAL_SERVER_ERROR;
462 }
463 rc = output_body(r, *body);
464
465 return rc;
466 }
467
468 static void init_perl_variables(request_rec *r)
469 {
fe98cae @spiritloose use dTHX
authored
470 dTHX;
f61f188 @spiritloose Initial commit
authored
471 GV *exit_gv = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
472 GvCV(exit_gv) = get_cv("ModPSGI::exit", TRUE);
473 GvIMPORTED_CV_on(exit_gv);
474 sv_setpv_mg(get_sv("0", FALSE), r->server->process->argv[0]);
475 hv_store(GvHV(PL_envgv), "MOD_PSGI", 8, newSVpv(MOD_PSGI_VERSION, 0), 0);
476 }
477
4e00d63 @spiritloose init and destroy in handler
authored
478 static int psgi_handler(request_rec *r)
f61f188 @spiritloose Initial commit
authored
479 {
480 SV *app, *env, *res;
4e00d63 @spiritloose init and destroy in handler
authored
481 PerlInterpreter *my_perl;
f61f188 @spiritloose Initial commit
authored
482 psgi_dir_config *c;
483 int rc;
484
485 if (strcmp(r->handler, "psgi")) {
486 return DECLINED;
487 }
488
489 c = (psgi_dir_config *) ap_get_module_config(r->per_dir_config, &psgi_module);
490
491 if (c->psgi_app == NULL) {
492 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, r->server,
493 "PSGIApp not configured");
494 return DECLINED;
495 }
496
4e00d63 @spiritloose init and destroy in handler
authored
497 my_perl = perl_alloc();
498 PL_perl_destruct_level = 1;
499 perl_construct(my_perl);
500 perl_parse(my_perl, xs_init, argc, argv, envp);
501 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
502 perl_run(my_perl);
503 init_perl_variables(r);
504
f61f188 @spiritloose Initial commit
authored
505 app = load_psgi(r, c->psgi_app);
506 if (app == NULL) {
507 rc = HTTP_INTERNAL_SERVER_ERROR;
508 goto exit;
509 }
510 env = make_env(r);
511 res = run_app(r, app, env);
512 if (res == NULL) {
513 server_error(r, "invalid response");
514 rc = HTTP_INTERNAL_SERVER_ERROR;
515 goto exit;
516 }
517 rc = output_response(r, res);
518 goto exit;
519 exit:
4e00d63 @spiritloose init and destroy in handler
authored
520 PL_perl_destruct_level = 1;
521 perl_destruct(my_perl);
522 perl_free(my_perl);
f61f188 @spiritloose Initial commit
authored
523 return rc;
524 }
525
526 static int supported_mpm()
527 {
528 int result;
529 ap_mpm_query(AP_MPMQ_IS_FORKED, &result);
530 return result;
531 }
532
e284234 @spiritloose Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
533 static apr_status_t psgi_child_exit(void *p)
534 {
535 PERL_SYS_TERM();
536 return OK;
537 }
538
539 static void psgi_child_init(apr_pool_t *p, server_rec *s)
540 {
541 PERL_SYS_INIT3(&argc, (char ***) argv, &envp);
542 apr_pool_cleanup_register(p, NULL, psgi_child_exit, psgi_child_exit);
543 }
544
f61f188 @spiritloose Initial commit
authored
545 static void psgi_register_hooks(apr_pool_t *p)
546 {
547 if (supported_mpm()) {
548 ap_hook_handler(psgi_handler, NULL, NULL, APR_HOOK_MIDDLE);
e284234 @spiritloose Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
549 ap_hook_child_init(psgi_child_init, NULL, NULL, APR_HOOK_MIDDLE);
f61f188 @spiritloose Initial commit
authored
550 } else {
551 server_error(NULL, "mod_psgi only supports prefork mpm");
552 }
553 }
554
555 static void *create_dir_config(apr_pool_t *p, char *path)
556 {
557 psgi_dir_config *c = apr_pcalloc(p, sizeof(psgi_dir_config));
558 c->psgi_app = NULL;
559 return (void *) c;
560 }
561
562 static const char *cmd_psgi_app(cmd_parms *cmd, void *conf, const char *v)
563 {
564 psgi_dir_config *c = (psgi_dir_config *) conf;
565 c->psgi_app = (char *) apr_pstrdup(cmd->pool, v);
566 return NULL;
567 }
568
569 static const command_rec command_table[] = {
570 AP_INIT_TAKE1("PSGIApp", cmd_psgi_app, NULL,
b991f34 @spiritloose Allow PSGIApp in .htaccess
authored
571 OR_LIMIT, "set PSGI application"),
f61f188 @spiritloose Initial commit
authored
572 { NULL }
573 };
574
575 module AP_MODULE_DECLARE_DATA psgi_module = {
576 STANDARD20_MODULE_STUFF,
577 create_dir_config, /* create per-dir config structures */
578 NULL, /* merge per-dir config structures */
579 NULL, /* create per-server config structures */
580 NULL, /* merge per-server config structures */
581 command_table, /* table of config file commands */
582 psgi_register_hooks /* register hooks */
583 };
584
Something went wrong with that request. Please try again.