Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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