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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
#!/usr/bin/env bash
":"; # -*-clojure-*-
":"; set -ueo pipefail
":"; script_home="$(cd "$(dirname "$0")" && pwd)"
":"; exec "$script_home/clj-1.11" "$0" "$@"
(require
'[clojure.edn :as edn]
'[clojure.java.io :as io]
'[clojure.set :as set]
'[clojure.string :as str])
(import
'(clojure.lang ExceptionInfo)
'(java.io PushbackReader))
(defn prs [stream & items]
(binding [*out* stream]
(apply pr items)))
(defn prns [stream & items]
(binding [*out* stream]
(apply prn items)))
(defn msg [stream & items]
(binding [*out* stream]
(apply print items)))
(defn msgn [stream & items]
(binding [*out* stream]
(apply println items)))
(defn usage [stream]
(msgn stream (str/triml "
Usage:
dep-diff --help
dep-diff [OPT...] [--] OLD_TREE_PATH NEW_TREE_PATH
OPT:
--mismatches | --ignore-exclusions | --ignore-id X/Y
Examines two dependency lists as-per \"lein deps :tree\" and reports
any differences with respect to the dependency names and versions.
If --mismatches is specified, then only reports mismatched versions
of dependencies the two lists have in common. If
--ignore-exclusions is specified, then does not consider exclusions
when comparing the dependencies. Specific dependencies can be
excluded from consideration via --ignore-id, e.g. --ignore-id
org.clojure/tools.cli.")))
(defn exit [rc]
(throw (ex-info "" {:kind ::exit ::rc 1})))
(defn tree->dep-seq [stream]
(with-open [r (io/reader stream)
pbr (PushbackReader. r)]
(doall
(let [eof (Object.)]
(take-while #(not= % eof)
(repeatedly #(edn/read {:eof eof} pbr)))))))
(defn validate-dep-seq [ds]
(doseq [dep ds]
(when-not (> (count ds) 1)
(msgn *err* "dependency seq len < 2:" (pr-str dep))
(exit 2))
(when-not (symbol? (first dep))
(msgn *err* "dependency name is not a symbol:" (pr-str dep))
(exit 2))
(when-not (string? (second dep))
(msgn *err* "dependency version is not a string: " (pr-str dep))
(exit 2)))
(doseq [[name deps-for-name] (group-by first ds)
:when (not= 1 (count deps-for-name))]
(let [versions (map second deps-for-name)]
(when (not= 1 (count (distinct versions)))
(msgn *err* "unexpected duplicates:" (pr-str deps-for-name))
(exit 2))))
ds)
(defn strip-bc-scope [dep]
(if (#{'org.bouncycastle/bcutil-jdk18on 'org.bouncycastle/bcpkix-jdk18on 'org.bouncycastle/bcprov-jdk18on}
(first dep))
(letfn [(strip [remainder]
(when (seq remainder)
(if (= '(:scope "provided") (take 2 remainder))
(strip (drop 2 remainder))
(cons (first remainder)
(strip (rest remainder))))))]
(vec (strip dep)))
dep))
(defn strip-exclusions [dep]
(letfn [(strip [remainder]
(when (seq remainder)
(if (= :exclusions (first remainder))
(strip (drop 2 remainder))
(cons (first remainder)
(strip (rest remainder))))))]
(vec (strip dep))))
(defn not-puppetdb? [dep]
(not= 'puppetlabs/puppetdb (first dep)))
(defn display-diff [{:keys [ignore-exclusions? mismatches-only? ignore-puppetdb?
ignore-ids pe-bouncy-castle-provided? out]
:or {out *out*} :as opts}
deps-1 deps-2]
(doseq [name (-> (concat (keys deps-1) (keys deps-2)) distinct sort)
:when (or (empty? ignore-ids) (not (ignore-ids name)))
:let [old (get deps-1 name)
new (get deps-2 name)]]
(if (and (seq old) (seq new))
(let [relevant-set (fn [s]
((cond-> set
ignore-exclusions? (comp (partial map strip-exclusions))
ignore-puppetdb? (comp (partial filter not-puppetdb?))
pe-bouncy-castle-provided? (comp (partial map strip-bc-scope)))
s))
relevant-old (relevant-set old)
relevant-new (relevant-set new)]
(when (not= relevant-old relevant-new)
(doseq [dep (sort-by second (set/difference relevant-old relevant-new))]
(prns out '- dep))
(doseq [dep (sort-by second (set/difference relevant-new relevant-old))]
(prns out '+ dep))))
;; We only have old or new
(if-not mismatches-only?
(if (seq old)
(doseq [dep (sort-by second old)]
(prns out '- dep))
(doseq [dep (sort-by second new)]
(prns out '+ dep)))))))
(defn dispatch-diff [opts old new]
(apply display-diff opts
(map (fn [path]
(with-open [r (io/input-stream path)]
(group-by first (-> r tree->dep-seq validate-dep-seq))))
[old new]))
0)
(defn args->opts [args]
(loop [args args
opts {:positional []
:ignore-ids #{}}]
(if-not (seq args)
opts
(case (first args)
"--help" (recur (rest args) (assoc opts :help? true))
"--mismatches" (recur (rest args) (assoc opts :mismatches-only? true))
"--ignore-exclusions" (recur (rest args)
(assoc opts :ignore-exclusions? true))
"--ignore-puppetdb" (recur (rest args)
(assoc opts :ignore-puppetdb? true))
"--ignore-id" (recur (nthrest args 2)
(update opts :ignore-ids #(conj % (-> args (nth 1) symbol))))
"--allow-pe-bc-provided" (recur (rest args)
(assoc opts :pe-bouncy-castle-provided? true))
(cond
(= "--" (first args)) (update opts :positional conj (rest args))
(str/starts-with? (first args) "-")
(do
(msgn *err* "dep-diff: unknown argument" (pr-str (first args)))
(exit 2))
:else (recur (rest args) (update opts :positional conj (first args))))))))
(defn validate-opts [opts]
(if (:help? opts)
(when (seq (dissoc :help? opts))
(usage *err*)
(exit 2))
(when (not= 2 (count (:positional opts)))
(msgn *err* "dep-diff: please specify two comparison paths")
(usage *err*)
(exit 2)))
opts)
(defn run-cmd [args]
(let [opts (-> args args->opts validate-opts)]
(if (:help? opts)
(do (usage *out*) 0)
(apply dispatch-diff
(merge {:out *out*} (select-keys opts [:mismatches-only? :ignore-exclusions?
:ignore-puppetdb? :ignore-ids
:pe-bouncy-castle-provided?]))
(:positional opts)))))
(defn main [args]
(let [rc (try
(run-cmd args)
(catch ExceptionInfo ex
(let [data (ex-data ex)]
(when-not (= ::exit (:kind data))
(throw ex))
(::rc data))))]
(shutdown-agents)
(flush)
(binding [*out* *err*] (flush))
(System/exit rc)))
(main *command-line-args*)
|
