scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*remove definition of PARSE-REQUEST-URI (relict of Olin's old URL parser) 

*use URI-STRING->HTTP-URL instead
This commit is contained in:
vibr 2005-04-04 21:07:55 +00:00
parent d864e4da80
commit 46645ccd58
1 changed files with 4 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
scheme/httpd/core.scm
View File

@ -193,6 +193,9 @@
options) options)
))))) )))))
;;; REDIRECT-REQUEST relies on that nothing is read out from SOCKET.
(define (redirect-request req response socket options) (define (redirect-request req response socket options)
(let* ((new-location-uri (redirect-body-location (response-body response))) (let* ((new-location-uri (redirect-body-location (response-body response)))
(url (with-fatal-error-handler* (url (with-fatal-error-handler*
@ -251,46 +254,12 @@
(else (fatal-syntax-error "Bad Request Line.")))) (else (fatal-syntax-error "Bad Request Line."))))
(meth (car elts)) (meth (car elts))
(request-uri (cadr elts)) (request-uri (cadr elts))
(url (parse-request-uri request-uri sock options)) (url (uri-string->http-url request-uri))
(headers (if (equal? version '(0 . 9)) (headers (if (equal? version '(0 . 9))
'() '()
(read-rfc822-headers (socket:inport sock))))) (read-rfc822-headers (socket:inport sock)))))
(make-request meth request-uri url version headers sock))))) (make-request meth request-uri url version headers sock)))))
;;; Parse the URI, but if it begins without the "http://host:port"
;;; prefix, interpolate one from SOCKET. It would be sleazier but
;;; faster if we just computed the default host and port at
;;; server-startup time, instead of on every request.
;;; REDIRECT-REQUEST relys on that nothing is read out from SOCKET.
(define (parse-request-uri request-uri socket options)
(receive (scheme path search frag-id) (parse-uri request-uri)
(if frag-id ; Can't have a #frag part.
(fatal-syntax-error "HTTP URL contains illegal #<fragment> suffix."
request-uri)
(if scheme
(if (string-ci=? scheme "http") ; Better be an http url.
(parse-http-url path search #f)
(fatal-syntax-error "Non-HTTP URL" request-uri))
;; Interpolate the server struct from our net connection.
(if (and (pair? path) (string=? (car path) ""))
(let* ((addr (socket-local-address socket))
(local-name (or (httpd-options-fqdn options)
(socket-address->fqdn addr)))
(portnum (or (httpd-options-reported-port options)
(my-reported-port addr))))
(make-http-url (make-server #f #f
local-name
(number->string portnum))
(map unescape-uri (cdr path)) ; Skip initial /.
search
#f))
(fatal-syntax-error "Path fragment must begin with slash"
request-uri))))))
(define parse-http-version (define parse-http-version
(let ((re (make-regexp "^HTTP/([0-9]+)\\.([0-9]+)$")) (let ((re (make-regexp "^HTTP/([0-9]+)\\.([0-9]+)$"))