summaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
authorGravatar Aleix Conchillo Flaque2011-01-11 16:17:58 +0100
committerGravatar Andy Wingo2011-02-18 23:34:27 +0100
commit2a87435f81cc2ef0e0b1b7c749bb029ae6fac5be (patch)
treeeb589313d2a257c245b542fb53bf04387162be51
parenta357b2a0dc0d4b109df8e9207d0fcc90a214d2d3 (diff)
downloadtekuti-2a87435f81cc2ef0e0b1b7c749bb029ae6fac5be.tar.gz
tekuti-2a87435f81cc2ef0e0b1b7c749bb029ae6fac5be.zip
fixes due to (web http) updates
-rw-r--r--tekuti/page-helpers.scm11
-rw-r--r--tekuti/request.scm20
2 files changed, 15 insertions, 16 deletions
diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm
index 5d2b7cc..07405a5 100644
--- a/tekuti/page-helpers.scm
+++ b/tekuti/page-helpers.scm
@@ -82,8 +82,8 @@
last-modified
etag
(doctype xhtml-doctype)
- (content-type-params '(("charset" . "utf-8")))
- (content-type "text/html")
+ (content-type-params '((charset . "utf-8")))
+ (content-type 'text/html)
(extra-headers '())
(sxml (and body (templatize #:title title #:body body))))
(values (build-response
@@ -378,9 +378,10 @@
(define (with-authentication request thunk)
(if (request-authenticated? request)
(thunk)
- (respond `((p "Authentication required, yo"))
- #:status 401
- #:extra-headers '((www-authenticate . "Basic realm=\"Tekuti\"")))))
+ (let ((header (parse-header 'www-authenticate "Basic realm=\"Tekuti\"")))
+ (respond `((p "Authentication required, yo"))
+ #:status 401
+ #:extra-headers `((www-authenticate . ,header))))))
(define (atom-header last-modified)
(define (relurl . tail)
diff --git a/tekuti/request.scm b/tekuti/request.scm
index 736111b..1a84e34 100644
--- a/tekuti/request.scm
+++ b/tekuti/request.scm
@@ -47,9 +47,9 @@
(lambda (piece)
(let ((equals (string-index piece #\=)))
(if equals
- (cons (uri-decode (substring piece 0 equals) #:charset charset)
- (uri-decode (substring piece (1+ equals)) #:charset charset))
- (cons (uri-decode piece #:charset charset) ""))))
+ (cons (uri-decode (substring piece 0 equals) #:encoding charset)
+ (uri-decode (substring piece (1+ equals)) #:encoding charset))
+ (cons (uri-decode piece #:encoding charset) ""))))
(string-split str #\&)))
(define (request-relative-path r)
@@ -88,7 +88,7 @@
(charset (or (assoc-ref (cdr content-type) "charset")
"utf-8")))
(cond
- ((equal? (car content-type) "application/x-www-form-urlencoded")
+ ((equal? (car content-type) 'application/x-www-form-urlencoded)
(parse-www-form-urlencoded body charset))
(else
(error "bad content-type" content-type)))))))
@@ -97,13 +97,11 @@
(define (request-authenticated? request)
(let ((auth (request-authorization request)))
(and auth
- (match-bind "^Basic ([A-Za-z0-9+/=]*)$" auth (_ b64)
- (match-bind "^([^:]*):(.*)$"
- (utf8->string (base64-decode b64))
- (_ user pass)
- (and (equal? user *admin-user*)
- (equal? pass *admin-pass*))
- #f)
+ (match-bind "^([^:]*):(.*)$"
+ (utf8->string (base64-decode (cdr auth)))
+ (_ user pass)
+ (and (equal? user *admin-user*)
+ (equal? pass *admin-pass*))
#f))))
(define-syntax path-proc-case