source: project/release/4/spiffy/trunk/web-scheme-handler.scm @ 12135

Last change on this file since 12135 was 12135, checked in by sjamaan, 12 years ago

Add back ssp, web-scheme and simple-directory handlers

File size: 2.7 KB
Line 
1;;;; web-scheme-handler.scm
2;
3; Copyright (c) 2007, Peter Bex
4; Copyright (c) 2000-2005, Felix L. Winkelmann
5; All rights reserved.
6;
7; Redistribution and use in source and binary forms, with or without
8; modification, are permitted provided that the following conditions
9; are met:
10;
11; 1. Redistributions of source code must retain the above copyright
12;    notice, this list of conditions and the following disclaimer.
13; 2. Redistributions in binary form must reproduce the above copyright
14;    notice, this list of conditions and the following disclaimer in the
15;    documentation and/or other materials provided with the distribution.
16; 3. Neither the name of the author nor the names of its
17;    contributors may be used to endorse or promote products derived
18;    from this software without specific prior written permission.
19;
20; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
25; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
26; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
31; OF THE POSSIBILITY OF SUCH DAMAGE.
32;
33; Please report bugs, suggestions and ideas to the Chicken Trac
34; ticket tracking system (assign tickets to user 'sjamaan'):
35; http://trac.callcc.org
36;
37; Web-scheme file handler
38
39(module web-scheme-handler
40  (web-scheme-handler web-scheme-eval-environment)
41
42(import chicken scheme spiffy extras intarweb ports files)
43 
44(define web-scheme-eval-environment (make-parameter (interaction-environment)))
45
46(define-syntax swallow-output
47  (syntax-rules ()
48    ((_ expr ...)
49     (let* ((ret "")
50            (str (with-output-to-string
51                   (lambda () (set! ret (begin expr ...))))))
52       (if (string? ret)
53           (string-append str ret)
54           str)))))
55
56(define (load-ws file)
57  (swallow-output
58   (eval `(begin ,@(read-file file)) (web-scheme-eval-environment))))
59
60(define (web-scheme-handler fn)
61  (let* ([out (load-ws (make-pathname (root-path) fn))])
62    (with-headers `((content-type text/html)
63                    (content-length ,(string-length out)))
64      (lambda ()
65       (write-response (current-response))
66       (display out (response-port (current-response)))))))
67
68)
Note: See TracBrowser for help on using the repository browser.