blob: b6eef26fb71fd8a66b0c7648158624913eccc5d0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;; Copyright (c) James Reeves. All rights reserved.
;; The use and distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
;; can be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other, from
;; this software.
(ns compojure.http.servlet
"Functions for interfacing Compojure with the Java servlet standard."
(:use compojure.http.routes
compojure.http.request)
(:import [java.io File InputStream FileInputStream]
java.util.Map$Entry
[javax.servlet.http Cookie HttpServlet HttpServletRequest HttpServletResponse]
javax.servlet.ServletContext
org.apache.commons.io.IOUtils))
;; Functions to pull information from the request object
(defn- get-headers
"Creates a name/value map of all the request headers."
[#^HttpServletRequest request]
(reduce
(fn [headers name]
(assoc headers (.toLowerCase name) (.getHeader request name)))
{}
(enumeration-seq (.getHeaderNames request))))
(defn- get-content-length
"Returns the content length, or nil if there is no content."
[#^HttpServletRequest request]
(let [length (.getContentLength request)]
(if (>= length 0)
length)))
(defn create-request
"Create the request map from the HttpServletRequest object."
[#^HttpServletRequest request, #^HttpServlet servlet]
{:server-port (.getServerPort request)
:server-name (.getServerName request)
:remote-addr (.getRemoteAddr request)
:uri (.getRequestURI request)
:query-string (.getQueryString request)
:scheme (keyword (.getScheme request))
:request-method (keyword (.toLowerCase (.getMethod request)))
:headers (get-headers request)
:content-type (.getContentType request)
:content-length (get-content-length request)
:character-encoding (.getCharacterEncoding request)
:body (.getInputStream request)
;; Custom non-Ring field:
:servlet-request request
:servlet-context (.getServletContext servlet)})
;; Functions to set data in the response object
(defn- set-headers
"Update a HttpServletResponse with a map of headers."
[#^HttpServletResponse response, headers]
(doseq [[key val-or-vals] headers]
(if (string? val-or-vals)
(.setHeader response key val-or-vals)
(doseq [val val-or-vals]
(.addHeader response key val))))
; Some headers must be set through specific methods
(when-let [content-type (get headers "Content-Type")]
(.setContentType response content-type)))
(defn- set-body
"Update a HttpServletResponse body with a String, ISeq, File or InputStream."
[#^HttpServletResponse response, body]
(cond
(string? body)
(with-open [writer (.getWriter response)]
(.println writer body))
(seq? body)
(with-open [writer (.getWriter response)]
(doseq [chunk body]
(.print writer (str chunk))
(.flush writer)))
(instance? InputStream body)
(with-open [out (.getOutputStream response)]
(IOUtils/copy body out)
(.close body)
(.flush out))
(instance? File body)
(with-open [stream (FileInputStream. body)]
(set-body response stream))))
(defn update-servlet-response
"Update the HttpServletResponse using a response map."
[#^HttpServletResponse response, {:keys [status headers body]}]
(.setStatus response status)
(set-headers response headers)
(set-body response body))
;; Functions that combine request and response handling
(defn request-handler
"Handle incoming HTTP requests from a servlet."
[[servlet request response] routes]
(.setCharacterEncoding response "UTF-8")
(if-let [response-map (routes (create-request request servlet))]
(update-servlet-response response response-map)
(throw (NullPointerException.
"Handler returned nil (maybe no routes matched URI)"))))
(definline servlet
"Create a servlet from a sequence of routes. Automatically updates if
the routes binding is redefined."
[routes]
`(proxy [HttpServlet] []
(~'service [request# response#]
(request-handler [~'this request# response#]
~routes))))
(defmacro defservice
"Defines a service method with an optional prefix suitable for being used by
genclass to compile a HttpServlet class.
e.g. (defservice my-routes)
(defservice \"my-prefix-\" my-routes)"
([routes]
`(defservice "-" ~routes))
([prefix routes]
`(defn ~(symbol (str prefix "service"))
[servlet# request# response#]
(request-handler [servlet# request# response#]
~routes))))
|
