if the path is empty, use /

svn: r12750
This commit is contained in:
Eli Barzilay 2008-12-09 02:39:45 +00:00
parent da7b6978ee
commit 169c69a0bc

View File

@ -103,30 +103,33 @@
;; http://getpost-impure-port : bool x url x union (str, #f) x list (str) -> in-port
(define (http://getpost-impure-port get? url post-data strings)
(let*-values
([(proxy) (assoc (url-scheme url) (current-proxy-servers))]
[(server->client client->server) (make-ports url proxy)]
[(access-string) (url->string
(if proxy
url
(make-url #f #f #f #f
(url-path-absolute? url)
(url-path url)
(url-query url)
(url-fragment url))))])
(define (println . xs)
(for-each (lambda (x) (display x client->server)) xs)
(display "\r\n" client->server))
(println (if get? "GET " "POST ") access-string " HTTP/1.0")
(println "Host: " (url-host url)
(let ([p (url-port url)]) (if p (format ":~a" p) "")))
(when post-data (println "Content-Length: " (bytes-length post-data)))
(for-each println strings)
(println)
(when post-data (display post-data client->server))
(flush-output client->server)
(tcp-abandon-port client->server)
server->client))
(define proxy (assoc (url-scheme url) (current-proxy-servers)))
(define-values (server->client client->server) (make-ports url proxy))
(define access-string
(url->string
(if proxy
url
;; RFCs 1945 and 2616 say:
;; Note that the absolute path cannot be empty; if none is present in
;; the original URI, it must be given as "/" (the server root).
(let-values ([(abs? path)
(if (null? (url-path url))
(values #t (list (make-path/param "" '())))
(values (url-path-absolute? url) (url-path url)))])
(make-url #f #f #f #f abs? path (url-query url) (url-fragment url))))))
(define (println . xs)
(for-each (lambda (x) (display x client->server)) xs)
(display "\r\n" client->server))
(println (if get? "GET " "POST ") access-string " HTTP/1.0")
(println "Host: " (url-host url)
(let ([p (url-port url)]) (if p (format ":~a" p) "")))
(when post-data (println "Content-Length: " (bytes-length post-data)))
(for-each println strings)
(println)
(when post-data (display post-data client->server))
(flush-output client->server)
(tcp-abandon-port client->server)
server->client)
(define (file://->path url [kind (system-path-convention-type)])
(let ([strs (map path/param-path (url-path url))]