Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 586 lines (522 sloc) 15.264 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 #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 {
fe98cae @spiritloose use dTHX
authored
138 dTHX;
f61f188 @spiritloose Initial commit
authored
139 HV *env = (HV *) rec;
140 hv_store(env, key, strlen(key), newSVpv(val, 0), 0);
141 return 1;
142 }
143
144 static SV *make_env(request_rec *r)
145 {
fe98cae @spiritloose use dTHX
authored
146 dTHX;
f61f188 @spiritloose Initial commit
authored
147 HV *env;
148 AV *version;
149 char *url_scheme;
150 SV *input, *errors;
151
152 env = newHV();
153
154 ap_add_cgi_vars(r);
155 ap_add_common_vars(r);
156 if (apr_table_get(r->subprocess_env, "PATH_INFO") == NULL) {
157 apr_table_set(r->subprocess_env, "PATH_INFO", "");
158 }
159 if (strcmp(apr_table_get(r->subprocess_env, "SCRIPT_NAME"), "/") == 0
160 && strcmp(apr_table_get(r->subprocess_env, "PATH_INFO"), "") == 0) {
161 apr_table_set(r->subprocess_env, "PATH_INFO", "/");
162 apr_table_set(r->subprocess_env, "SCRIPT_NAME", "");
163 }
164 apr_table_do(copy_env, env, r->subprocess_env, NULL);
165
166 version = newAV();
167 av_push(version, newSViv(1));
168 av_push(version, newSViv(0));
169 hv_store(env, "psgi.version", 12, newRV_inc((SV *) version), 0);
170
171 url_scheme = apr_table_get(r->subprocess_env, "HTTPS") == NULL ? "http" : "https";
172 hv_store(env, "psgi.url_scheme", 15, newSVpv(url_scheme, 0), 0);
173
174 input = newRV_noinc(newSV(0));
175 sv_magic(SvRV(input), NULL, PERL_MAGIC_ext, NULL, 0);
176 mg_find(SvRV(input), PERL_MAGIC_ext)->mg_obj = (void *) r;
177 sv_bless(input, gv_stashpv("ModPSGI::Input", 1));
178 hv_store(env, "psgi.input", 10, input, 0);
179
180 errors = newRV_noinc(newSV(0));
181 sv_magic(SvRV(errors), NULL, PERL_MAGIC_ext, NULL, 0);
182 mg_find(SvRV(errors), PERL_MAGIC_ext)->mg_obj = (void *) r;
183 sv_bless(errors, gv_stashpv("ModPSGI::Errors", 1));
184 hv_store(env, "psgi.errors", 11, errors, 0);
185
186 hv_store(env, "psgi.multithread", 16, newSViv(0), 0);
187 hv_store(env, "psgi.multiprocess", 17, newSViv(1), 0);
188 hv_store(env, "psgi.run_once", 13, newSViv(1), 0);
189 hv_store(env, "psgi.async", 10, newSViv(0), 0);
190
191 return newRV_inc((SV *) env);
192 }
193
194 static SV *load_psgi(request_rec *r, const char *file)
195 {
fe98cae @spiritloose use dTHX
authored
196 dTHX;
f61f188 @spiritloose Initial commit
authored
197 SV *app;
198 char *code;
199
200 code = apr_psprintf(r->pool, "do q\"%s\" or die $@",
201 ap_escape_quotes(r->pool, file));
202 app = eval_pv(code, FALSE);
203
204 if (SvTRUE(ERRSV)) {
205 server_error(r, "%s", SvPV_nolen(ERRSV));
206 return NULL;
207 }
208 if (!SvOK(app) || !SvROK(app) || SvTYPE(SvRV(app)) != SVt_PVCV) {
209 server_error(r, "%s does not return an application code reference", file);
210 return NULL;
211 }
212 return app;
213 }
214
215 static SV *run_app(request_rec *r, SV *app, SV *env)
216 {
fe98cae @spiritloose use dTHX
authored
217 dTHX;
f61f188 @spiritloose Initial commit
authored
218 int count;
219 SV *res;
220 dSP;
221 ENTER;
222 SAVETMPS;
223 PUSHMARK(SP) ;
224 XPUSHs(sv_2mortal(env));
225 PUTBACK;
226
227 count = call_sv(app, G_EVAL|G_KEEPERR|G_SCALAR);
228 SPAGAIN;
229 if (SvTRUE(ERRSV)) {
230 res = NULL;
231 server_error(r, "%s", SvPV_nolen(ERRSV));
232 POPs;
233 } else if (count > 0) {
234 res = POPs;
235 SvREFCNT_inc(res);
236 } else {
237 res = NULL;
238 }
239 PUTBACK;
240 FREETMPS;
241 LEAVE;
242 return res;
243 }
244
245 static int output_status(request_rec *r, SV *status)
246 {
fe98cae @spiritloose use dTHX
authored
247 dTHX;
f61f188 @spiritloose Initial commit
authored
248 int s = SvIV(status);
249 if (s < 100) {
250 server_error(r, "invalid response status %d", s);
251 return HTTP_INTERNAL_SERVER_ERROR;
252 }
253 r->status = s;
254 return OK;
255 }
256
257 static int check_header_value(const char *value)
258 {
259 int i;
260 int len = strlen(value);
261 for (i = 0; i < len; i++) {
262 if (value[i] < 37) {
263 return 1;
264 }
265 }
266 return 0;
267 }
268
269 static int output_headers(request_rec *r, AV *headers)
270 {
fe98cae @spiritloose use dTHX
authored
271 dTHX;
f61f188 @spiritloose Initial commit
authored
272 SV *key_sv, *val_sv;
273 char *key, *val;
274 while (av_len(headers) > -1) {
275 key_sv = av_shift(headers);
276 val_sv = av_shift(headers);
277 if (key_sv == NULL || val_sv == NULL) break;
278 key = SvPV_nolen(key_sv);
279 val = SvPV_nolen(val_sv);
280 if (check_header_value(val) != 0) {
281 server_error(r, "value string must not contain characters below chr(37)");
282 return HTTP_INTERNAL_SERVER_ERROR;
283 } else if (strcmp(key, "Content-Type") == 0) {
284 r->content_type = apr_pstrdup(r->pool, val);
285 } else if (strcmp(key, "Status") == 0) {
286 server_error(r, "headers must not contain a Status");
287 return HTTP_INTERNAL_SERVER_ERROR;
288 } else {
289 apr_table_add(r->headers_out, key, val);
290 }
291 }
292 return OK;
293 }
294
295 static int respond_to(SV *obj, const char *method)
296 {
fe98cae @spiritloose use dTHX
authored
297 dTHX;
f61f188 @spiritloose Initial commit
authored
298 int res;
299 dSP;
300 ENTER;
301 SAVETMPS;
302 PUSHMARK(SP);
303 XPUSHs(obj);
304 XPUSHs(sv_2mortal(newSVpv(method, 0)));
305 PUTBACK;
306
307 call_method("can", G_SCALAR);
308 SPAGAIN;
309 res = SvROK(POPs);
310 PUTBACK;
311 FREETMPS;
312 LEAVE;
313 return res;
314 }
315
316 static void set_content_length(request_rec *r, apr_off_t length)
317 {
318 if (apr_table_get(r->headers_out, "Content-Length") == NULL) {
319 apr_table_add(r->headers_out, "Content-Length", apr_off_t_toa(r->pool, length));
320 }
321 }
322
323 static int output_body_ary(request_rec *r, AV *bodys)
324 {
fe98cae @spiritloose use dTHX
authored
325 dTHX;
f61f188 @spiritloose Initial commit
authored
326 SV **body;
327 I32 i;
328 I32 lastidx;
329 char *buf;
330 STRLEN len;
331 apr_off_t clen;
332
333 lastidx = av_len(bodys);
334 for (i = 0; i <= lastidx; i++) {
335 body = av_fetch(bodys, i, 0);
336 if (SvOK(*body)) {
337 buf = SvPV(*body, len);
338 ap_rwrite(buf, len, r);
339 clen += len;
340 }
341 }
342 set_content_length(r, clen);
343 return OK;
344 }
345
346 static int output_body_obj(request_rec *r, SV *obj, int type)
347 {
fe98cae @spiritloose use dTHX
authored
348 dTHX;
f61f188 @spiritloose Initial commit
authored
349 SV *buf_sv, *rs;
350 apr_off_t clen = 0;
351 STRLEN len;
352 char *buf;
353 int count;
354
355 if (type == SVt_PVMG && !respond_to(obj, "getline")) {
356 server_error(r, "response body object must be able to getline");
357 return HTTP_INTERNAL_SERVER_ERROR;
358 }
359
360 dSP;
361 ENTER;
362 SAVETMPS;
363 SAVESPTR(PL_rs);
364 PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE));
365 while (1) {
366 PUSHMARK(SP);
367 XPUSHs(obj);
368 PUTBACK;
369 count = call_method("getline", G_SCALAR);
370 if (count != 1) croak("Big trouble\n");
371 SPAGAIN;
372 buf_sv = POPs;
373 if (SvOK(buf_sv)) {
374 buf = SvPV(buf_sv, len);
375 clen += len;
376 ap_rwrite(buf, len, r);
377 } else {
378 break;
379 }
380 }
381 set_content_length(r, len);
382 PUSHMARK(SP);
383 XPUSHs(obj);
384 PUTBACK;
385 call_method("close", G_DISCARD);
386 SPAGAIN;
387 PUTBACK;
388 FREETMPS;
389 LEAVE;
390 return OK;
391 }
392
393 static int output_body(request_rec *r, SV *body)
394 {
fe98cae @spiritloose use dTHX
authored
395 dTHX;
f61f188 @spiritloose Initial commit
authored
396 int rc, type;
397 switch (type = SvTYPE(SvRV(body))) {
398 case SVt_PVAV:
399 rc = output_body_ary(r, (AV *) SvRV(body));
400 break;
401 case SVt_PVGV:
402 require_pv("IO/Handle.pm");
403 case SVt_PVMG:
404 rc = output_body_obj(r, body, type);
405 break;
406 default:
407 server_error(r, "response body must be an array reference or object");
408 rc = HTTP_INTERNAL_SERVER_ERROR;
409 break;
410 }
411 return rc;
412 }
413
414 static int output_response(request_rec *r, SV *res)
415 {
fe98cae @spiritloose use dTHX
authored
416 dTHX;
f61f188 @spiritloose Initial commit
authored
417 AV *res_av;
418 SV **status;
419 SV **headers;
420 AV *headers_av;
421 SV **body;
422 int rc;
423
424 if (!SvROK(res) || SvTYPE(SvRV(res)) != SVt_PVAV) {
425 server_error(r, "response must be an array reference");
426 return HTTP_INTERNAL_SERVER_ERROR;
427 }
428 res_av = (AV *) SvRV(res);
429 if (av_len(res_av) != 2) {
430 server_error(r, "response must have 3 elements");
431 return HTTP_INTERNAL_SERVER_ERROR;
432 }
433
434 status = av_fetch(res_av, 0, 0);
435 if (!SvOK(*status)) {
436 server_error(r, "response status must be a scalar value");
437 return HTTP_INTERNAL_SERVER_ERROR;
438 }
439 rc = output_status(r, *status);
440 if (rc != OK) return rc;
441
442 headers = av_fetch(res_av, 1, 0);
443 if (!SvROK(*headers) || SvTYPE(SvRV(*headers)) != SVt_PVAV) {
444 server_error(r, "response headers must be an array reference");
445 return HTTP_INTERNAL_SERVER_ERROR;
446 }
447 headers_av = (AV *) SvRV(*headers);
448 if ((av_len(headers_av) + 1) % 2 != 0) {
449 server_error(r, "num of response headers must be even");
450 return HTTP_INTERNAL_SERVER_ERROR;
451 }
452 rc = output_headers(r, headers_av);
453 if (rc != OK) return rc;
454
455 body = av_fetch(res_av, 2, 0);
456 if (!SvROK(*body)) {
457 server_error(r, "response body must be a reference");
458 return HTTP_INTERNAL_SERVER_ERROR;
459 }
460 rc = output_body(r, *body);
461
462 return rc;
463 }
464
465 static void init_perl_variables(request_rec *r)
466 {
fe98cae @spiritloose use dTHX
authored
467 dTHX;
f61f188 @spiritloose Initial commit
authored
468 GV *exit_gv = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
469 GvCV(exit_gv) = get_cv("ModPSGI::exit", TRUE);
470 GvIMPORTED_CV_on(exit_gv);
471 sv_setpv_mg(get_sv("0", FALSE), r->server->process->argv[0]);
472 hv_store(GvHV(PL_envgv), "MOD_PSGI", 8, newSVpv(MOD_PSGI_VERSION, 0), 0);
473 }
474
475 static PerlInterpreter *init_perl(request_rec *r)
476 {
477 int argc = 0;
478 char *argv[] = { "", NULL };
479 char **envp = NULL;
fe98cae @spiritloose use dTHX
authored
480 PerlInterpreter *my_perl;
f61f188 @spiritloose Initial commit
authored
481 PERL_SYS_INIT3(&argc, (char ***) argv, &envp);
fe98cae @spiritloose use dTHX
authored
482 my_perl = perl_alloc();
f61f188 @spiritloose Initial commit
authored
483 PL_perl_destruct_level = 1;
fe98cae @spiritloose use dTHX
authored
484 perl_construct(my_perl);
485 perl_parse(my_perl, xs_init, argc, argv, envp);
f61f188 @spiritloose Initial commit
authored
486 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
fe98cae @spiritloose use dTHX
authored
487 perl_run(my_perl);
f61f188 @spiritloose Initial commit
authored
488 init_perl_variables(r);
fe98cae @spiritloose use dTHX
authored
489 return my_perl;
f61f188 @spiritloose Initial commit
authored
490 }
491
fe98cae @spiritloose use dTHX
authored
492 static void *destroy_perl(PerlInterpreter *my_perl)
f61f188 @spiritloose Initial commit
authored
493 {
494 PL_perl_destruct_level = 1;
fe98cae @spiritloose use dTHX
authored
495 perl_destruct(my_perl);
496 perl_free(my_perl);
f61f188 @spiritloose Initial commit
authored
497 PERL_SYS_TERM();
498 }
499
500 static int psgi_handler(request_rec *r)
501 {
fe98cae @spiritloose use dTHX
authored
502 dTHX;
f61f188 @spiritloose Initial commit
authored
503 SV *app, *env, *res;
504 PerlInterpreter *perlinterp;
505 psgi_dir_config *c;
506 int rc;
507
508 if (strcmp(r->handler, "psgi")) {
509 return DECLINED;
510 }
511
512 c = (psgi_dir_config *) ap_get_module_config(r->per_dir_config, &psgi_module);
513
514 if (c->psgi_app == NULL) {
515 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, r->server,
516 "PSGIApp not configured");
517 return DECLINED;
518 }
519
520 perlinterp = init_perl(r);
521 app = load_psgi(r, c->psgi_app);
522 if (app == NULL) {
523 rc = HTTP_INTERNAL_SERVER_ERROR;
524 goto exit;
525 }
526 env = make_env(r);
527 res = run_app(r, app, env);
528 if (res == NULL) {
529 server_error(r, "invalid response");
530 rc = HTTP_INTERNAL_SERVER_ERROR;
531 goto exit;
532 }
533 rc = output_response(r, res);
534 goto exit;
535 exit:
536 destroy_perl(perlinterp);
537 return rc;
538 }
539
540 static int supported_mpm()
541 {
542 int result;
543 ap_mpm_query(AP_MPMQ_IS_FORKED, &result);
544 return result;
545 }
546
547 static void psgi_register_hooks(apr_pool_t *p)
548 {
549 if (supported_mpm()) {
550 ap_hook_handler(psgi_handler, NULL, NULL, APR_HOOK_MIDDLE);
551 } else {
552 server_error(NULL, "mod_psgi only supports prefork mpm");
553 }
554 }
555
556 static void *create_dir_config(apr_pool_t *p, char *path)
557 {
558 psgi_dir_config *c = apr_pcalloc(p, sizeof(psgi_dir_config));
559 c->psgi_app = NULL;
560 return (void *) c;
561 }
562
563 static const char *cmd_psgi_app(cmd_parms *cmd, void *conf, const char *v)
564 {
565 psgi_dir_config *c = (psgi_dir_config *) conf;
566 c->psgi_app = (char *) apr_pstrdup(cmd->pool, v);
567 return NULL;
568 }
569
570 static const command_rec command_table[] = {
571 AP_INIT_TAKE1("PSGIApp", cmd_psgi_app, NULL,
b991f34 @spiritloose Allow PSGIApp in .htaccess
authored
572 OR_LIMIT, "set PSGI application"),
f61f188 @spiritloose Initial commit
authored
573 { NULL }
574 };
575
576 module AP_MODULE_DECLARE_DATA psgi_module = {
577 STANDARD20_MODULE_STUFF,
578 create_dir_config, /* create per-dir config structures */
579 NULL, /* merge per-dir config structures */
580 NULL, /* create per-server config structures */
581 NULL, /* merge per-server config structures */
582 command_table, /* table of config file commands */
583 psgi_register_hooks /* register hooks */
584 };
585
Something went wrong with that request. Please try again.