Skip to content

HTTPS clone URL

Subversion checkout URL

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