fogus/httpcore.clj

## httpcore.clj
(ns org.apache.http.examples
 "Basic HTTP Server.
  A quick port of http://svn.apache.org/repos/asf/httpcomponents/httpcore/trunk/httpcore/src/examples/org/apache/http/examples/ElementalHttpServer.java to Clojure"
  (:import (java.io File OutputStreamWriter InterruptedIOException IOException)
           (java.net ServerSocket URLDecoder)
           (java.util Locale)
           (org.apache.http.protocol BasicHttpProcessor HttpContext BasicHttpContext HttpRequestHandler HttpRequestHandlerRegistry HttpService ResponseConnControl ResponseContent ResponseDate ResponseServer)
           (org.apache.http ConnectionClosedException HttpEntity HttpEntityEnclosingRequest HttpException HttpRequest HttpResponse HttpServerConnection HttpStatus MethodNotSupportedException)
           (org.apache.http.entity ContentProducer EntityTemplate FileEntity)
           (org.apache.http.impl DefaultConnectionReuseStrategy DefaultHttpResponseFactory DefaultHttpServerConnection)
           (org.apache.http.params BasicHttpParams CoreConnectionPNames HttpParams CoreProtocolPNames)
           (org.apache.http.util EntityUtils)))

(defn entity [& ss]
  (doto (EntityTemplate.
          (proxy [ContentProducer] []
            (writeTo [outstream]
              (let [w (OutputStreamWriter. outstream "UTF-8")]
                (doseq [s ss] (.write w s))
                (.flush w)))))
    (.setContentType "text/html; charset=UTF-8")))

(defn file-handler [docroot]
  (proxy [HttpRequestHandler] []
    (handle [request response context]
      (println "file-handler")
      (let [method (-> request .getRequestLine .getMethod (.toUpperCase Locale/ENGLISH))]
        (if-not (#{"GET" "HEAD" "POST"} method)
          (throw (MethodNotSupportedException. (str method " method not supported")))
          (let [target (-> request .getRequestLine .getUri)]
            (when (instance? HttpEntityEnclosingRequest request)
              (let [entity (.getEntity request)
                    entityContent (EntityUtils/toByteArray entity)]
                (println "Incoming entity content (bytes):" (count entityContent))))
            (let [file (File. docroot (URLDecoder/decode target))]
              (cond
                (-> file .exists not)
                  (let [body (entity "<html><body><h1>"
                               "File " (.getPath file) " not found"
                               "</h1></body></html>")]
                    (.setStatusCode response HttpStatus/SC_NOT_FOUND)
                    (.setEntity response body)
                    (println "File" (.getPath file) "not found"))
                (or (-> file .canRead not) (.isDirectory file))
                  (let [body (entity "<html><body><h1>"
                               "Access denied"
                               "</h1></body></html>")]
                    (.setStatusCode response HttpStatus/SC_FORBIDDEN)
                    (.setEntity response body)
                    (println "Cannot read file" (.getPath file)))
                :else
                  (let [body (FileEntity. file "text/html")]
                    (.setStatusCode response HttpStatus/SC_OK)
                    (.setEntity response body)
                    (println "Serving file" (.getPath file)))))))))))


(defn request-handler [httpservice conn]
  #(do
     (println "New connection thread")
     (let [context (BasicHttpContext. nil)]
       (try
         (while (.isOpen conn)
           (.handleRequest httpservice conn context))
         (catch ConnectionClosedException ex
           (println "Client closed connection"))
         (catch IOException ex
           (println "I/O error:" (.getMessage ex)))
         (catch HttpException ex
           (println "Unrecoverable HTTP protocol violation:" (.getMessage ex)))
         (finally
           (try
             (.shutdown conn)
             (catch IOException _
               nil)))))))

(defn request-listener [port docroot]
  (let [serversocket (ServerSocket. port)
        params (doto (BasicHttpParams.)
                 (.setIntParameter CoreConnectionPNames/SO_TIMEOUT 5000)
                 (.setIntParameter CoreConnectionPNames/SOCKET_BUFFER_SIZE (* 8 1024))
                 (.setBooleanParameter CoreConnectionPNames/STALE_CONNECTION_CHECK false)
                 (.setBooleanParameter CoreConnectionPNames/TCP_NODELAY true)
                 (.setParameter CoreProtocolPNames/ORIGIN_SERVER "HttpComponents/1.1"))
        httpproc (doto (BasicHttpProcessor.)
                   (.addInterceptor (ResponseDate.))
                   (.addInterceptor (ResponseServer.))
                   (.addInterceptor (ResponseContent.))
                   (.addInterceptor (ResponseConnControl.)))

        reqistry (doto (HttpRequestHandlerRegistry.)
                   (.register "*" (file-handler docroot)))

        httpservice (doto (HttpService. httpproc
                            (DefaultConnectionReuseStrategy.)
                            (DefaultHttpResponseFactory.))
                      (.setParams params)
                      (.setHandlerResolver reqistry))]

        (println "Listening on port" (.getLocalPort serversocket))
        (loop []
          (try
            (let [socket (.accept serversocket)
                  conn (doto (DefaultHttpServerConnection.)
                         (.bind socket params))]
              (doto (Thread. (request-handler httpservice conn))
                (.setDaemon true)
                (.start)))
            (catch InterruptedIOException ex
                nil)
            (catch IOException e
                (println "I/O error initialising connection thread:"
                  (.getMessage e))))
            (recur))))

