Skip to content

HTTPS clone URL

Subversion checkout URL

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