summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-03-11 10:24:08 +0100
committerAndy Wingo <wingo@pobox.com>2012-03-11 10:24:08 +0100
commitaaaa0eef9cfdb426f0b0fb4423fc25b655b722a4 (patch)
treebedf4e9d4cd4d4eaa1bf257ac8b8c3a07b0e5fdb
parentbc612809929b85fdcb39bc17a15a53c88b43a8bd (diff)
downloadguile-aaaa0eef9cfdb426f0b0fb4423fc25b655b722a4.tar.gz
add exception printers for bad-header, bad-header-component
* module/web/http.scm (bad-header-component): Throw 'bad-header-component instead of 'bad-header. (bad-header-printer, bad-header-component-printer): Add exception printers.
-rw-r--r--module/web/http.scm17
1 files changed, 16 insertions, 1 deletions
diff --git a/module/web/http.scm b/module/web/http.scm
index 10c5fcf77..80f972ba5 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -240,7 +240,22 @@ ordered alist."
(define (bad-header sym val)
(throw 'bad-header sym val))
(define (bad-header-component sym val)
- (throw 'bad-header sym val))
+ (throw 'bad-header-component sym val))
+
+(define (bad-header-printer port key args default-printer)
+ (apply (case-lambda
+ ((sym val)
+ (format port "Bad ~a header: ~a\n" (header->string sym) val))
+ (_ (default-printer)))
+ args))
+(define (bad-header-component-printer port key args default-printer)
+ (apply (case-lambda
+ ((sym val)
+ (format port "Bad ~a header component: ~a\n" sym val))
+ (_ (default-printer)))
+ args))
+(set-exception-printer! 'bad-header bad-header-printer)
+(set-exception-printer! 'bad-header-component bad-header-component-printer)
(define (parse-opaque-string str)
str)