It worked

;;; mgrabmue-servlets.scm -- user servlets for the webserver ;;; ;;; Copyright (C) 2004 Thien-Thi Nguyen ;;; Copyright (C) 2000, 2001 Martin Grabmueller ;;; ;;; This is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This software is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this package; see the file COPYING. If not, write to ;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This file demonstrates how you can write your own customized servlet ;; in SizzWeb. A servlet procedure must perform the followin steps: ;; - Set the HTTP response status ;; - Add appropriate headers ;; - Add content ;; - Commit the response. ;;; Code: (define-module (ttn-do mgrabmue-webserver) #:use-module (ttn shell-command-to-string)) ;; Kill the server loop (by returning #f). ;; (add-dynamic-handler! "^/qqq" (lambda (M in-port upath headers) (add-standard-headers M) (M #:set-reply-status:success) (M #:add-header #:Connection "close") (M #:add-header #:Content-Type "text/plain") (M #:add-content "bye!") (M #:send-reply) #f)) ;; Write a short message and dump the headers from the client. ;; (add-dynamic-handler! "^/test" (lambda (M in-port upath headers) (add-standard-headers M) (M #:set-reply-status:success) (M #:add-header #:Connection "close") (M #:add-header #:Content-Type "text/html") (M #:add-content "It worked" "

It seems that dynamic URL support in " *server-name* " works.

" "

The following headers were sent by your browser:

" (map (lambda (x) (list "\n")) headers) "

" (car x) "

" (cdr x) "

") (M #:send-reply))) ;; Register the time servlet to respond for all URLs below `/time'. ;; (add-dynamic-handler! "/time" (lambda (M in-port upath headers) (add-standard-headers M) (M #:set-reply-status:success) (M #:add-header #:Connection "close") (M #:add-header #:Content-Type "text/html") (M #:add-content "Time servlet" "

Time servlet

" "

Current local time on this server: " (strftime "%H:%M" (localtime (current-time))) "

") (M #:send-reply))) ;; Register the user servlet to respond for all URLs below `/user'. ;; (add-dynamic-handler! "/user" (lambda (M in-port upath headers) (add-standard-headers M) (M #:set-reply-status:success) (M #:add-header #:Connection "close") (M #:add-header #:Content-Type "text/html") (M #:add-content "User servlet" "

User servlet

" "

This is the servlet from the Sizzle distribution talking.

" "

You requested " upath ".

") (M #:send-reply))) ;; A dynamic upath handler for .shtml files. File contents are scanned ;; for `' comments, which are replaced w/ the ;; appropriate "server-side include" output. At this time, only ;; `#include' and `#exec' are handled. Fully expanded: ;; ;; ;; ;; ;; Note that the double-quotes are required. [This may differ somewhat ;; from Apache behavior -- sorry, manual not handy at the moment, this ;; is from memory. We should probably fix this to make it mimic Apache ;; as much as possible to avoid user confusion. -ttn] ;; (add-dynamic-handler! "\\.shtml$" (lambda (M in-port upath headers) (add-standard-headers M) (M #:set-reply-status:success) (M #:add-header #:Connection "close") (M #:add-header #:Content-Type "text/html") (let* ((rx (make-regexp "")) (ssi (fs-name upath)) (str (slurp ssi)) (max (string-length str)) (c '())) ;; do two passes to allow for validation (tbd) (let loop ((start 0) (acc '())) (if (>= start max) (set! c (reverse acc)) (let ((m (regexp-exec rx str start))) (if m (loop (match:end m) (cons (cons (string->symbol (match:substring m 1)) (match:substring m 3)) (cons (substring str start (match:start m)) acc))) (loop max (cons (substring str start max) acc)))))) (chdir (dirname ssi)) (for-each (lambda (chunk) (M #:add-content (if (string? chunk) chunk (case (car chunk) ((include) (slurp (cdr chunk))) ((exec) (shell-command-to-string (cdr chunk))) (else "(???)"))))) c)) (M #:send-reply))) ;;; mgrabmue-servlets.scm ends here