diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index 862b9f4..f4eedc3 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -193,6 +193,9 @@ options) ))))) + +;;; REDIRECT-REQUEST relies on that nothing is read out from SOCKET. + (define (redirect-request req response socket options) (let* ((new-location-uri (redirect-body-location (response-body response))) (url (with-fatal-error-handler* @@ -251,46 +254,12 @@ (else (fatal-syntax-error "Bad Request Line.")))) (meth (car 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)) '() (read-rfc822-headers (socket:inport 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 # 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 (let ((re (make-regexp "^HTTP/([0-9]+)\\.([0-9]+)$"))