-
Notifications
You must be signed in to change notification settings - Fork 11
/
message.clj
519 lines (423 loc) · 15.9 KB
/
message.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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
(ns clj-pgp.message
"The functions in this namespace package raw data into PGP _messages_, which
can be compressed, encrypted, and signed.
The encryption functions use the concept of _encryptors_ and _decryptors_.
A collection of encryptors may be used to encipher a message, and any
corresponding decryptor will be able to decipher it.
For symmetric encryption, the encryptor is the passphrase string and the
corresponding decryptor is the same string.
For public-key encryption, the encryptor is the public-key object and the
decryptor is the corresponding private-key. Alternately, the decryptor can be
a function which accepts a key id and returns the corresponding private-key,
to look it up or unlock the key on demand."
(:require
[byte-streams :as bytes]
[clj-pgp.core :as pgp]
[clj-pgp.tags :as tags]
[clj-pgp.util :refer [arg-coll arg-map]]
[clojure.java.io :as io])
(:import
(java.io
ByteArrayOutputStream
FilterOutputStream
InputStream
OutputStream)
java.security.SecureRandom
java.util.Date
(org.bouncycastle.bcpg
ArmoredOutputStream)
(org.bouncycastle.openpgp
PGPCompressedData
PGPCompressedDataGenerator
PGPEncryptedData
PGPEncryptedDataGenerator
PGPEncryptedDataList
PGPLiteralData
PGPLiteralDataGenerator
PGPMarker
PGPPBEEncryptedData
PGPPublicKeyEncryptedData
PGPUtil)
(org.bouncycastle.openpgp.operator.bc
BcPBEDataDecryptorFactory
BcPBEKeyEncryptionMethodGenerator
BcPGPDataEncryptorBuilder
BcPGPDigestCalculatorProvider
BcPublicKeyDataDecryptorFactory
BcPublicKeyKeyEncryptionMethodGenerator)))
;; ## Helpers
(defn- with-reduce-attrs
"Creates a new reducing function that merges the kvs onto the value passed
to the `rf`"
[rf & kvs]
(fn reducer
[acc value]
(rf acc (apply assoc value kvs))))
;; ## PGP Data Encoding
(defprotocol ^:no-doc MessagePacket
"Protocol for packets of message data."
(reduce-message
[data opts rf acc]
"Recursively unpacks a message packet and calls `rf` with `acc` and the message as map.
See `reduce-messages` for the map structure and options")
(readable
[data opts]
"Determines if the message packet can be read using the given options. Should return the
readable object itself if it's readable or nil if not."))
(defn- reduce-content
"Decodes a sequence of PGP objects from an input stream, unpacking each
objects data.
See `reduce-messages` for options"
[^InputStream input opts rf acc]
(reduce
#(reduce-message %2 opts rf %1)
acc
(pgp/read-objects input)))
(defn armored-data-stream
"Wraps an `OutputStream` with an armored data stream. Packets written to this
stream will be output in ASCII encoded Base64."
^OutputStream
[^OutputStream output]
(ArmoredOutputStream. output))
;; ## Literal Data Packets
(def data-formats
"Supported data formats which can be specified when building literal data
packets."
{:binary PGPLiteralData/BINARY
:text PGPLiteralData/TEXT
:utf8 PGPLiteralData/UTF8})
(defn literal-data-stream
"Wraps an `OutputStream` with a literal data generator, returning another
stream. Typically, the wrapped stream is a compressed data stream or
encrypted data stream.
Data written to the returned stream will write a literal data packet to the
wrapped output stream. If the data is longer than the buffer size, the packet
is written in chunks in a streaming fashion.
Options may be provided to customize the packet:
- `:buffer-size` maximum number of bytes per chunk
- `:format` data format type
- `:filename` filename string for the data
- `:mtime` data modification time"
^OutputStream
[^OutputStream output & opts]
(let [{:keys [buffer-size format filename ^Date mtime]
:or {buffer-size 4096
format :binary
filename PGPLiteralData/CONSOLE
mtime (Date.)}}
(arg-map opts)]
(.open (PGPLiteralDataGenerator.)
output
(char (data-formats format))
(str filename)
mtime
(byte-array buffer-size))))
;; Read the literal data bytes from the packet.
(extend-protocol MessagePacket
PGPLiteralData
(reduce-message
[packet opts rf acc]
(let [data (.getInputStream packet)
format (tags/code->tag data-formats (char (.getFormat packet)))]
(rf acc {:format format
:filename (.getFileName packet)
:mtime (.getModificationTime packet)
:data data})))
(readable
[packet opts]
;; PGPLiteralData is always readable
packet)
PGPMarker
(reduce-message
[packet opts rf acc]
;; Such a packet MUST be ignored when received. It may be placed at the
;; beginning of a message that uses features not available in PGP 2.6.x
;; in order to cause that version to report that newer software is
;; necessary to process the message.
acc)
(readable
[packet opts]
;; PGPMarker is always readable
packet))
;; ## Compressed Data Packets
(defn compressed-data-stream
"Wraps an `OutputStream` with a compressed data generator, returning another
stream. Typically, literal data packets will be written to this stream, which
are compressed and written to an underlying encryption stream."
^OutputStream
[^OutputStream output algorithm]
(.open (PGPCompressedDataGenerator.
(tags/compression-algorithm-code algorithm))
output))
;; Decompress the data contained in the packet.
(extend-protocol MessagePacket
PGPCompressedData
(reduce-message
[packet opts rf acc]
(let [zip-algo (tags/compression-algorithm-tag
(.getAlgorithm packet))]
(reduce
(fn [acc packet]
(reduce-message packet opts (with-reduce-attrs rf :compress zip-algo) acc))
acc
(pgp/read-objects (.getDataStream packet)))))
(readable
[packet opts]
;; PGPCompressedData is always readable
packet))
;; ## Encrypted Data Packets
(defn- add-encryption-method!
"Adds an encryption method to an encrypted data generator. Returns the updated
generator."
^PGPEncryptedDataGenerator
[^PGPEncryptedDataGenerator generator encryptor]
(cond
(string? encryptor)
(.addMethod
generator
(BcPBEKeyEncryptionMethodGenerator.
(.toCharArray ^String encryptor)))
(pgp/public-key encryptor)
(.addMethod
generator
(BcPublicKeyKeyEncryptionMethodGenerator.
(pgp/public-key encryptor)))
:else
(throw (IllegalArgumentException.
(str "Don't know how to encrypt data with " (pr-str encryptor)))))
generator)
(defn encrypted-data-stream
"Wraps an `OutputStream` with an encrypted data generator, returning another
stream. The data written to the stream will be encrypted with a symmetric
session key, which is then encrypted for each of the given public keys.
Typically, the data written to this will consist of compressed data packets.
If the data is longer than the buffer size, the packet is written in chunks
in a streaming fashion.
Options may be provided to customize the packet:
- `:buffer-size` maximum number of bytes per chunk
- `:integrity-packet` whether to include a Modification Detection Code packet
- `:random` custom random number generator"
^OutputStream
[^OutputStream output cipher encryptors & opts]
(let [encryptors (arg-coll encryptors)
{:keys [buffer-size integrity-packet random]
:or {buffer-size 4096
integrity-packet true}}
(arg-map opts)]
(when (empty? (remove nil? encryptors))
(throw (IllegalArgumentException.
"Cannot encrypt data stream without encryptors.")))
(when (< 1 (count (filter string? encryptors)))
(throw (IllegalArgumentException.
"Only one passphrase encryptor is supported")))
(.open
^PGPEncryptedDataGenerator
(reduce
add-encryption-method!
(PGPEncryptedDataGenerator.
(cond->
(BcPGPDataEncryptorBuilder.
(tags/symmetric-key-algorithm-code cipher))
integrity-packet (.setWithIntegrityPacket true)
random (.setSecureRandom ^SecureRandom random)))
encryptors)
output
(byte-array buffer-size))))
(extend-protocol MessagePacket
PGPEncryptedDataList
;; Read through the list of encrypted session keys and attempt to find one
;; which the decryptor will unlock. If none are found, the message is not
;; decipherable and an exception is thrown.
(reduce-message
[packet opts rf acc]
(if-let [readable-packet (readable packet opts)]
(reduce-message readable-packet opts rf acc)
(throw (IllegalArgumentException.
(str "Cannot decrypt " (pr-str packet) " with " (pr-str opts)
" (no matching encrypted session key)")))))
(readable
[packet opts]
(some
#(readable % opts)
(iterator-seq (.getEncryptedDataObjects packet))))
PGPPBEEncryptedData
(reduce-message
[packet {:keys [decryptor] :as opts} rf acc]
(let [decryptor-factory (BcPBEDataDecryptorFactory.
(.toCharArray ^String decryptor)
(BcPGPDigestCalculatorProvider.))
cipher (-> packet
(.getSymmetricAlgorithm decryptor-factory)
tags/symmetric-key-algorithm-tag)]
(reduce-content
(.getDataStream packet decryptor-factory)
opts
(with-reduce-attrs rf :cipher cipher :object packet)
acc)))
;; If the decryptor is a string, try to use it to decrypt the passphrase
;; protected session key.
(readable
[packet {:keys [decryptor] :as opts}]
(when (string? decryptor)
packet))
PGPPublicKeyEncryptedData
(reduce-message
[packet {:keys [decryptor] :as opts} rf acc]
(let [for-key (.getKeyID packet)
privkey (pgp/private-key
(if (ifn? decryptor)
(decryptor for-key)
decryptor))
decryptor-factory (BcPublicKeyDataDecryptorFactory. privkey)
cipher (-> packet
(.getSymmetricAlgorithm decryptor-factory)
tags/symmetric-key-algorithm-tag)]
(reduce-content
(.getDataStream packet decryptor-factory)
opts
(with-reduce-attrs rf
:encrypted-for for-key
:cipher cipher
:object packet)
acc)))
;; If the decryptor is callable, use it to find a private key matching the id
;; on the data packet. Otherwise, use it directly as a private key. If the
;; decryptor doesn't match the id, return nil.
(readable
[packet {:keys [decryptor] :as opts}]
(let [for-key (.getKeyID packet)]
(when (some-> (if (ifn? decryptor)
(decryptor for-key)
decryptor)
(pgp/private-key)
(pgp/key-id)
(= for-key))
packet))))
;; ## Constructing PGP Messages
(defn message-output-stream
"Wraps the given output stream with compression and encryption layers. The
data will decryptable by the corresponding decryptors. Does _not_ close the
wrapped stream when it is closed.
Opts may contain:
- `:buffer-size` maximum number of bytes per chunk
- `:compress` compress the cleartext with the given algorithm, if specified
- `:cipher` symmetric key algorithm to use if encryptors are provided
- `:encryptors` keys to encrypt the cipher session key with
- `:armor` whether to ascii-encode the output
See `literal-data-stream` and `encrypted-data-stream` for more options."
^OutputStream
[^OutputStream output & opts]
(let [{:keys [compress cipher encryptors armor]
:or {cipher :aes-256}
:as opts}
(arg-map opts)
encryptors (arg-coll encryptors)
wrap-with
(fn [streams wrapper & args]
(conj streams (apply wrapper (last streams) args)))
streams
(->
(vector output)
(cond->
armor (wrap-with armored-data-stream)
encryptors (wrap-with encrypted-data-stream cipher encryptors opts)
compress (wrap-with compressed-data-stream compress))
(wrap-with literal-data-stream opts)
rest reverse)]
(proxy [FilterOutputStream] [(first streams)]
(close
[]
(dorun (map #(.close ^OutputStream %) streams))))))
(defn package
"Compresses, encrypts, and encodes the given data and returns an encoded
message packet. If the `:armor` option is set, the result will be an ASCII
string; otherwise, the function returns a byte array.
The message will readable by any of the corresponding decryptors.
See `message-output-stream` for options."
[data & opts]
(let [opts (arg-map opts)
buffer (ByteArrayOutputStream.)]
(with-open [^OutputStream stream
(message-output-stream buffer opts)]
(io/copy data stream))
(cond-> (.toByteArray buffer)
(:armor opts) String.)))
(defn encrypt
"Constructs a message packet enciphered for the given encryptors. See
`message-output-stream` for options."
[data encryptors & opts]
(apply package data
:encryptors encryptors
opts))
;; ## Reading PGP Messages
(defn- reduce-objects
"Reduces over the PGP objects the returns the resulting accumulator.
Verifys the integrity of each object and throws if its invalid."
[opts rf acc objects]
(reduce
(fn reduce-and-verify!
[acc message]
(reduce-message
message
opts
(fn [acc {:keys [object] :as message}]
;; To be able to verify the integrity we must have consumed the stream itself.
;; Make sure to call the reducing function and then verify the message.
(let [results (rf acc message)]
(when (and (instance? PGPEncryptedData object)
(.isIntegrityProtected ^PGPEncryptedData object)
(not (.verify ^PGPEncryptedData object)))
(throw (IllegalStateException.
(str "Encrypted data object " object
" failed integrity verification!"))))
results))
acc))
acc
objects))
(defn reduce-messages
"Reads message packets form an input source and reduces over them with the
given accumulator `acc` and reducing function `rf`. Each message contains
keys similiar to the options used to build them, describing the type of compression used,
cophier encrypted with, etc. The `rf` should take the accumulator and a `message` and
return the resulting accumulator. It must consume the stream passed in the `:data` field.
A message is a map containing:
- `:format` one of #{:binary :text :utf8}
- `:data` An InputStream
- `:filename` the name of the file
- `:mtime` the modified time of the message
Opts may contain:
- `:decryptor` secret to decipher the message encryption"
[input rf acc & opts]
(->> input
bytes/to-input-stream
PGPUtil/getDecoderStream
pgp/read-objects
(reduce-objects (apply hash-map opts) rf acc)))
(defn read-messages
"Reads message packets from an input source and returns a sequence of message
maps which have realized `:data` entries.
See `reduce-messages` for options
"
[input & opts]
(apply
reduce-messages
input
(fn [acc {:keys [format data] :as message}]
(let [data' (bytes/to-byte-array data)]
(->> (case format
(:text :utf8) (String. data')
data')
(assoc message :data)
(conj acc))))
[]
opts))
(defn decrypt
"Decrypts a message packet and attempts to decipher it with the given
decryptor. Returns the data of the first message directly.
See `read-messages` for options."
[input decryptor & opts]
(->
(apply read-messages input
:decryptor decryptor
opts)
first :data))