35
36
37:-module(xmlenc,
38 [ decrypt_xml/4 39 ]).
40:- use_module(library(ssl)).
41:- use_module(library(crypto)).
42:- use_module(library(sgml)).
43:- use_module(library(base64)).
44:- use_module(library(error)).
45
46:- meta_predicate
47 decrypt_xml(+, -, 3, +).
48
57
60ssl_algorithm('http://www.w3.org/2001/04/xmlenc#tripledes-cbc', 'des3', 8).
61ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes128-cbc', 'aes-128-cbc', 16).
62ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes256-cbc', 'aes-256-cbc', 32).
63ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes192-cbc', 'aes-192-cbc', 24).
64
71
72decrypt_xml([], [], _, _):- !.
73decrypt_xml([element(ns(_, 'http://www.w3.org/2001/04/xmlenc#'):'EncryptedData',
74 Attributes, EncryptedData)|Siblings],
75 [Decrypted|NewSiblings], KeyCallback, Options) :-
76 !,
77 decrypt_element(Attributes, EncryptedData, Decrypted, KeyCallback, Options),
78 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options).
79
80decrypt_xml([element(Tag, Attributes, Children)|Siblings],
81 [element(Tag, Attributes, NewChildren)|NewSiblings], KeyCallback, Options) :-
82 !,
83 decrypt_xml(Children, NewChildren, KeyCallback, Options),
84 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options).
85decrypt_xml([Other|Siblings], [Other|NewSiblings], KeyCallback, Options):-
86 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options).
87
98
99:-meta_predicate(decrypt_element(+, +, -, 3, +)).
100
101decrypt_element(Attributes, EncryptedData, Decrypted, KeyCallback, Options):-
102 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'),
103 ( memberchk(element(XENC:'CipherData', _, CipherData), EncryptedData)
104 -> true
105 ; existence_error(cipher_data, EncryptedData)
106 ),
107 108 109 ( memberchk('Type'=Type, Attributes)
110 -> true
111 ; Type = 'http://www.w3.org/2001/04/xmlenc#Content'
112 ),
113
114 115 determine_encryption_algorithm(EncryptedData, Algorithm, IVSize),
116
117 118 119 determine_key(EncryptedData, Key, KeyCallback, Options),
120
121 122 123 124 ( memberchk(element(XENC:'CipherValue', _, CipherValueElement), CipherData)
125 -> base64_element(CipherValueElement, CipherValueWithIV),
126 string_codes(CipherValueWithIV, CipherValueWithIVCodes),
127 length(IVCodes, IVSize),
128 append(IVCodes, CipherCodes, CipherValueWithIVCodes),
129 string_codes(IV, IVCodes),
130 string_codes(CipherText, CipherCodes),
131 length(CipherValueWithIVCodes, _),
132 evp_decrypt(CipherText, Algorithm, Key, IV, DecryptedStringWithPadding, [padding(none), encoding(octet)])
133 ; memberchk(element(XENC:'CipherReference', CipherReferenceAttributes, CipherReference), CipherData)->
134 135 136 137 memberchk('URI'=CipherURI, CipherReferenceAttributes),
138 139 ( memberchk(element('Transforms', _, Transforms), CipherReference)
140 -> true
141 ; Transforms = []
142 ),
143 uri_components(CipherURI, uri_components(Scheme, _, _, _, _)),
144 ( ( Scheme == 'http' ; Scheme == 'https')
145 146 -> with_output_to(string(RawCipherValue),
147 setup_call_cleanup(http_open(CipherURI, HTTPStream, []),
148 copy_stream_data(HTTPStream, current_output),
149 close(HTTPStream)))
150 ; domain_error(resolvable_uri, CipherURI)
151 ),
152 apply_ciphertext_transforms(RawCipherValue, Transforms, CipherValue),
153 sub_string(CipherValue, 0, IVSize, _, IV),
154 sub_string(CipherValue, IVSize, _, 0, CipherText),
155 evp_decrypt(CipherText, Algorithm, Key, IV, DecryptedStringWithPadding, [padding(none), encoding(octet)])
156 ),
157 158 159 160 xmlenc_padding(DecryptedStringWithPadding, DecryptedString),
161 162 163 ( Type == 'http://www.w3.org/2001/04/xmlenc#Element'
164 -> setup_call_cleanup(open_string(DecryptedString, StringStream),
165 load_structure(StringStream, [Decrypted], [dialect(xmlns), keep_prefix(true)]),
166 close(StringStream))
167 ; Decrypted = DecryptedString
168 ).
169
170xmlenc_padding(DecryptedStringWithPadding, DecryptedString):-
171 string_length(DecryptedStringWithPadding, _),
172 string_codes(DecryptedStringWithPadding, Codes),
173 append(_, [LastCode], Codes),
174 length(Padding, LastCode),
175 append(DecryptedCodes, Padding, Codes),
176 !,
177 string_codes(DecryptedString, DecryptedCodes).
178
179apply_ciphertext_transforms(CipherValue, [], CipherValue):- !.
180apply_ciphertext_transforms(_, [_AnythingElse|_], _):-
181 182 throw(error(implementation_missing('CipherReference transforms are not implemented', _))).
183
184:- meta_predicate determine_key(+,-,3,+).
185determine_key(EncryptedData, Key, KeyCallback, Options):-
186 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
187 ( memberchk(element(DS:'KeyInfo', _, KeyInfo), EncryptedData)
188 -> true
189 ; 190 191 192 existence_error(key_info, EncryptedData)
193 ),
194 resolve_key(KeyInfo, Key, KeyCallback, Options).
195
196:- meta_predicate resolve_key(+,-,3,+).
197
198resolve_key(Info, Key, KeyCallback, Options):-
199 200 XENC = 'http://www.w3.org/2001/04/xmlenc#',
201 memberchk(element(ns(_, XENC):'EncryptedKey', _KeyAttributes, EncryptedKey), Info),
202 !,
203 204 205 206 memberchk(element(ns(_, XENC):'EncryptionMethod', MethodAttributes, EncryptionMethod), EncryptedKey),
207 memberchk('Algorithm'=Algorithm, MethodAttributes),
208
209 210 determine_key(EncryptedKey, PrivateKey, KeyCallback, Options),
211
212 memberchk(element(ns(_, XENC):'CipherData', _, CipherData), EncryptedKey),
213 memberchk(element(ns(_, XENC):'CipherValue', _, CipherValueElement), CipherData),
214 base64_element(CipherValueElement, CipherValue),
215 ( Algorithm == 'http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p'
216 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1_oaep)])
217 ; Algorithm == 'http://www.w3.org/2009/xmlenc11#rsa-oaep',
218 memberchk(element(ns(_, 'http://www.w3.org/2009/xmlenc11#'):'MGF', MGFAttributes, _), EncryptionMethod),
219 memberchk('Algorithm'='http://www.w3.org/2009/xmlenc11#mgf1sha1', MGFAttributes) 220 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1_oaep)])
221 ; Algorithm == 'http://www.w3.org/2001/04/xmlenc#rsa-1_5'
222 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1)])
223 ; domain_error(key_transport, Algorithm)
224 ).
225resolve_key(KeyInfo, _Key, _KeyCallback, _Options):-
226 227 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'),
228 memberchk(element(XENC:'AgreementMethod', _KeyAttributes, _AgreementMethod), KeyInfo),
229 !,
230 throw(not_implemented).
232resolve_key(KeyInfo, Key, KeyCallback, _Options):-
233 234 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
235 memberchk(element(DS:'KeyName', _KeyAttributes, [KeyName]), KeyInfo),
236 !,
237 call(KeyCallback, name, KeyName, Key).
238resolve_key(KeyInfo, _Key, _KeyCallback, _Options):-
239 240 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
241 memberchk(element(DS:'RetrievalMethod', _KeyAttributes, _RetrievalMethod), KeyInfo),
242 !,
243 throw(not_implemented).
244resolve_key(KeyInfo, Key, KeyCallback, _Options):-
245 246 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
247 memberchk(element(DS:'KeyValue', _KeyAttributes, KeyValue), KeyInfo),
248 !,
249 ( memberchk(element(DS:'RSAKeyValue', _, RSAKeyValue), KeyInfo)
250 -> memberchk(element(DS:'Modulus', _, [ModulusBase64]), RSAKeyValue),
251 memberchk(element(DS:'Exponent', _, [ExponentBase64]), RSAKeyValue),
252 base64_to_hex(ModulusBase64, Modulus),
253 base64_to_hex(ExponentBase64, Exponent),
254 call(KeyCallback, public_key, public_key(rsa(Modulus, Exponent, -, -, -, -, -, -)), Key)
255 ; memberchk(element(DS:'DSAKeyValue', _, _DSAKeyValue), KeyInfo)
256 -> throw(error(not_implemented(dsa_key), _)) 257 ; existence_error(usable_key_value, KeyValue)
258 ).
259resolve_key(KeyInfo, Key, KeyCallback, _Options):-
260 261 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
262 memberchk(element(DS:'X509Data', _, X509Data), KeyInfo),
263 memberchk(element(DS:'X509Certificate', _, [X509Certificate]), X509Data),
264 !,
265 string_concat("-----BEGIN CERTIFICATE-----\n", X509Certificate, X509CertificateWithHeader),
266 string_concat(X509CertificateWithHeader, "\n-----END CERTIFICATE-----", X509CertificateWithHeaderAndFooter),
267 setup_call_cleanup(open_string(X509CertificateWithHeaderAndFooter, X509Stream),
268 load_certificate(X509Stream, Certificate),
269 close(X509Stream)),
270 call(KeyCallback, certificate, Certificate, Key).
271resolve_key(KeyInfo, _Key, _KeyCallback, _Options):-
272 273 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
274 memberchk(element(DS:'PGPData', _KeyAttributes, _PGPData), KeyInfo),
275 !,
276 throw(not_implemented).
277resolve_key(KeyInfo, _Key, _KeyCallback, _Options):-
278 279 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
280 memberchk(element(DS:'SPKIData', _KeyAttributes, _SPKIData), KeyInfo),
281 !,
282 throw(not_implemented).
283resolve_key(KeyInfo, _Key, _KeyCallback, _Options):-
284 285 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
286 memberchk(element(DS:'MgmtData', _KeyAttributes, _SPKIData), KeyInfo),
287 !,
288 throw(not_implemented).
289resolve_key(Info, _, _, _):-
290 291 292 293 existence_error(usable_key, Info).
294
295
296base64_to_hex(Base64, Hex):-
297 base64(Raw, Base64),
298 atom_codes(Raw, Codes),
299 hex_bytes(Hex0, Codes),
300 string_upper(Hex0, Hex).
301
302
303determine_encryption_algorithm(EncryptedData, Algorithm, IVSize):-
304 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'),
305 ( memberchk(element(XENC:'EncryptionMethod', EncryptionMethodAttributes, _), EncryptedData)
306 -> 307 memberchk('Algorithm'=XMLAlgorithm, EncryptionMethodAttributes),
308 ( ssl_algorithm(XMLAlgorithm, Algorithm, IVSize)
309 -> true
310 ; domain_error(block_cipher, XMLAlgorithm)
311 )
312 313 314 315 ; existence_error(encryption_method, EncryptedData)
316 ).
317
318base64_element([CipherValueElement], CipherValue):-
319 atom_codes(CipherValueElement, Base64Codes),
320 delete_newlines(Base64Codes, TrimmedCodes),
321 string_codes(Trimmed, TrimmedCodes),
322 base64(CipherValue, Trimmed).
323
324delete_newlines([], []):- !.
325delete_newlines([13|As], B):- !, delete_newlines(As, B).
326delete_newlines([10|As], B):- !, delete_newlines(As, B).
327delete_newlines([A|As], [A|B]):- !, delete_newlines(As, B).