## Process this file with Automake to create Makefile.in
##
-## Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
+## Copyright (C) 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
modules/README modules/module-0.scm modules/module-1.scm \
modules/module-2.scm modules/main \
\
- safe/README safe/safe safe/untrusted.scm safe/evil.scm
+ safe/README safe/safe safe/untrusted.scm safe/evil.scm \
+ \
+ web/hello.scm web/debug-sxml.scm
AM_CFLAGS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config compile`
AM_LIBS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config link`
safe Examples for creating and using safe environments.
+web Simple web servers.
+
compat autoconf code for making a Guile extension
compatible with older versions of Guile.
--- /dev/null
+;;; Commentary:
+
+;;; A simple debugging server that responds to all responses with a
+;;; table containing the headers given in the request.
+;;;
+;;; As a novelty, this server uses a little micro-framework to build up
+;;; the response as SXML. Instead of a string, the `respond' helper
+;;; returns a procedure for the body, which allows the `(web server)'
+;;; machinery to collect the output as a bytevector in the desired
+;;; encoding, instead of building an intermediate output string.
+;;;
+;;; In the future this will also allow for chunked transfer-encoding,
+;;; for HTTP/1.1 clients.
+
+;;; Code:
+
+(use-modules (web server)
+ (web request)
+ (web response)
+ (sxml simple))
+
+(define html5-doctype "<!DOCTYPE html>\n")
+(define default-title "Hello hello!")
+
+(define* (templatize #:key (title "No title") (body '((p "No body"))))
+ `(html (head (title ,title))
+ (body ,@body)))
+
+(define* (respond #:optional body #:key
+ (status 200)
+ (title default-title)
+ (doctype html5-doctype)
+ (content-type-params '(("charset" . "utf-8")))
+ (content-type "text/html")
+ (extra-headers '())
+ (sxml (and body (templatize #:title title #:body body))))
+ (values (build-response
+ #:code status
+ #:headers `((content-type . (,content-type ,@content-type-params))
+ ,@extra-headers))
+ (lambda (port)
+ (if sxml
+ (begin
+ (if doctype (display doctype port))
+ (sxml->xml sxml port))))))
+
+(define (debug-page request body)
+ (respond `((h1 "hello world!")
+ (table
+ (tr (th "header") (th "value"))
+ ,@(map (lambda (pair)
+ `(tr (td (tt ,(with-output-to-string
+ (lambda () (display (car pair))))))
+ (td (tt ,(with-output-to-string
+ (lambda ()
+ (write (cdr pair))))))))
+ (request-headers request))))))
+
+(run-server debug-page)
--- /dev/null
+;;; Commentary:
+
+;;; A simple web server that responds to all requests with the eponymous
+;;; string. Visit http://localhost:8080 to test.
+
+;;; Code:
+
+(use-modules (web server))
+
+;; A handler receives two values as arguments: the request object, and
+;; the request body. It returns two values also: the response object,
+;; and the response body.
+;;
+;; In this simple example we don't actually access the request object,
+;; but if we wanted to, we would use the procedures from the `(web
+;; request)' module. If there is no body given in the request, the body
+;; argument will be false.
+;;
+;; To create a response object, use the `build-response' procedure from
+;; `(web response)'. Here we take advantage of a shortcut, in which we
+;; return an alist of headers for the response instead of returning a
+;; proper response object. In this case, a response object will be made
+;; for us with a 200 OK status.
+;;
+(define (handler request body)
+ (values '((content-type . ("text/plain")))
+ "Hello, World!"))
+
+(run-server handler)
HCoop / bpt / guile.git / commitdiff