aliens/tekuti
1
0
Fork 0
Code Activity

Convert the mod-lisp headers to lowercase

Browse source 
HTTP headers are expected to be treated case-insensitively.
This commit is contained in:
Andreas Rottmann 2009-07-02 19:47:30 +02:00
parent d52865f037
commit eac799afc3
3 changed files with 5 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
tekuti/mod-lisp.scm
View file

@ -45,7 +45,8 @@
(let ((k (read-line*))) (let ((k (read-line*)))
(if (string=? k "end") (if (string=? k "end")
(reverse (map cons keys values)) (reverse (map cons keys values))
(lp (cons k keys) (cons (read-line*) values)))))) (lp (cons (string-downcase k) keys)
(cons (read-line*) values))))))
(define (read-chars nchars port) (define (read-chars nchars port)
(let ((buf (make-string nchars))) (let ((buf (make-string nchars)))

2
tekuti/page.scm
View file

@ -308,7 +308,7 @@
(server-name (request-server-name request))) (server-name (request-server-name request)))
(cond (cond
((let ((since (assoc-ref (rref request 'headers '()) ((let ((since (assoc-ref (rref request 'headers '())
"If-Modified-Since"))) "if-modified-since")))
(and since (>= (rfc822-date->timestamp since) last-modified))) (and since (>= (rfc822-date->timestamp since) last-modified)))
(rcons* request (rcons* request
'status 304 'status 304

4
tekuti/request.scm
View file

@ -118,7 +118,7 @@
;; danger here, regarding the optional alternate clauses... ;; danger here, regarding the optional alternate clauses...
(define (request-authenticated? request) (define (request-authenticated? request)
(let ((headers (rref request 'headers '()))) (let ((headers (rref request 'headers '())))
(let ((auth (assoc-ref headers "Authorization"))) (let ((auth (assoc-ref headers "authorization")))
(and auth (and auth
(match-bind "^Basic ([A-Za-z0-9+/=]*)$" auth (_ b64) (match-bind "^Basic ([A-Za-z0-9+/=]*)$" auth (_ b64)
(match-bind "^([^:]*):(.*)$" (match-bind "^([^:]*):(.*)$"
@ -193,7 +193,7 @@
(define (request-server-name request) (define (request-server-name request)
(let ((headers (rref request 'headers))) (let ((headers (rref request 'headers)))
(or (assoc-ref headers "Host") (or (assoc-ref headers "host")
(assoc-ref headers "server-ip-addr")))) (assoc-ref headers "server-ip-addr"))))