Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 723 lines (637 sloc) 19.229 kb
f61f188 Jiro Nishiguchi 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 */
03fb93e mattn win32 porting.
mattn authored
16 #ifdef _WIN32
17 /* avoid to define duplicate definition of uid_t/gid_t in perl/CORE.h */
18 #define uid_t _uid_t
19 #define gid_t _gid_t
20 #endif
f61f188 Jiro Nishiguchi Initial commit
authored
21 #include "httpd.h"
22 #include "http_log.h"
23 #include "http_config.h"
24 #include "http_protocol.h"
25 #include "util_script.h"
26 #include "ap_config.h"
27 #include "ap_mpm.h"
377b40d Jiro Nishiguchi sendfile support. closes #1
authored
28 #include "apr_file_io.h"
29 #include "apr_file_info.h"
03fb93e mattn win32 porting.
mattn authored
30 #include "apr_buckets.h"
f61f188 Jiro Nishiguchi Initial commit
authored
31 #include "apr_strings.h"
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
32 #include "apr_hash.h"
f61f188 Jiro Nishiguchi Initial commit
authored
33
03fb93e mattn win32 porting.
mattn authored
34 #ifdef _WIN32
35 /* use perl's uid_t/gid_t. disable apr's macros. */
36 #undef uid_t
37 #undef gid_t
38 #undef exit
39 #endif
40
f61f188 Jiro Nishiguchi Initial commit
authored
41 #include "EXTERN.h"
42 #include "perl.h"
43 #include "XSUB.h"
44 #define NEED_eval_pv
45 #define NEED_newRV_noinc
46 #define NEED_sv_2pv_flags
47 #include "ppport.h"
48
fae83c4 Jiro Nishiguchi oops, define CLEAR_ERRSV after #include.
authored
49 #ifndef CLEAR_ERRSV /* should support in ppport.h ? */
50 #define CLEAR_ERRSV() STMT_START { sv_setpvn(ERRSV,"",0); if (SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END
51 #endif /* CLEAR_ERRSV */
52
03fb93e mattn win32 porting.
mattn authored
53 #ifdef _WIN32
54 /* no use perl compatible macros. it break apr's structure. ex: bucket->link */
55 #undef link
56 #undef read
57 #endif
58
098e77e Jiro Nishiguchi ap_add_version_component
authored
59 #define PSGI_HANDLER_NAME "psgi"
60
f61f188 Jiro Nishiguchi Initial commit
authored
61 #ifdef DEBUG
62 #define TRACE(...) ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, NULL, __VA_ARGS__)
63 #endif
64
65 module AP_MODULE_DECLARE_DATA psgi_module;
66
67 typedef struct {
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
68 char *file;
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
69 char *location;
f61f188 Jiro Nishiguchi Initial commit
authored
70 } psgi_dir_config;
71
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
72 static PerlInterpreter *perlinterp = NULL;
73
74 static apr_hash_t *app_mapping = NULL;
75
76 static apr_array_header_t *psgi_apps = NULL;
e284234 Jiro Nishiguchi Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
77
f61f188 Jiro Nishiguchi Initial commit
authored
78 static void server_error(request_rec *r, const char *fmt, ...)
79 {
80 va_list argp;
81 const char *msg;
82 va_start(argp, fmt);
83 msg = apr_pvsprintf(r->pool, fmt, argp);
84 va_end(argp);
85 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "%s", msg);
86 }
87
88 EXTERN_C void xs_init (pTHX);
89
90 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
91
92 XS(ModPSGI_exit);
93 XS(ModPSGI_exit)
94 {
95 dXSARGS;
96 croak("exit");
97 XSRETURN(0);
98 }
99
100 XS(ModPSGI_Input_read);
101 XS(ModPSGI_Input_read)
102 {
103 dXSARGS;
104 SV *self = ST(0);
105 SV *buf = ST(1);
106 request_rec *r = (request_rec *) mg_find(SvRV(self), PERL_MAGIC_ext)->mg_obj;
107 apr_size_t len = SvIV(ST(2));
108 apr_size_t offset = items >= 4 ? SvIV(ST(3)) : 0;
109 apr_status_t rv;
110 apr_bucket_brigade *bb;
111 apr_bucket *bucket;
112 int eos = 0;
113 SV *ret;
114 dXSTARG;
115
116 ret = newSVpv("", 0);
117 bb = apr_brigade_create(r->pool, r->connection->bucket_alloc);
118 rv = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES, APR_BLOCK_READ, len);
119 if (rv != APR_SUCCESS) {
120 ST(0) = &PL_sv_undef;
121 XSRETURN(1);
122 }
123
124 for (bucket = APR_BRIGADE_FIRST(bb);
125 bucket != APR_BRIGADE_SENTINEL(bb);
126 bucket = APR_BUCKET_NEXT(bucket)) {
127 const char *bbuf;
128 apr_size_t blen;
129 if (APR_BUCKET_IS_EOS(bucket)) {
130 eos = 1;
131 break;
132 }
133 if (APR_BUCKET_IS_METADATA(bucket)) {
134 continue;
135 }
136 apr_bucket_read(bucket, &bbuf, &blen, APR_BLOCK_READ);
137 sv_catpvn(ret, bbuf, blen);
138 }
139
140 sv_setsv(buf, ret);
141 ST(0) = sv_2mortal(newSViv(SvCUR(buf)));
142 XSRETURN(1);
143 }
144
145 XS(ModPSGI_Errors_print);
146 XS(ModPSGI_Errors_print)
147 {
148 dXSARGS;
149 SV *self = ST(0);
150 SV *msg = ST(1);
151 dXSTARG;
152 request_rec *r = (request_rec *) mg_find(SvRV(self), PERL_MAGIC_ext)->mg_obj;
153 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, r->server, "%s", SvPV_nolen(msg));
154 ST(0) = newSViv(1);
155 XSRETURN(1);
156 }
157
158 EXTERN_C void
159 xs_init(pTHX)
160 {
161 char *file = __FILE__;
162 dXSUB_SYS;
163
164 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
165 newXS("ModPSGI::exit", ModPSGI_exit, file);
166 newXSproto("ModPSGI::Input::read", ModPSGI_Input_read, file, "$$$;$");
167 newXSproto("ModPSGI::Errors::print", ModPSGI_Errors_print, file, "$$");
168 }
169
170 static int copy_env(void *rec, const char *key, const char *val)
171 {
fe98cae Jiro Nishiguchi use dTHX
authored
172 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
173 HV *env = (HV *) rec;
174 hv_store(env, key, strlen(key), newSVpv(val, 0), 0);
175 return 1;
176 }
177
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
178 static SV *make_env(request_rec *r, psgi_dir_config *c)
f61f188 Jiro Nishiguchi Initial commit
authored
179 {
fe98cae Jiro Nishiguchi use dTHX
authored
180 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
181 HV *env;
182 AV *version;
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
183 char *url_scheme, *script_name, *vpath, *path_info;
f61f188 Jiro Nishiguchi Initial commit
authored
184 SV *input, *errors;
185
186 env = newHV();
187
188 ap_add_cgi_vars(r);
189 ap_add_common_vars(r);
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
190
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
191 /* fix SCRIPT_NAME & PATH_INFO */
192 if (c->location == NULL || strcmp(c->location, "/") == 0) {
193 script_name = "";
194 } else {
195 script_name = c->location;
f61f188 Jiro Nishiguchi Initial commit
authored
196 }
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
197 vpath = apr_pstrcat(r->pool,
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
198 apr_table_get(r->subprocess_env, "SCRIPT_NAME"),
199 apr_table_get(r->subprocess_env, "PATH_INFO"),
200 NULL);
201 path_info = &vpath[strlen(script_name)];
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
202 apr_table_set(r->subprocess_env, "PATH_INFO", path_info);
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
203 apr_table_set(r->subprocess_env, "SCRIPT_NAME", script_name);
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
204
f61f188 Jiro Nishiguchi Initial commit
authored
205 apr_table_do(copy_env, env, r->subprocess_env, NULL);
206
207 version = newAV();
208 av_push(version, newSViv(1));
209 av_push(version, newSViv(0));
210 hv_store(env, "psgi.version", 12, newRV_inc((SV *) version), 0);
211
212 url_scheme = apr_table_get(r->subprocess_env, "HTTPS") == NULL ? "http" : "https";
213 hv_store(env, "psgi.url_scheme", 15, newSVpv(url_scheme, 0), 0);
214
215 input = newRV_noinc(newSV(0));
216 sv_magic(SvRV(input), NULL, PERL_MAGIC_ext, NULL, 0);
217 mg_find(SvRV(input), PERL_MAGIC_ext)->mg_obj = (void *) r;
218 sv_bless(input, gv_stashpv("ModPSGI::Input", 1));
219 hv_store(env, "psgi.input", 10, input, 0);
220
221 errors = newRV_noinc(newSV(0));
222 sv_magic(SvRV(errors), NULL, PERL_MAGIC_ext, NULL, 0);
223 mg_find(SvRV(errors), PERL_MAGIC_ext)->mg_obj = (void *) r;
224 sv_bless(errors, gv_stashpv("ModPSGI::Errors", 1));
225 hv_store(env, "psgi.errors", 11, errors, 0);
226
227 hv_store(env, "psgi.multithread", 16, newSViv(0), 0);
228 hv_store(env, "psgi.multiprocess", 17, newSViv(1), 0);
229 hv_store(env, "psgi.run_once", 13, newSViv(1), 0);
3377795 Jiro Nishiguchi psgi.async -> psgi.nonblocking
authored
230 hv_store(env, "psgi.nonblocking", 16, newSViv(0), 0);
f61f188 Jiro Nishiguchi Initial commit
authored
231
232 return newRV_inc((SV *) env);
233 }
234
235 static SV *run_app(request_rec *r, SV *app, SV *env)
236 {
fe98cae Jiro Nishiguchi use dTHX
authored
237 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
238 int count;
239 SV *res;
240 dSP;
241 ENTER;
242 SAVETMPS;
243 PUSHMARK(SP) ;
244 XPUSHs(sv_2mortal(env));
245 PUTBACK;
246
0e90b5f Jiro Nishiguchi use G_KEEPERR and CLEAR_ERRSV() to catch errors
authored
247 count = call_sv(app, G_EVAL|G_SCALAR|G_KEEPERR);
f61f188 Jiro Nishiguchi Initial commit
authored
248 SPAGAIN;
249 if (SvTRUE(ERRSV)) {
250 res = NULL;
251 server_error(r, "%s", SvPV_nolen(ERRSV));
0e90b5f Jiro Nishiguchi use G_KEEPERR and CLEAR_ERRSV() to catch errors
authored
252 CLEAR_ERRSV();
f61f188 Jiro Nishiguchi Initial commit
authored
253 POPs;
254 } else if (count > 0) {
255 res = POPs;
256 SvREFCNT_inc(res);
257 } else {
258 res = NULL;
259 }
260 PUTBACK;
261 FREETMPS;
262 LEAVE;
263 return res;
264 }
265
266 static int output_status(request_rec *r, SV *status)
267 {
fe98cae Jiro Nishiguchi use dTHX
authored
268 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
269 int s = SvIV(status);
270 if (s < 100) {
271 server_error(r, "invalid response status %d", s);
272 return HTTP_INTERNAL_SERVER_ERROR;
273 }
274 r->status = s;
275 return OK;
276 }
277
278 static int output_headers(request_rec *r, AV *headers)
279 {
fe98cae Jiro Nishiguchi use dTHX
authored
280 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
281 SV *key_sv, *val_sv;
947bdac Jiro Nishiguchi use ap_set_content_length
authored
282 char *key;
283
284 r->content_type = NULL;
f61f188 Jiro Nishiguchi Initial commit
authored
285 while (av_len(headers) > -1) {
286 key_sv = av_shift(headers);
287 val_sv = av_shift(headers);
288 if (key_sv == NULL || val_sv == NULL) break;
289 key = SvPV_nolen(key_sv);
aab7f6a Jiro Nishiguchi Do not check header value
authored
290 if (strcmp(key, "Content-Type") == 0) {
947bdac Jiro Nishiguchi use ap_set_content_length
authored
291 r->content_type = apr_pstrdup(r->pool, SvPV_nolen(val_sv));
292 } else if (strcmp(key, "Content-Length") == 0) {
293 ap_set_content_length(r, SvIV(val_sv));
f61f188 Jiro Nishiguchi Initial commit
authored
294 } else if (strcmp(key, "Status") == 0) {
295 server_error(r, "headers must not contain a Status");
296 return HTTP_INTERNAL_SERVER_ERROR;
297 } else {
947bdac Jiro Nishiguchi use ap_set_content_length
authored
298 apr_table_add(r->headers_out, key, SvPV_nolen(val_sv));
f61f188 Jiro Nishiguchi Initial commit
authored
299 }
300 }
301 return OK;
302 }
303
304 static int respond_to(SV *obj, const char *method)
305 {
fe98cae Jiro Nishiguchi use dTHX
authored
306 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
307 int res;
308 dSP;
309 ENTER;
310 SAVETMPS;
311 PUSHMARK(SP);
312 XPUSHs(obj);
313 XPUSHs(sv_2mortal(newSVpv(method, 0)));
314 PUTBACK;
315
316 call_method("can", G_SCALAR);
317 SPAGAIN;
318 res = SvROK(POPs);
319 PUTBACK;
320 FREETMPS;
321 LEAVE;
322 return res;
323 }
324
325 static int output_body_ary(request_rec *r, AV *bodys)
326 {
fe98cae Jiro Nishiguchi use dTHX
authored
327 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
328 SV **body;
329 I32 i;
330 I32 lastidx;
331 char *buf;
332 STRLEN len;
03fb93e mattn win32 porting.
mattn authored
333 apr_off_t clen = 0;
f61f188 Jiro Nishiguchi Initial commit
authored
334
335 lastidx = av_len(bodys);
336 for (i = 0; i <= lastidx; i++) {
337 body = av_fetch(bodys, i, 0);
338 if (SvOK(*body)) {
339 buf = SvPV(*body, len);
340 ap_rwrite(buf, len, r);
341 clen += len;
342 }
343 }
947bdac Jiro Nishiguchi use ap_set_content_length
authored
344 if (clen > 0) {
345 ap_set_content_length(r, clen);
346 }
f61f188 Jiro Nishiguchi Initial commit
authored
347 return OK;
348 }
349
350 static int output_body_obj(request_rec *r, SV *obj, int type)
351 {
fe98cae Jiro Nishiguchi use dTHX
authored
352 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
353 SV *buf_sv, *rs;
354 apr_off_t clen = 0;
355 STRLEN len;
03fb93e mattn win32 porting.
mattn authored
356 dSP;
f61f188 Jiro Nishiguchi Initial commit
authored
357 char *buf;
358 int count;
359
360 if (type == SVt_PVMG && !respond_to(obj, "getline")) {
361 server_error(r, "response body object must be able to getline");
362 return HTTP_INTERNAL_SERVER_ERROR;
363 }
364
365 ENTER;
366 SAVETMPS;
367 SAVESPTR(PL_rs);
368 PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE));
369 while (1) {
370 PUSHMARK(SP);
371 XPUSHs(obj);
372 PUTBACK;
373 count = call_method("getline", G_SCALAR);
374 if (count != 1) croak("Big trouble\n");
375 SPAGAIN;
376 buf_sv = POPs;
377 if (SvOK(buf_sv)) {
378 buf = SvPV(buf_sv, len);
379 clen += len;
380 ap_rwrite(buf, len, r);
381 } else {
382 break;
383 }
384 }
947bdac Jiro Nishiguchi use ap_set_content_length
authored
385 if (len > 0) {
386 ap_set_content_length(r, len);
387 }
f61f188 Jiro Nishiguchi Initial commit
authored
388 PUSHMARK(SP);
389 XPUSHs(obj);
390 PUTBACK;
391 call_method("close", G_DISCARD);
392 SPAGAIN;
393 PUTBACK;
394 FREETMPS;
395 LEAVE;
396 return OK;
397 }
398
377b40d Jiro Nishiguchi sendfile support. closes #1
authored
399 static int output_body_sendfile(request_rec *r, const char *path)
400 {
401 apr_file_t *fd;
402 apr_status_t status;
403 apr_size_t len, nbytes;
404 apr_finfo_t finfo;
405 int rc;
406
407 status = apr_file_open(&fd, path, APR_READ|APR_BINARY, APR_OS_DEFAULT, r->pool);
408 if (status != APR_SUCCESS) {
409 return HTTP_INTERNAL_SERVER_ERROR;
410 }
411
412 apr_file_info_get(&finfo, APR_FINFO_NORM, fd);
413 len = finfo.size;
414
415 status = ap_send_fd(fd, r, 0, len, &nbytes);
416 apr_file_close(fd);
417
418 if (status == APR_SUCCESS) {
419 ap_set_content_length(r, nbytes);
420 rc = OK;
421 } else {
422 rc = HTTP_INTERNAL_SERVER_ERROR;
423 }
424
425 return rc;
426 }
427
428 static int output_body_path(request_rec *r, SV *body)
429 {
430 dTHX;
431 int count;
432 apr_status_t rc;
433 SV *path_sv;
434 char *path;
435 dSP;
436 ENTER;
437 SAVETMPS;
438 PUSHMARK(SP);
439 XPUSHs(body);
440 PUTBACK;
441
442 count = call_method("path", G_EVAL|G_SCALAR|G_KEEPERR);
443 SPAGAIN;
444 if (SvTRUE(ERRSV)) {
445 rc = DECLINED;
446 server_error(r, "unable to get path\n%s", SvPV_nolen(ERRSV));
447 CLEAR_ERRSV();
448 POPs;
449 } else if (count > 0) {
450 path_sv = POPs;
451 path = apr_pstrdup(r->pool, SvPV_nolen(path_sv));
452 rc = OK;
453 } else {
454 rc = DECLINED;
455 }
456 PUTBACK;
457 FREETMPS;
458 LEAVE;
459
460 return rc != OK ? rc : output_body_sendfile(r, path);
461 }
462
f61f188 Jiro Nishiguchi Initial commit
authored
463 static int output_body(request_rec *r, SV *body)
464 {
fe98cae Jiro Nishiguchi use dTHX
authored
465 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
466 int rc, type;
467 switch (type = SvTYPE(SvRV(body))) {
468 case SVt_PVAV:
469 rc = output_body_ary(r, (AV *) SvRV(body));
470 break;
471 case SVt_PVGV:
377b40d Jiro Nishiguchi sendfile support. closes #1
authored
472 /* TODO:
473 * It's possible to get fd by PerlIO_fileno(IoIFP(sv_2io(body)))
474 * It's possible to get apr_file_t by apr_os_file_put
475 * Is it possible to implement above portable?
476 */
f61f188 Jiro Nishiguchi Initial commit
authored
477 require_pv("IO/Handle.pm");
478 case SVt_PVMG:
377b40d Jiro Nishiguchi sendfile support. closes #1
authored
479 if (respond_to(body, "path")) {
480 rc = output_body_path(r, body);
481 if (rc != DECLINED) break;
482 }
f61f188 Jiro Nishiguchi Initial commit
authored
483 rc = output_body_obj(r, body, type);
484 break;
485 default:
486 server_error(r, "response body must be an array reference or object");
487 rc = HTTP_INTERNAL_SERVER_ERROR;
488 break;
489 }
490 return rc;
491 }
492
493 static int output_response(request_rec *r, SV *res)
494 {
fe98cae Jiro Nishiguchi use dTHX
authored
495 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
496 AV *res_av;
497 SV **status;
498 SV **headers;
499 AV *headers_av;
500 SV **body;
501 int rc;
502
503 if (!SvROK(res) || SvTYPE(SvRV(res)) != SVt_PVAV) {
504 server_error(r, "response must be an array reference");
505 return HTTP_INTERNAL_SERVER_ERROR;
506 }
507 res_av = (AV *) SvRV(res);
508 if (av_len(res_av) != 2) {
509 server_error(r, "response must have 3 elements");
510 return HTTP_INTERNAL_SERVER_ERROR;
511 }
512
513 status = av_fetch(res_av, 0, 0);
514 if (!SvOK(*status)) {
515 server_error(r, "response status must be a scalar value");
516 return HTTP_INTERNAL_SERVER_ERROR;
517 }
518 rc = output_status(r, *status);
519 if (rc != OK) return rc;
520
521 headers = av_fetch(res_av, 1, 0);
522 if (!SvROK(*headers) || SvTYPE(SvRV(*headers)) != SVt_PVAV) {
523 server_error(r, "response headers must be an array reference");
524 return HTTP_INTERNAL_SERVER_ERROR;
525 }
526 headers_av = (AV *) SvRV(*headers);
527 if ((av_len(headers_av) + 1) % 2 != 0) {
528 server_error(r, "num of response headers must be even");
529 return HTTP_INTERNAL_SERVER_ERROR;
530 }
531 rc = output_headers(r, headers_av);
532 if (rc != OK) return rc;
533
534 body = av_fetch(res_av, 2, 0);
535 if (!SvROK(*body)) {
536 server_error(r, "response body must be a reference");
537 return HTTP_INTERNAL_SERVER_ERROR;
538 }
539 rc = output_body(r, *body);
540
541 return rc;
542 }
543
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
544 static void init_perl_variables()
f61f188 Jiro Nishiguchi Initial commit
authored
545 {
fe98cae Jiro Nishiguchi use dTHX
authored
546 dTHX;
f61f188 Jiro Nishiguchi Initial commit
authored
547 GV *exit_gv = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
548 GvCV(exit_gv) = get_cv("ModPSGI::exit", TRUE);
549 GvIMPORTED_CV_on(exit_gv);
550 hv_store(GvHV(PL_envgv), "MOD_PSGI", 8, newSVpv(MOD_PSGI_VERSION, 0), 0);
551 }
552
ecd58df Jiro Nishiguchi Load .psgi from .htaccess
authored
553 static SV *load_psgi(apr_pool_t *pool, const char *file)
554 {
555 dTHX;
556 SV *app;
557 char *code;
558
559 code = apr_psprintf(pool, "do q\"%s\" or die $@",
560 ap_escape_quotes(pool, file));
561 app = eval_pv(code, FALSE);
562
563 if (SvTRUE(ERRSV)) {
564 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL, "%s", SvPV_nolen(ERRSV));
0e90b5f Jiro Nishiguchi use G_KEEPERR and CLEAR_ERRSV() to catch errors
authored
565 CLEAR_ERRSV();
ecd58df Jiro Nishiguchi Load .psgi from .htaccess
authored
566 return NULL;
567 }
568 if (!SvOK(app) || !SvROK(app) || SvTYPE(SvRV(app)) != SVt_PVCV) {
569 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL,
570 "%s does not return an application code reference", file);
571 return NULL;
572 }
573 return app;
574 }
575
4e00d63 Jiro Nishiguchi init and destroy in handler
authored
576 static int psgi_handler(request_rec *r)
f61f188 Jiro Nishiguchi Initial commit
authored
577 {
578 SV *app, *env, *res;
579 psgi_dir_config *c;
580
098e77e Jiro Nishiguchi ap_add_version_component
authored
581 if (strcmp(r->handler, PSGI_HANDLER_NAME)) {
f61f188 Jiro Nishiguchi Initial commit
authored
582 return DECLINED;
583 }
584 c = (psgi_dir_config *) ap_get_module_config(r->per_dir_config, &psgi_module);
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
585 if (c->file == NULL) {
f61f188 Jiro Nishiguchi Initial commit
authored
586 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE, 0, r->server,
587 "PSGIApp not configured");
588 return DECLINED;
589 }
5b66763 Jiro Nishiguchi PERL_SET_CONTEXT
authored
590
591 PERL_SET_CONTEXT(perlinterp);
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
592 app = apr_hash_get(app_mapping, c->file, APR_HASH_KEY_STRING);
ecd58df Jiro Nishiguchi Load .psgi from .htaccess
authored
593 if (app == NULL) {
594 app = load_psgi(r->pool, c->file);
595 if (app == NULL) {
596 server_error(r, "%s had compilation errors.", c->file);
597 return HTTP_INTERNAL_SERVER_ERROR;
598 }
599 apr_hash_set(app_mapping, c->file, APR_HASH_KEY_STRING, app);
600 }
cad20bf Jiro Nishiguchi Thanks to fujiwara. fixes #4
authored
601 env = make_env(r, c);
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
602 res = run_app(r, app, env);
f61f188 Jiro Nishiguchi Initial commit
authored
603 if (res == NULL) {
604 server_error(r, "invalid response");
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
605 return HTTP_INTERNAL_SERVER_ERROR;
f61f188 Jiro Nishiguchi Initial commit
authored
606 }
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
607 return output_response(r, res);
f61f188 Jiro Nishiguchi Initial commit
authored
608 }
609
e284234 Jiro Nishiguchi Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
610 static apr_status_t psgi_child_exit(void *p)
611 {
03fb93e mattn win32 porting.
mattn authored
612 if (perlinterp == NULL) {
613 PERL_SET_CONTEXT(perlinterp);
614 PL_perl_destruct_level = 1;
615 perl_destruct(perlinterp);
616 perl_free(perlinterp);
617 PERL_SYS_TERM();
618 perlinterp = NULL;
619 }
e284234 Jiro Nishiguchi Call PERL_SYS_INIT3,PERL_SYS_TERM once per process
authored
620 return OK;
621 }
622
623 static void psgi_child_init(apr_pool_t *p, server_rec *s)
624 {
625 apr_pool_cleanup_register(p, NULL, psgi_child_exit, psgi_child_exit);
626 }
627
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
628 static apr_status_t
629 psgi_pre_config(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp)
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
630 {
631 int argc = 2;
632 char *argv[] = { "perl", "-e;0", NULL };
633 char **envp = NULL;
634
635 PERL_SYS_INIT3(&argc, (char ***) argv, &envp);
636 perlinterp = perl_alloc();
637 PL_perl_destruct_level = 1;
638 perl_construct(perlinterp);
639 perl_parse(perlinterp, xs_init, argc, argv, envp);
640 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
641 perl_run(perlinterp);
642 init_perl_variables();
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
643
644 psgi_apps = apr_array_make(pconf, 10, sizeof(char *));
645 app_mapping = apr_hash_make(pconf);
646
647 return OK;
648 }
649
650 static int
651 psgi_post_config(apr_pool_t *pconf, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s)
652 {
653 dTHX;
654 int i;
655 char *file, **elts;
656 SV *app;
8fd6f10 Jiro Nishiguchi Ignore first call psgi_post_config
authored
657 void *data;
658 const char *userdata_key = "psgi_post_config";
659
660 apr_pool_userdata_get(&data, userdata_key, s->process->pool);
661 if (data == NULL) {
662 apr_pool_userdata_set((const void *)1, userdata_key,
663 apr_pool_cleanup_null, s->process->pool);
664 return OK;
665 }
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
666 elts = (char **) psgi_apps->elts;
667 for (i = 0; i < psgi_apps->nelts; i++) {
668 file = elts[i];
669 app = load_psgi(pconf, file);
670 if (app == NULL) {
671 ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, 0, NULL,
672 "%s had compilation errors.", file);
673 return DONE;
674 }
675 apr_hash_set(app_mapping, file, APR_HASH_KEY_STRING, app);
676 }
098e77e Jiro Nishiguchi ap_add_version_component
authored
677
678 ap_add_version_component(pconf, apr_psprintf(pconf, "mod_psgi/%s", MOD_PSGI_VERSION));
679
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
680 return OK;
681 }
682
f61f188 Jiro Nishiguchi Initial commit
authored
683 static void psgi_register_hooks(apr_pool_t *p)
684 {
03fb93e mattn win32 porting.
mattn authored
685 ap_hook_pre_config(psgi_pre_config, NULL, NULL, APR_HOOK_MIDDLE);
686 ap_hook_post_config(psgi_post_config, NULL, NULL, APR_HOOK_MIDDLE);
687 ap_hook_child_init(psgi_child_init, NULL, NULL, APR_HOOK_MIDDLE);
688 ap_hook_handler(psgi_handler, NULL, NULL, APR_HOOK_MIDDLE);
f61f188 Jiro Nishiguchi Initial commit
authored
689 }
690
691 static void *create_dir_config(apr_pool_t *p, char *path)
692 {
693 psgi_dir_config *c = apr_pcalloc(p, sizeof(psgi_dir_config));
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
694 c->file = NULL;
430ccf9 FUJIWARA Shunichiro fix PATH_INFO and SCRIPT_NAME
fujiwara authored
695 c->location = path;
f61f188 Jiro Nishiguchi Initial commit
authored
696 return (void *) c;
697 }
698
699 static const char *cmd_psgi_app(cmd_parms *cmd, void *conf, const char *v)
700 {
701 psgi_dir_config *c = (psgi_dir_config *) conf;
ace1272 Jiro Nishiguchi Make PerlInterpreter persistent
authored
702 c->file = (char *) apr_pstrdup(cmd->pool, v);
c115693 Jiro Nishiguchi 'do $psgi_app' at post_config
authored
703 *(const char **) apr_array_push(psgi_apps) = c->file;
f61f188 Jiro Nishiguchi Initial commit
authored
704 return NULL;
705 }
706
707 static const command_rec command_table[] = {
708 AP_INIT_TAKE1("PSGIApp", cmd_psgi_app, NULL,
b991f34 Jiro Nishiguchi Allow PSGIApp in .htaccess
authored
709 OR_LIMIT, "set PSGI application"),
f61f188 Jiro Nishiguchi Initial commit
authored
710 { NULL }
711 };
712
713 module AP_MODULE_DECLARE_DATA psgi_module = {
714 STANDARD20_MODULE_STUFF,
715 create_dir_config, /* create per-dir config structures */
716 NULL, /* merge per-dir config structures */
717 NULL, /* create per-server config structures */
718 NULL, /* merge per-server config structures */
719 command_table, /* table of config file commands */
720 psgi_register_hooks /* register hooks */
721 };
722
Something went wrong with that request. Please try again.