blob: f9a2dab28715b4ab5e545cc74773a83a6dd5455f (
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
130
131
|
;; 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.middleware
"Various middleware functions."
(:use compojure.http.routes
compojure.str-utils
clojure.contrib.def
clojure.contrib.str-utils))
(defn header-option
"Converts a header option KeyValue into a string."
[[key val]]
(cond
(true? val) (str* key)
(false? val) nil
:otherwise (str* key "=" val)))
(defn header-options
"Converts a map into an HTTP header options string."
[m delimiter]
(str-join delimiter
(remove nil? (map header-option m))))
(defn with-headers
"Merges a map of header name and values into the response. Overwrites
existing headers."
[handler headers]
(fn [request]
(if-let [response (handler request)]
(assoc response :headers
(merge (:headers response) headers)))))
(defn with-cache-control
"Middleware to set the Cache-Control http header. Map entries with boolean
values either write their key if true, or nothing if false.
Example:
{:max-age 3600 :public false :must-revalidate true}
=> Cache-Control: max-age=3600, must-revalidate"
[handler header-map]
(with-headers handler
{"Cache-Control" (header-options header-map ", ")}))
(defn with-uri-rewrite
"Rewrites a request uri with the result of calling f with the
request's original uri. If f returns nil the handler is not called."
[handler f]
(fn [request]
(let [uri (:uri request)
rewrite (f uri)]
(if rewrite
(handler (assoc request :uri rewrite))
nil))))
(defn- remove-or-nil-context
"Removes a context string from the front of a uri. If it wasn't there,
returns nil."
[uri context]
(if (.startsWith uri context)
(if-not (= uri context)
(subs uri (count context))
"/")
nil))
(defn with-context
"Removes the context string from the beginning of the request uri
such that route matching is done without it. If the context is not
present, the handler will not be called."
[handler context]
(with-uri-rewrite handler #(remove-or-nil-context % context)))
(defn- uri-snip-slash
"Removes a trailing slash from all uris except \"/\"."
[uri]
(if (and (not (= "/" uri))
(.endsWith uri "/"))
(chop uri)
uri))
(defn ignore-trailing-slash
"Makes routes match regardless of whether or not a uri ends in a slash."
[handler]
(with-uri-rewrite handler uri-snip-slash))
(defvar default-mimetypes
{"css" "text/css"
"gif" "image/gif"
"gz" "application/gzip"
"htm" "text/html"
"html" "text/html"
"jpg" "image/jpeg"
"js" "text/javascript"
"pdf" "application/pdf"
"png" "image/png"
"swf" "application/x-shockwave-flash"
"txt" "text/plain"
"xml" "text/xml"
"zip" "application/zip"}
"Default mimetype map used by with-mimetypes.")
(defn- extension
"Returns the text after the last . of a String or nil."
[s]
(second (re-find #"\.(\w*$)" s)))
(defn- request-mimetype
"Derives the mimetype from a request. See with-mimetypes for options."
[request options]
(let [default (or (:default options) "text/html")]
(if-let [ext (extension (:uri request))]
(let [mimetypes (or (:mimetypes options) default-mimetypes)]
(get mimetypes ext default))
default)))
(defn with-mimetypes
"Middleware to add the proper Content-Type header based on the uri of
the request. options is a map containing a :mimetype map of extension
to type and a :default mime type. If :mimetype is not provided, a default
map with common mime types will be used. If :default is not provided,
\"text/html\" is used."
([handler]
(with-mimetypes handler {}))
([handler options]
(fn [request]
(let [mimetype (request-mimetype request options)]
((with-headers handler {"Content-Type" mimetype}) request)))))
|
