blob: 55239d56b02e37788a03dd0c0828f15a399cb127 (
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
|
(ns mulk.benki.main
(:refer-clojure)
(:use [clojure core repl pprint]
noir.core
[hiccup core page-helpers]
[mulk.benki util config db])
(:require [noir server options]
[mulk.benki wiki auth book_marx id lazychat xmpp]
[ring.middleware.file]
[noir.session :as session]
[noir.request :as request]
[clojure.java.jdbc :as sql]
[lamina.core :as lamina]
[aleph.http :as ahttp]
[aleph.formats :as aformats]
[ring.util.codec :as codec])
(:import [java.math BigDecimal BigInteger])
(:gen-class))
(defn wrap-utf-8 [handler]
(fn [request]
(let [response (handler request)
ctype (get-in response [:headers "Content-Type"])
utf8ctype (str ctype "; charset=utf-8")]
(if (and ctype
(re-matches #"^(text/html|text/plain|application/xhtml+xml|text/xml|application/atom+xml)$" ctype))
(assoc-in response [:headers "Content-Type"] utf8ctype)
response))))
(defn wrap-base-uri [handler]
(fn [request]
(let [base-uri (:base-uri @benki-config)]
(hiccup.core/with-base-url base-uri
((noir.options/wrap-options handler {:base-url base-uri}) request)))))
(defn wrap-cache-control [handler]
(fn [request]
(let [response (handler request)]
(if (get-in response [:headers "Cache-Control"])
response
(assoc-in response [:headers "Cache-Control"] "no-cache")
;; no-cache, no-store, must-revalidate
;; Which one is the most appropriate?
;; (is must-revalidate even valid for server responses?)
))))
(defn wrap-auth-token [handler]
(fn [request]
(binding [*user*
(or (when-let [key (get-in request [:params :auth])]
(with-dbt
(sql/with-query-results results
["SELECT \"user\" AS uid FROM page_keys
WHERE page = ? AND \"key\" = ?"
(:uri request)
(BigDecimal. (BigInteger. key 36))]
(:uid (first results)))))
(session/get :user))]
(handler request))))
(defn wrap-extension-mimetype [handler]
(fn [request]
(let [uri (codec/url-decode (:uri request))
response (handler request)
extension (second (re-find #"\.([\w]*)($|\?)" uri))
exttype ({"txt" "text/plain"
"css" "text/css"
"js" "text/javascript"
"html" "text/html"
"jpg" "image/jpeg"
"gif" "image/gif"
"png" "image/png"}
extension)]
(if (and (nil? (get-in response [:headers "Content-Type"]))
exttype)
(assoc-in response [:headers "Content-Type"] exttype)
response))))
(do-once ::init
(noir.server/add-middleware #(wrap-utf-8 %))
(noir.server/add-middleware #(wrap-base-uri %))
(noir.server/add-middleware #(wrap-auth-token %))
(noir.server/add-middleware #(wrap-cache-control %))
(noir.server/add-middleware #(ring.middleware.file/wrap-file % "static"))
(noir.server/add-middleware #(wrap-extension-mimetype %)))
(defn run-server []
(let [mode (or (:mode @benki-config) :production)
noir-handler (noir.server/gen-handler {:mode mode})]
(ahttp/start-http-server (ahttp/wrap-ring-handler noir-handler)
{:port (:web-port @benki-config)
:websocket true})))
(def server (atom nil))
(defn -main [& args]
(do
(future (mulk.benki.xmpp/init-xmpp!))
(future (mulk.benki.lazychat/init-lazychat!))
(future (swap! server (run-server))))
(loop []
(Thread/sleep 1000000)
(recur)))
|