(doto (Thread. #(request-listener 8080 "c:/var/www"))
      (.setDaemon false)
      (.start))
	(ns org.apache.http.examples
	"Basic HTTP Server.
	A quick port of http://svn.apache.org/repos/asf/httpcomponents/httpcore/trunk/httpcore/src/examples/org/apache/http/examples/ElementalHttpServer.java to Clojure"
	(:import (java.io File OutputStreamWriter InterruptedIOException IOException)
	(java.net ServerSocket URLDecoder)
	(java.util Locale)
	(org.apache.http.protocol BasicHttpProcessor HttpContext BasicHttpContext HttpRequestHandler HttpRequestHandlerRegistry HttpService ResponseConnControl ResponseContent ResponseDate ResponseServer)
	(org.apache.http ConnectionClosedException HttpEntity HttpEntityEnclosingRequest HttpException HttpRequest HttpResponse HttpServerConnection HttpStatus MethodNotSupportedException)
	(org.apache.http.entity ContentProducer EntityTemplate FileEntity)
	(org.apache.http.impl DefaultConnectionReuseStrategy DefaultHttpResponseFactory DefaultHttpServerConnection)
	(org.apache.http.params BasicHttpParams CoreConnectionPNames HttpParams CoreProtocolPNames)
	(org.apache.http.util EntityUtils)))

	(defn entity [& ss]
	(doto (EntityTemplate.
	(proxy [ContentProducer] []
	(writeTo [outstream]
	(let [w (OutputStreamWriter. outstream "UTF-8")]
	(doseq [s ss] (.write w s))
	(.flush w)))))
	(.setContentType "text/html; charset=UTF-8")))

	(defn file-handler [docroot]
	(proxy [HttpRequestHandler] []
	(handle [request response context]
	(println "file-handler")
	(let [method (-> request .getRequestLine .getMethod (.toUpperCase Locale/ENGLISH))]
	(if-not (#{"GET" "HEAD" "POST"} method)
	(throw (MethodNotSupportedException. (str method " method not supported")))
	(let [target (-> request .getRequestLine .getUri)]
	(when (instance? HttpEntityEnclosingRequest request)
	(let [entity (.getEntity request)
	entityContent (EntityUtils/toByteArray entity)]
	(println "Incoming entity content (bytes):" (count entityContent))))
	(let [file (File. docroot (URLDecoder/decode target))]
	(cond
	(-> file .exists not)
	(let [body (entity "<html><body><h1>"
	"File " (.getPath file) " not found"
	"</h1></body></html>")]
	(.setStatusCode response HttpStatus/SC_NOT_FOUND)
	(.setEntity response body)
	(println "File" (.getPath file) "not found"))
	(or (-> file .canRead not) (.isDirectory file))
	(let [body (entity "<html><body><h1>"
	"Access denied"
	"</h1></body></html>")]
	(.setStatusCode response HttpStatus/SC_FORBIDDEN)
	(.setEntity response body)
	(println "Cannot read file" (.getPath file)))
	:else
	(let [body (FileEntity. file "text/html")]
	(.setStatusCode response HttpStatus/SC_OK)
	(.setEntity response body)
	(println "Serving file" (.getPath file)))))))))))


	(defn request-handler [httpservice conn]
	#(do
	(println "New connection thread")
	(let [context (BasicHttpContext. nil)]
	(try
	(while (.isOpen conn)
	(.handleRequest httpservice conn context))
	(catch ConnectionClosedException ex
	(println "Client closed connection"))
	(catch IOException ex
	(println "I/O error:" (.getMessage ex)))
	(catch HttpException ex
	(println "Unrecoverable HTTP protocol violation:" (.getMessage ex)))
	(finally
	(try
	(.shutdown conn)
	(catch IOException _
	nil)))))))

	(defn request-listener [port docroot]
	(let [serversocket (ServerSocket. port)
	params (doto (BasicHttpParams.)
	(.setIntParameter CoreConnectionPNames/SO_TIMEOUT 5000)
	(.setIntParameter CoreConnectionPNames/SOCKET_BUFFER_SIZE (* 8 1024))
	(.setBooleanParameter CoreConnectionPNames/STALE_CONNECTION_CHECK false)
	(.setBooleanParameter CoreConnectionPNames/TCP_NODELAY true)
	(.setParameter CoreProtocolPNames/ORIGIN_SERVER "HttpComponents/1.1"))
	httpproc (doto (BasicHttpProcessor.)
	(.addInterceptor (ResponseDate.))
	(.addInterceptor (ResponseServer.))
	(.addInterceptor (ResponseContent.))
	(.addInterceptor (ResponseConnControl.)))

	reqistry (doto (HttpRequestHandlerRegistry.)
	(.register "*" (file-handler docroot)))

	httpservice (doto (HttpService. httpproc
	(DefaultConnectionReuseStrategy.)
	(DefaultHttpResponseFactory.))
	(.setParams params)
	(.setHandlerResolver reqistry))]

	(println "Listening on port" (.getLocalPort serversocket))
	(loop []
	(try
	(let [socket (.accept serversocket)
	conn (doto (DefaultHttpServerConnection.)
	(.bind socket params))]
	(doto (Thread. (request-handler httpservice conn))
	(.setDaemon true)
	(.start)))
	(catch InterruptedIOException ex
	nil)
	(catch IOException e
	(println "I/O error initialising connection thread:"
	(.getMessage e))))
	(recur))))

	(doto (Thread. #(request-listener 8080 "c:/var/www"))
	(.setDaemon false)
	(.start))