method: ~a" (substring str start end))))) (define* (parse-request-uri str #:optional (start 0) (end (string-length str))) "Parse a URI from an HTTP request line. Note that URIs in requests do not have to have a scheme or host name. The result is a URI-reference object." (cond ((= start end) (bad-request "Missing Request-URI")) ((string= str "*" start end) #f) ((eqv? (string-ref str start) #\/) (let* ((q (string-index str #\? start end)) (f (string-index str #\# start end)) (q (and q (or (not f) (< q f)) q))) (build-uri-reference #:path (substring str start (or q f end)) #:query (and q (substring str (1+ q) (or f end))) #:fragment (and f (substring str (1+ f) end))))) (else (or (string->uri (substring str start end)) (bad-request "Invalid URI: ~a" (substring str start end)))))) (define (read-request-line port) "Read the first line of an HTTP request from PORT, returning three values: the method, the URI, and the version." (let* ((line (read-header-line port)) (d0 (string-index line char-set:whitespace)) ; "delimiter zero" (d1 (string-rindex line char-set:whitespace))) (unless (and d0 d1 (< d0 d1)) (bad-request "Bad Request-Line: ~s" line)) (values (parse-http-method line 0 d0) (parse-request-uri line (skip-whitespace line (1+ d0) d1) d1) (parse-http-version line (1+ d1) (string-length line))))) (define (write-uri uri port) (put-string port (uri->string uri #:include-fragment? #f))) (define (write-request-line method uri version port) "Write the first line of an HTTP request to PORT." (put-symbol port method) (put-char port #\space) (when (http-proxy-port? port) (let ((scheme (uri-scheme uri)) (host (uri-host uri)) (host-port (uri-port uri))) (when (and scheme host) (put-symbol port scheme) (put-string port "://") (cond ((string-index host #\:) (put-char port #\[) (put-string port host) (put-char port #\])) (else (put-string port host))) (unless ((@@ (web uri) default-port?) scheme host-port) (put-char port #\:) (put-non-negative-integer port host-port))))) (let ((path (uri-path uri)) (query (uri-query uri))) (if (string-null? path) (put-string port "/") (put-string port path)) (when query (put-string port "?") (put-string port query))) (put-char port #\space) (write-http-version version port) (put-string port "\r\n")) (define (read-response-line port) "Read the first line of an HTTP response from PORT, returning three values: the HTTP version, the response code, and the (possibly empty) \"reason phrase\"." (let* ((line (read-header-line port)) (d0 (string-index line char-set:whitespace)) ; "delimiter zero" (d1 (and d0 (string-index line char-set:whitespace (skip-whitespace line d0))))) (unless (and d0 d1) (bad-response "Bad Response-Line: ~s" line)) (values (parse-http-version line 0 d0) (parse-non-negative-integer line (skip-whitespace line d0 d1) d1) (string-trim-both line char-set:whitespace d1)))) (define (write-response-line version code reason-phrase port) "Write the first line of an HTTP response to PORT." (write-http-version version port) (put-char port #\space) (put-non-negative-integer port code) (put-char port #\space) (put-string port reason-phrase) (put-string port "\r\n"))