Check for correct content-type in GET-BINDINGS. Raise an error if it is not correct.

This commit is contained in:
interp 2003-06-03 07:36:48 +00:00
parent d36409fddc
commit 575dd18f03
2 changed files with 17 additions and 3 deletions

View File

@ -9,7 +9,21 @@
(define *cache-lock* (make-lock)) (define *cache-lock* (make-lock))
(define (get-bindings surflet-request) (define (get-bindings surflet-request)
(let ((request-method (surflet-request-method surflet-request))) (let ((request-method (surflet-request-method surflet-request))
(content-type (assoc "content-type"
(surflet-request-headers surflet-request))))
;; Check if we the content-type is the one we support. If there's
;; no content-type, assume the default (this is the one we
;; support).
(if (and content-type
;; Have to string-trim now, because the (buggy?) rfc822
;; implementation leaves the leading whitespace of the
;; header value.
(not (string=? (string-trim (cdr content-type))
"application/x-www-form-urlencoded")))
(error "get-bindings currently only supports
'application/x-www-form-urlencoded' as content-type"))
(cond (cond
((string=? request-method "GET") ((string=? request-method "GET")
(form-query-list (http-url-search (form-query-list (http-url-search

View File

@ -25,7 +25,7 @@
;; SUrflet-requests as expected from the surflet handler ;; SUrflet-requests as expected from the surflet handler
(define-interface surflet-handler/requests-interface (define-interface surflet-handler/requests-interface
(export make-surflet-request ;FIMXE? unusable for user (export make-surflet-request ;FIXME? unusable for user
surflet-request? surflet-request?
surflet-request-request surflet-request-request
surflet-request-input-port surflet-request-input-port
@ -662,7 +662,7 @@
surflet-requests surflet-requests
(subset url (http-url-search)) (subset url (http-url-search))
(subset srfi-14 (char-set:digit)) (subset srfi-14 (char-set:digit))
(subset srfi-13 (string-index)) (subset srfi-13 (string-index string-trim))
(subset srfi-1 (filter)) (subset srfi-1 (filter))
(subset sunet-utilities (get-header))) (subset sunet-utilities (get-header)))
(files bindings)) (files bindings))