From ac1f721985f5f123bde21838a36b9f3b54742220 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 9 Dec 2008 02:39:45 +0000
Subject: [PATCH] if the path is empty, use /

svn: r12750

original commit: 169c69a0bc6d0faff5473b75ff6ee17bef45ae84
---
 collects/net/url-unit.ss | 51 +++++++++++++++++++++-------------------
 1 file changed, 27 insertions(+), 24 deletions(-)

diff --git a/collects/net/url-unit.ss b/collects/net/url-unit.ss
index 986012c..b7773be 100644
--- a/collects/net/url-unit.ss
+++ b/collects/net/url-unit.ss
@@ -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))]