/
uberjar.clj
187 lines (165 loc) · 7.22 KB
/
uberjar.clj
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
(ns leiningen.uberjar
"Package up the project files and dependencies into a jar file."
(:require [clojure.xml :as xml]
[clojure.zip :as zip]
[clojure.java.io :as io]
[leiningen.core.classpath :as classpath]
[leiningen.core.project :as project]
[leiningen.core.main :as main]
[leiningen.core.utils :as utils]
[leiningen.jar :as jar]
[leiningen.pom :as pom]
[clojure.set :as set])
(:import (java.io File FileOutputStream PrintWriter)
(java.util.regex Pattern)
(java.util.zip ZipFile ZipOutputStream ZipEntry)
(org.apache.commons.io.output CloseShieldOutputStream)
(org.apache.commons.lang StringEscapeUtils)))
(defn- tree-edit
"Walk the componment xml dom looking for description tag"
[zipper editor]
(loop [loc zipper]
(if (zip/end? loc)
(zip/root loc)
(if (= :description (:tag (zip/node loc)))
(let [new-loc (zip/edit loc editor)]
(recur (zip/next new-loc)))
(recur (zip/next loc))))))
(defn- html-escape-editor
"Escape <,>,& from content"
[node]
(let [content (get (:content node) 0)]
(if-not (nil? content)
(assoc-in node [:content 0] (StringEscapeUtils/escapeXml content))
node)))
(defn- components-read [ins]
(let [zipper (->> ins xml/parse zip/xml-zip)]
(->> (tree-edit zipper html-escape-editor) zip/xml-zip zip/children
(filter #(= (:tag %) :components))
first :content)))
(defn- components-write [out components]
(binding [*out* (PrintWriter. out)]
(xml/emit {:tag :component-set
:content
[{:tag :components
:content components}]})
(.flush *out*)))
(def components-merger
"Project `:uberjar-merge-with` merger for components.xml files."
[components-read into components-write])
(def clj-map-merger
"Project `:uberjar-merge-with` for files containing a single map
read with `clojure.core/read`, such as data_readers.clj."
[(comp read-string slurp) merge #(spit %1 (pr-str %2))])
(defn- merger-match? [[pattern] filename]
(boolean
(condp instance? pattern
String (= pattern filename)
Pattern (re-find pattern filename))))
(def ^:private skip-merger
[(constantly ::skip)
(constantly nil)])
(def ^:private default-merger
[(fn [in out file prev]
(when-not prev
(.setCompressedSize file -1)
(.putNextEntry out file)
(io/copy (.getInputStream in file) out)
(.closeEntry out))
::skip)
(constantly nil)])
(defn- make-merger [fns]
{:pre [(sequential? fns) (= 3 (count fns)) (every? ifn? fns)]}
(let [[read-fn merge-fn write-fn] fns]
[(fn [in out file prev]
(with-open [ins (.getInputStream in file)]
(let [new (read-fn ins)]
(if-not prev
new
(merge-fn new prev)))))
(fn [out filename result]
(.putNextEntry out (ZipEntry. filename))
(write-fn (CloseShieldOutputStream. out) result)
(.closeEntry out))]))
(defn- make-mergers [project]
(into (utils/map-vals (:uberjar-merge-with project)
(comp make-merger eval))
(map #(vector % skip-merger)
(:uberjar-exclusions project))))
(defn- select-merger [mergers filename]
(or (->> mergers (filter #(merger-match? % filename)) first second)
default-merger))
(defn- warn-on-drop [filename]
(let [non-code #".*/|project\.clj|META-INF/(MANIFEST\.MF|(NOTICE|LICENSE)(.*\.txt)?|DEPENDENCIES)"]
(if-not (re-matches non-code filename)
(main/debug " Dropping" filename))))
;; TODO: unify with copy-to-jar functionality in jar.clj (for 3.0?)
(defn- copy-entries
"Read entries of ZipFile `in` and apply the filename-determined entry-merging
logic captured in `mergers`. The default merger copies entry contents directly
to the ZipOutputStream `out` and skips subsequent same-named files. Returns
new `merged-map` merged entry map."
[in out mergers merged-map]
(reduce (fn [merged-map file]
(let [filename (.getName file), prev (get merged-map filename)]
(if (identical? ::skip prev)
(do (warn-on-drop filename)
merged-map)
(let [[read-merge] (select-merger mergers filename)]
(assoc merged-map
filename (read-merge in out file prev))))))
merged-map (enumeration-seq (.entries in))))
(defn- include-dep [out mergers merged-map dep]
(main/debug "Including" (.getName dep))
(with-open [zipfile (ZipFile. dep)]
(copy-entries zipfile out mergers merged-map)))
(defn write-components
"Given a list of jarfiles, writes contents to a stream"
[project jars out]
(let [mergers (make-mergers project)
include-dep (partial include-dep out mergers)
merged-map (reduce include-dep {} jars)]
(doseq [[filename result] merged-map
:when (not (identical? ::skip result))
:let [[_ write] (select-merger mergers filename)]]
(write out filename result))))
(defn uberjar
"Package up the project files and all dependencies into a jar file.
Includes the contents of each of the dependency jars. Suitable for standalone
distribution.
With an argument, the uberjar will be built with an alternate main.
The namespace you choose as main should have :gen-class in its ns form
as well as defining a -main function.
Note: The :uberjar profile is implicitly activated for this task, and cannot
be deactivated."
([project main]
(let [scoped-profiles (set (project/pom-scope-profiles project :provided))
default-profiles (set (project/expand-profile project :default))
provided-profiles (remove
(set/difference default-profiles scoped-profiles)
(-> project meta :included-profiles))
project (project/merge-profiles (project/merge-profiles project [:uberjar]) provided-profiles)
_ #_ (bail early if snapshot) (pom/check-for-snapshot-deps project)
project (update-in project [:jar-inclusions]
concat (:uberjar-inclusions project))
[_ jar] (try (first (jar/jar project main))
(catch Exception e
(when main/*debug*
(.printStackTrace e))
(main/abort "Uberjar aborting because jar failed:"
(.getMessage e))))
standalone-filename (jar/get-jar-filename project :standalone)]
(with-open [out (-> standalone-filename
(FileOutputStream.)
(ZipOutputStream.))]
(let [whitelisted (select-keys project project/whitelist-keys)
project (-> (project/unmerge-profiles project [:default])
(merge whitelisted))
deps (->> (classpath/resolve-managed-dependencies
:dependencies :managed-dependencies project)
(filter #(.endsWith (.getName %) ".jar")))
jars (cons (io/file jar) deps)]
(write-components project jars out)))
(main/info "Created" standalone-filename)
standalone-filename))
([project] (uberjar project nil)))