Accept custom request headers.

src/clojure/http/client.clj

@@ -4,34 +4,38 @@
         [clojure.contrib.str-utils :only [str-join]])
   (:import (java.net URL HttpURLConnection)))
 
-(defn create-url
+(def default-headers {"User-Agent" (str "Clojure/" (clojure-version)
+                                        " (+http://clojure.org)"),
+                      "Connection" "close",
+                      "Accept" ""})
+
+(defn url
   "If url is an instance of java.net.URL then returns it without
 modification, otherwise tries to instantiate a java.net.URL with
 url as its sole argument."
-  [url]
-  (if (instance? URL url)
-    url
-    (URL. url)))
+  [u]
+  (if (instance? URL u)
+    u
+    (URL. u)))
 
-(defn body-seq
-  "Returns a lazy-seq of lines from either (.getErrorStream url)
-or (.getInputStream url), whichever is appropriate."
-  [url]
-  (try
-   (let [stream (if (>= (.getResponseCode url) 400)
-                  (.getErrorStream url)
-                  (.getInputStream url))]
-     (read-lines stream))))
+(defn- body-seq
+  "Returns a lazy-seq of lines from either the input stream
+or the error stream of connection, whichever is appropriate."
+  [connection]
+  (read-lines (if (>= (.getResponseCode connection) 400)
+                (.getErrorStream connection)
+                (.getInputStream connection))))
 
-(defn parse-headers
-  "Returns a map of the response headers from url."
-  [url]
-  (let [hs (.getHeaderFields url)]
+(defn- parse-headers
+  "Returns a map of the response headers from connection."
+  [connection]
+  ;; TODO: headers should be case-insensitive map according to spec
+  (let [hs (.getHeaderFields connection)]
     (apply merge (map (fn [e] (when-let [k (key e)]
                                 {k (first (val e))}))
                       hs))))
 
-(defn parse-cookies
+(defn- parse-cookies
   "Returns a map of cookies when given the Set-Cookie string sent
 by a server."
   [cookie-string]
@@ -53,37 +57,27 @@ by a server."
                       cookie-map)))
 
 (defn request
-  "Perform an HTTP request on url."
-  [url & [method cookies]]
-  ;; url should be named connection?
-  (let [url (.openConnection (create-url url))
+  "Perform an HTTP request on url u."
+  [u & [method headers cookies]]
+  (let [connection (.openConnection (url u))
         method (.toUpperCase (as-str (or method
                                          "GET")))]
-    (.setRequestMethod url method)
-    (.setRequestProperty url
-                         "User-Agent"
-                         "Clojure/pre-1.0 (+http://clojure.org)")
-    (.setRequestProperty url
-                         "Connection"
-                         "close")
-    (.setRequestProperty url
-                         "Accept"
-                         "")
+    (.setRequestMethod connection method)
+
+    (doseq [header (conj default-headers (or headers {}))]
+      (.setRequestProperty connection
+                           (first header)
+                           (second header)))
+
     (when cookies
-      (.setRequestProperty url
+      (.setRequestProperty connection
                            "Cookie"
                            (create-cookie-string cookies)))
-    (.connect url)
-    (let [headers (parse-headers url)]
-      {:body-seq (body-seq url)
-       :code (.getResponseCode url)
-       :msg (.getResponseMessage url)
+    (.connect connection)
+    (let [headers (parse-headers connection)]
+      {:body-seq (body-seq connection)
+       :code (.getResponseCode connection)
+       :msg (.getResponseMessage connection)
        :headers (dissoc headers "Set-Cookie")
        :cookies (parse-cookies (get headers "Set-Cookie" nil))
-       :url (str (.getURL url))})))
-
-;; (use '(clojure.contrib pprint))
-
-;; (pprint
-;;  (request "http://localhost:2000/" :get
-;;           {"Path" "/", "sessionid" "689ac1e1b6e54c8d0f3eb8b063fc0e8f"}))
+       :url (str (.getURL connection))})))

test/clojure/http/test/client.clj

@@ -34,8 +34,12 @@
 (defonce server (create-server test-port echo-http-response))
 
 (deftest simple-get
-  (let [response (request (format "http://localhost:%s/" test-port)
-                          :get {"Path" "/"})]
+  (let [response (request (str "http://localhost:" test-port))]
     (is (= "OK" (:msg response)))
     (is (= 200 (:code response)))
-    (is (= "GET / HTTP/1.1" (first (:body-seq response))))))
+    (is (= "GET / HTTP/1.1" (first (:body-seq response))))))
+
+(deftest custom-header-get
+  (let [response (request (str "http://localhost:" test-port)
+                          :get {"How-Awesome" "very"})]
+    (is (some #{"How-Awesome: very"} (:body-seq response)))))