aliens/tekuti
1
0
Fork 0
Code Activity

fixes due to (web http) updates

Browse source
This commit is contained in:
Aleix Conchillo Flaque 2011-01-11 16:17:58 +01:00 committed by Andy Wingo
parent a357b2a0dc
commit 2a87435f81
2 changed files with 15 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
tekuti/page-helpers.scm
View file

@ -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)

20
tekuti/request.scm
View file

@ -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