[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-216-g2

From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-13-216-g27e3460
Date: Fri, 17 Dec 2010 12:36:56 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

The branch, master has been updated
       via  27e346064eaf410c207b71df33f4b2f8d4e3d453 (commit)
       via  7cf64a0af1a39fa6c4d935568aed6db4a930de8c (commit)
       via  cdab9fc6250ffa86467156d50b88834c28922b16 (commit)
       via  626e36e5cbfb8a251c647d44116bd2b34bc88106 (commit)
       via  d09c07fb102d3a151af9cac5bb6ffdc896f93ce1 (commit)
       via  e01163b5f11142a40c1abde6846ccdccd7294a9b (commit)
       via  60905b80d4a2c7c5fd0e71ac3a0e9285f18c5e7d (commit)
       via  5cdab8b8f6088ac6b8f7f78b8c32201a92a84ccd (commit)
       via  e2d4bfea009569b20e4295e5c9abbe53314f6f12 (commit)
      from  c21a5ddcaf2b17d65355c977f37ee50375961d17 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 27e346064eaf410c207b71df33f4b2f8d4e3d453
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:33:29 2010 +0100

    update NEWS
    * NEWS: Update.

commit 7cf64a0af1a39fa6c4d935568aed6db4a930de8c
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:30:07 2010 +0100

    guile-user has no filename
    * module/ice-9/boot-9.scm (guile-user): Set #:filename to #f for
      guile-user module, as guile-user isn't really associated with any

commit cdab9fc6250ffa86467156d50b88834c28922b16
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:27:43 2010 +0100

    add ,reload meta-command and document it and reload-module
    * module/ice-9/boot-9.scm (reload-module): Add docstring.
    * module/system/repl/command.scm (reload): New meta-command.
    * doc/ref/scheme-using.texi (Module Commands): Document the ,reload
    * doc/ref/api-modules.texi (Module System Reflection): Document

commit 626e36e5cbfb8a251c647d44116bd2b34bc88106
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:16:36 2010 +0100

    document variable-unset!
    * doc/ref/api-modules.texi (Variables): Document variable-unset!.
    * NEWS: Update.

commit d09c07fb102d3a151af9cac5bb6ffdc896f93ce1
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:14:13 2010 +0100

    document make-unbound-fluid et al
    * doc/ref/api-scheduling.texi (Fluids and Dynamic States): Document the
      new fluid routines.
    * NEWS: Update.

commit e01163b5f11142a40c1abde6846ccdccd7294a9b
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:10:03 2010 +0100

    rename make-undefined-fluid to make-unbound-fluid
    * libguile/fluids.c (scm_make_unbound_fluid): Rename from
    * libguile/fluids.h:
    * module/language/elisp/runtime.scm: Update referrers.

commit 60905b80d4a2c7c5fd0e71ac3a0e9285f18c5e7d
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 13:04:23 2010 +0100

    multicast manual updates
    * doc/ref/posix.texi (Network Sockets and Communication): Add
      IP_MULTICAST_TTL and IP_MULTICAST_IF docs, from the docstring.
    * NEWS: Update.

commit 5cdab8b8f6088ac6b8f7f78b8c32201a92a84ccd
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 12:54:21 2010 +0100

    more web.texi "hacking"
    * doc/ref/web.texi (Web Server, Web Examples): Finish these sections.

commit e2d4bfea009569b20e4295e5c9abbe53314f6f12
Author: Andy Wingo <address@hidden>
Date:   Fri Dec 17 12:01:34 2010 +0100

    build-response validates headers
    * module/web/response.scm (build-response): Add some validation, like
      for build-request.


Summary of changes:
 NEWS                              |   18 ++--
 doc/ref/api-modules.texi          |   10 ++
 doc/ref/api-scheduling.texi       |   20 +++-
 doc/ref/posix.texi                |   10 ++
 doc/ref/scheme-using.texi         |    4 +
 doc/ref/web.texi                  |  259 ++++++++++++++++++++++++++++++++----
 libguile/fluids.c                 |    6 +-
 libguile/fluids.h                 |    2 +-
 module/ice-9/boot-9.scm           |    5 +-
 module/language/elisp/runtime.scm |    2 +-
 module/system/repl/command.scm    |   11 ++-
 module/web/response.scm           |   33 +++++-
 12 files changed, 333 insertions(+), 47 deletions(-)

diff --git a/NEWS b/NEWS
index cd1e5b9..55fb271 100644
--- a/NEWS
+++ b/NEWS
@@ -75,17 +75,19 @@ macros like `quote' are printed better.
 ** Multicast socket options
-FIXME: Need to document IP_MULTICAST_TTL and IP_MULTICAST_IF in the
+Support was added for the IP_MULTICAST_TTL and IP_MULTICAST_IF socket
+options.  See "Network Sockets and Communication" in the manual, for
+more information.
 ** Deprecate `cuserid'
 `cuserid' has been deprecated, as it only returns 8 bytes of a user's
 login.  Use `(passwd:name (getpwuid (geteuid)))' instead.
-** New procedure. `reload-module'
+** New procedure `reload-module', and `,reload' REPL command
-Needs documenting and a REPL meta-command.
+See "Module System Reflection" and "Module Commands" in the manual, for
+more information.
 ** Allow user-defined REPL meta-commands
@@ -93,14 +95,12 @@ See FIXME in the manual, for more information.
 ** Add support for unbound fluids
-FIXME: needs documentation
-See `make-undefined-fluid' (FIXME: should be make-unbound-fluid),
-`fluid-unset!', and `fluid-bound?' in the manual.
+See `make-unbound-fluid', `fluid-unset!', and `fluid-bound?' in the
 ** Add variable-unset!
-FIXME: document.
+See "Variables" in the manual, for more details.
 ** Command line additions
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 790cca6..8e778c7 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -563,6 +563,11 @@ arguments should be module objects, and @var{interface} 
should very
 likely be a module returned by @code{resolve-interface}.
 @end deffn
address@hidden {Scheme Procedure} reload-module module
+Revisit the source file that corresponds to @var{module}.  Raises an
+error if no source file is associated with the given module.
address@hidden deffn
 @node Included Guile Modules
 @subsection Included Guile Modules
@@ -1074,6 +1079,11 @@ Set the value of the variable @var{var} to @var{val}.
 value. Return an unspecified value.
 @end deffn
address@hidden {Scheme Procedure} variable-unset! var
address@hidden {C Function} scm_variable_unset_x (var)
+Unset the value of the variable @var{var}, leaving @var{var} unbound.
address@hidden deffn
 @deffn {Scheme Procedure} variable? obj
 @deffnx {C Function} scm_variable_p (obj)
 Return @code{#t} iff @var{obj} is a variable object, else
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index d550416..a3bef74 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -691,6 +691,12 @@ inherits the values from its parent.  Because each thread 
normally executes
 with its own dynamic state, you can use fluids for thread local storage.
 @end deffn
address@hidden {Scheme Procedure} make-unbound-fluid
address@hidden {C Function} scm_make_unbound_fluid ()
+Return a new fluid that is initially unbound (instead of being
+implicitly bound to @code{#f}.
address@hidden deffn
 @deffn {Scheme Procedure} fluid? obj
 @deffnx {C Function} scm_fluid_p (obj)
 Return @code{#t} iff @var{obj} is a fluid; otherwise, return
@@ -701,7 +707,8 @@ Return @code{#t} iff @var{obj} is a fluid; otherwise, return
 @deffnx {C Function} scm_fluid_ref (fluid)
 Return the value associated with @var{fluid} in the current
 dynamic root.  If @var{fluid} has not been set, then return
address@hidden Calling @code{fluid-ref} on an unbound fluid produces a
+runtime error.
 @end deffn
 @deffn {Scheme Procedure} fluid-set! fluid value
@@ -709,6 +716,17 @@ dynamic root.  If @var{fluid} has not been set, then return
 Set the value associated with @var{fluid} in the current dynamic root.
 @end deffn
address@hidden {Scheme Procedure} fluid-unset! fluid
address@hidden {C Function} scm_fluid_unset_x (fluid)
+Disassociate the given fluid from any value, making it unbound.
address@hidden deffn
address@hidden {Scheme Procedure} fluid-bound? fluid
address@hidden {C Function} scm_fluid_bound_p (fluid)
+Returns @code{#t} iff the given fluid is bound to a value, otherwise
address@hidden deffn
 @code{with-fluids*} temporarily changes the values of one or more fluids,
 so that the given procedure and each procedure called by it access the
 given values.  After the procedure returns, the old values are restored.
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index dc9d77b..468eaea 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -3045,6 +3045,16 @@ For IP level (@code{IPPROTO_IP}) the following 
@var{optname}s are
 defined (when provided by the system).  See @command{man ip} for what
 they mean.
address@hidden IP_MULTICAST_IF
+This sets the source interface used by multicast traffic.
address@hidden defvar
address@hidden IP_MULTICAST_TTL
+This sets the default TTL for multicast traffic. This defaults
+to 1 and should be increased to allow traffic to pass beyond the
+local network.
address@hidden defvar
 These can be used only with @code{setsockopt}, not @code{getsockopt}.
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 7700cbe..126b845 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -223,6 +223,10 @@ Import modules / List those imported.
 Load a file in the current module.
 @end deffn
address@hidden {REPL Command} reload [module]
+Reload the given module, or the current module if none was given.
address@hidden deffn
 @deffn {REPL Command} binding
 List current bindings.
 @end deffn
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 47025c5..ea5cd46 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -816,19 +816,23 @@ Return the given request header, or @var{default} if none 
was present.
 @code{(web server)} is a generic web server interface, along with a main
 loop implementation for web servers controlled by Guile.
-The lowest layer is the <server-impl> object, which defines a set of
-hooks to open a server, read a request from a client, write a
-response to a client, and close a server.  These hooks -- open,
-read, write, and close, respectively -- are bound together in a
-<server-impl> object.  Procedures in this module take a
-<server-impl> object, if needed.
-A <server-impl> may also be looked up by name.  If you pass the
address@hidden symbol to @code{run-server}, Guile looks for a variable named
address@hidden in the @code{(web server http)} module, which should be bound to 
-<server-impl> object.  Such a binding is made by instantiation of
-the @code{define-server-impl} syntax.  In this way the run-server loop can
-automatically load other backends if available.
+(use-modules (web server))
address@hidden example
+The lowest layer is the @code{<server-impl>} object, which defines a set
+of hooks to open a server, read a request from a client, write a
+response to a client, and close a server.  These hooks -- @code{open},
address@hidden, @code{write}, and @code{close}, respectively -- are bound
+together in a @code{<server-impl>} object.  Procedures in this module take a
address@hidden<server-impl>} object, if needed.
+A @code{<server-impl>} may also be looked up by name.  If you pass the
address@hidden symbol to @code{run-server}, Guile looks for a variable
+named @code{http} in the @code{(web server http)} module, which should
+be bound to a @code{<server-impl>} object.  Such a binding is made by
+instantiation of the @code{define-server-impl} syntax.  In this way the
+run-server loop can automatically load other backends if available.
 The life cycle of a server goes as follows:
@@ -840,11 +844,11 @@ server socket object, or signals an error.
 The @code{read} hook is called, to read a request from a new client.
-The @code{read} hook takes one arguments, the server socket.  It
-should return three values: an opaque client socket, the
-request, and the request body. The request should be a
address@hidden<request>} object, from @code{(web request)}.  The body should be 
-string or a bytevector, or @code{#f} if there is no body.
+The @code{read} hook takes one argument, the server socket.  It should
+return three values: an opaque client socket, the request, and the
+request body. The request should be a @code{<request>} object, from
address@hidden(web request)}.  The body should be a string or a bytevector, or
address@hidden if there is no body.
 If the read failed, the @code{read} hook may return #f for the client
 socket, request, and body.
@@ -872,7 +876,12 @@ If the user interrupts the loop, the @code{close} hook is 
called on
 the server socket.
 @end enumerate
+A user may define a server implementation with the following form:
 @defun define-server-impl name open read write close
+Make a @code{<server-impl>} object with the hooks @var{open},
address@hidden, @var{write}, and @var{close}, and bind it to the symbol
address@hidden in the current module.
 @end defun
 @defun lookup-server-impl impl
@@ -885,6 +894,12 @@ Currently a server implementation is a somewhat opaque 
type, useful only
 for passing to other procedures in this module, like @code{read-client}.
 @end defun
+The @code{(web server)} module defines a number of routines that use
address@hidden<server-impl>} objects to implement parts of a web server.  Given
+that we don't expose the accessors for the various fields of a
address@hidden<server-impl>}, indeed these routines are the only procedures with
+any access to the impl objects.
 @defun open-server impl open-params
 Open a server for the given implementation. Returns one value, the new
 server object. The implementation's @code{open} procedure is applied to
@@ -943,6 +958,8 @@ Release resources allocated by a previous invocation of
 @end defun
+Given the procedures above, it is a small matter to make a web server:
 @defun serve-one-client handler impl server state
 Read one request from @var{server}, call @var{handler} on the request
 and body, and write the response to the client. Returns the new state
@@ -978,28 +995,212 @@ The default server implementation is @code{http}, which 
 Server" in the manual, for more information.
 @end defun
address@hidden Web Examples
address@hidden Web Examples
+Well, enough about the tedious internals.  Let's make a web application!
address@hidden Hello, World!
+The first program we have to write, of course, is ``Hello, World!''.
+This means that we have to implement a web handler that does what we
+Now we define a handler, a function of two arguments and two return
+(define (handler request request-body)
+  (values @var{response} @var{response-body}))
address@hidden example
+In this first example, we take advantage of a short-cut, returning an
+alist of headers instead of a proper response object. The response body
+is our payload:
+(define (hello-world-handler request request-body)
+  (values '((content-type . ("text/plain")))
+          "Hello World!"))
address@hidden example
+Now let's test it, by running a server with this handler. Load up the
+web server module if you haven't yet done so, and run a server with this
 (use-modules (web server))
+(run-server hello-world-handler)
 @end example
+By default, the web server listens for requests on
address@hidden:8080}.  Visit that address in your web browser to
+test.  If you see the string, @code{Hello World!}, sweet!
address@hidden Web Examples
address@hidden Web Examples
address@hidden Inspecting the Request
-This section has yet to be written, really. But for now, try this:
+The Hello World program above is a general greeter, responding to all
+URIs.  To make a more exclusive greeter, we need to inspect the request
+object, and conditionally produce different results.  So let's load up
+the request, response, and URI modules, and do just that.
- (use-modules (web server))
+(use-modules (web server)) ; you probably did this already
+(use-modules (web request)
+             (web response)
+             (web uri))
+(define (request-path-components request)
+  (split-and-decode-uri-path (uri-path (request-uri request))))
+(define (hello-hacker-handler request body)
+  (if (equal? (request-path-components request)
+              '("hacker"))
+      (values '((content-type . ("text/plain")))
+              "Hello hacker!")
+      (not-found request)))
+(run-server hello-hacker-handler)
address@hidden example
- (define (handler request body)
-   (values '((content-type . ("text/plain")))
-           "Hello, World!"))
- (run-server handler)
+Here we see that we have defined a helper to return the components of
+the URI path as a list of strings, and used that to check for a request
+to @code{/hacker/}. Then the success case is just as before -- visit
address@hidden://localhost:8080/hacker/} in your browser to check.
+You should always match against URI path components as decoded by
address@hidden The above example will work for
address@hidden/hacker/}, @code{//hacker///}, and @code{/h%61ck%65r}.
+But we forgot to define @code{not-found}!  If you are pasting these
+examples into a REPL, accessing any other URI in your web browser will
+drop your Guile console into the debugger:
+<unnamed port>:38:7: In procedure module-lookup:
+<unnamed port>:38:7: Unbound variable: not-found
+Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
+scheme@@(guile-user) [1]> 
address@hidden example
+So let's define the function, right there in the debugger.  As you
+probably know, we'll want to return a 404 response.
+;; Paste this in your REPL
+(define (not-found request)
+  (values (build-response #:code 404)
+          (string-append "Resource not found: "
+                         (unparse-uri (request-uri request)))))
+;; Now paste this to let the web server keep going:
address@hidden example
+Now if you access @code{http://localhost/foo/}, you get this error
+message.  (Note that some popular web browsers won't show
+server-generated 404 messages, showing their own instead, unless the 404
+message body is long enough.)
address@hidden Higher-Level Interfaces
+The web handler interface is a common baseline that all kinds of Guile
+web applications can use.  You will usually want to build something on
+top of it, however, especially when producing HTML.  Here is a simple
+example that builds up HTML output using SXML (@pxref{sxml simple}).
+First, load up the modules:
+(use-modules (web server)
+             (web request)
+             (web response)
+             (sxml simple))
address@hidden example
+Now we define a simple templating function that takes a list of HTML
+body elements, as SXML, and puts them in our super template:
+(define (templatize title body)
+  `(html (head (title ,title))
+         (body ,@@body)))
 @end example
-Then visit @code{http://localhost:8080/} on your web browser.  Let us
-know how it goes!
+For example, the simplest Hello HTML can be produced like this:
+(sxml->xml (templatize "Hello!" '((b "Hi!"))))
address@hidden example
+Much better to work with Scheme data types than to work with HTML as
+strings. Now we define a little response helper:
+(define* (respond #:optional body #:key
+                  (status 200)
+                  (title "Hello hello!")
+                  (doctype "<!DOCTYPE html>\n")
+                  (content-type-params '(("charset" . "utf-8")))
+                  (content-type "text/html")
+                  (extra-headers '())
+                  (sxml (and body (templatize title 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))))))
address@hidden example
+Here we see the power of keyword arguments with default initializers. By
+the time the arguments are fully parsed, the @code{sxml} local variable
+will hold the templated SXML, ready for sending out to the client.
+Instead of returning the body as a string, here we give a procedure,
+which will be called by the web server to write out the response to the
+Now, a simple example using this responder, which lays out the incoming
+headers in an HTML table.
+(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)
address@hidden example
+Now if you visit any local address in your web browser, we actually see
+some HTML, finally.
address@hidden Conclusion
+Well, this is about as far as Guile's built-in web support goes, for
+now.  There are many ways to make a web application, but hopefully by
+standardizing the most fundamental data types, users will be able to
+choose the approach that suits them best, while also being able to
+switch between implementations of the server.  This is a relatively new
+part of Guile, so if you have feedback, let us know, and we can take it
+into account.  Happy hacking on the web!
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 6d048a0..3e71700 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -181,10 +181,10 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
 #undef FUNC_NAME
-SCM_DEFINE (scm_make_undefined_fluid, "make-undefined-fluid", 0, 0, 0,
+SCM_DEFINE (scm_make_unbound_fluid, "make-unbound-fluid", 0, 0, 0,
-            "")
-#define FUNC_NAME s_scm_make_undefined_fluid
+            "Make a fluid that is initially unbound.")
+#define FUNC_NAME s_scm_make_unbound_fluid
   SCM f = new_fluid ();
   scm_fluid_set_x (f, SCM_UNDEFINED);
diff --git a/libguile/fluids.h b/libguile/fluids.h
index db82203..66e3985 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -60,7 +60,7 @@
 SCM_API SCM scm_make_fluid (void);
-SCM_API SCM scm_make_undefined_fluid (void);
+SCM_API SCM scm_make_unbound_fluid (void);
 SCM_API int scm_is_fluid (SCM obj);
 SCM_API SCM scm_fluid_p (SCM fl);
 SCM_API SCM scm_fluid_ref (SCM fluid);
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 1b2985d..90ea7e0 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2276,6 +2276,7 @@ VALUE."
   (try-module-autoload name version))
 (define (reload-module m)
+  "Revisit the source file corresponding to the module @var{m}."
   (let ((f (module-filename m)))
     (if f
@@ -3344,8 +3345,10 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; FIXME:
 (module-use! the-scm-module (resolve-interface '(srfi srfi-4)))
+;; Set filename to #f to prevent reload.
 (define-module (guile-user)
-  #:autoload (system base compile) (compile compile-file))
+  #:autoload (system base compile) (compile compile-file)
+  #:filename #f)
 ;; Remain in the `(guile)' module at compilation-time so that the
 ;; `-Wunused-toplevel' warning works as expected.
diff --git a/module/language/elisp/runtime.scm 
index 47306e6..025dc96 100644
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -73,7 +73,7 @@
   (let ((intf (resolve-interface module))
         (resolved (resolve-module module)))
     (if (not (module-defined? intf sym))
-        (let ((fluid (make-undefined-fluid)))
+        (let ((fluid (make-unbound-fluid)))
           (module-define! resolved sym fluid)
           (module-export! resolved `(,sym))))))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 08f1c9e..2897b9b 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -50,7 +50,7 @@
 (define *command-table*
   '((help     (help h) (show) (apropos a) (describe d))
-    (module   (module m) (import use) (load l) (binding b) (in))
+    (module   (module m) (import use) (load l) (reload re) (binding b) (in))
     (language (language L))
     (compile  (compile c) (compile-file cc)
              (disassemble x) (disassemble-file xx))
@@ -391,6 +391,15 @@ Import modules / List those imported."
 Load a file in the current module."
   (load (->string file)))
+(define-meta-command (reload repl . args)
+  "reload [MODULE]
+Reload the given module, or the current module if none was given."
+  (pmatch args
+    (() (reload-module (current-module)))
+    ((,mod-name) (guard (list? mod-name))
+     (reload-module (resolve-module mod-name)))
+    (,mod-name (reload-module (resolve-module mod-name)))))
 (define-meta-command (binding repl)
 List current bindings."
diff --git a/module/web/response.scm b/module/web/response.scm
index 295b2f4..7acde1e 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -93,10 +93,41 @@
 (define (bad-response message . args)
   (throw 'bad-response message args))
+(define (non-negative-integer? n)
+  (and (number? n) (>= n 0) (exact? n) (integer? n)))
+(define (validate-headers headers)
+  (if (pair? headers)
+      (let ((h (car headers)))
+        (if (pair? h)
+            (let ((k (car h)) (v (cdr h)))
+              (if (symbol? k)
+                  (if (not (valid-header? k v))
+                      (bad-response "Bad value for header ~a: ~s" k v))
+                  (if (not (and (string? k) (string? v)))
+                      (bad-response "Unknown header not a pair of strings: ~s"
+                                    h)))
+              (validate-headers (cdr headers)))
+            (bad-response "Header not a pair: ~a" h)))
+      (if (not (null? headers))
+          (bad-response "Headers not a list: ~a" headers))))
 (define* (build-response #:key (version '(1 . 1)) (code 200) reason-phrase
-                         (headers '()) port)
+                         (headers '()) port (validate-headers? #t))
   "Construct an HTTP response object. If @var{validate-headers?} is true,
 the headers are each run through their respective validators."
+  (cond
+   ((not (and (pair? version)
+              (non-negative-integer? (car version))
+              (non-negative-integer? (cdr version))))
+    (bad-response "Bad version: ~a" version))
+   ((not (and (non-negative-integer? code) (< code 600)))
+    (bad-response "Bad code: ~a" code))
+   ((and reason-phrase (not (string? reason-phrase)))
+    (bad-response "Bad reason phrase" reason-phrase))
+   (else
+    (if validate-headers?
+        (validate-headers headers))))
   (make-response version code reason-phrase headers port))
 (define (extend-response r k v . additional)

GNU Guile

reply via email to

[Prev in Thread] Current Thread [Next in Thread]