1/* Part of SWI-Prolog 2 3 Author: Matt Lilley 4 E-mail: thetrime@gmail.com 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2004-2016, SWI-Prolog Foundation 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36 37:-module(xmlenc, 38 [ decrypt_xml/4, % +EncryptedXML, -DecryptedXML, :KeyCallback, +Options 39 load_certificate_from_base64_string/2 % +Base64String, -Certificate 40 ]). 41:- use_module(library(ssl)). 42:- use_module(library(crypto)). 43:- use_module(library(sgml)). 44:- use_module(library(base64)). 45:- use_module(library(error)). 46 47:- meta_predicate 48 decrypt_xml(+, -, 3, +).

XML encryption library

This library is a partial implementation of the XML encryption standard. It implements the decryption part, which is needed by SAML clients.

See also: - https://www.w3.org/TR/xmlenc-core1/; - https://en.wikipedia.org/wiki/Security_Assertion_Markup_Language */

59% These are the 4 mandatory block cipher algorithms 60% (actually aes-192-cbc is not mandatory, but it is easy to support) 61ssl_algorithm('http://www.w3.org/2001/04/xmlenc#tripledes-cbc', 'des3', 8). 62ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes128-cbc', 'aes-128-cbc', 16). 63ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes256-cbc', 'aes-256-cbc', 32). 64ssl_algorithm('http://www.w3.org/2001/04/xmlenc#aes192-cbc', 'aes-192-cbc', 24).

73decrypt_xml([], [], _, _):- !. 74decrypt_xml([element(ns(_, 'http://www.w3.org/2001/04/xmlenc#'):'EncryptedData', 75 Attributes, EncryptedData)|Siblings], 76 [Decrypted|NewSiblings], KeyCallback, Options) :- 77 !, 78 decrypt_element(Attributes, EncryptedData, Decrypted, KeyCallback, Options), 79 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options). 80 81decrypt_xml([element(Tag, Attributes, Children)|Siblings], 82 [element(Tag, Attributes, NewChildren)|NewSiblings], KeyCallback, Options) :- 83 !, 84 decrypt_xml(Children, NewChildren, KeyCallback, Options), 85 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options). 86decrypt_xml([Other|Siblings], [Other|NewSiblings], KeyCallback, Options):- 87 decrypt_xml(Siblings, NewSiblings, KeyCallback, Options).

100:-meta_predicate(decrypt_element(+, +, -, 3, +)). 101 102decrypt_element(Attributes, EncryptedData, Decrypted, KeyCallback, Options):- 103 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'), 104 ( memberchk(element(XENC:'CipherData', _, CipherData), EncryptedData) 105 -> true 106 ; existence_error(cipher_data, EncryptedData) 107 ), 108 % The Type attribute is not mandatory. However, 3.1 states that 109 % "Without this information, the decryptor will be unable to automatically restore the XML document to its original cleartext form." 110 ( memberchk('Type'=Type, Attributes) 111 -> true 112 ; Type = 'http://www.w3.org/2001/04/xmlenc#Content' 113 ), 114 115 % First of all, determine the algorithm used to encrypt the data 116 determine_encryption_algorithm(EncryptedData, Algorithm, IVSize), 117 118 % There are now two tasks remaining, and they seem like they ought to be quite simple, but unfortunately they are not 119 % First, we must determine the key used to encrypt the message 120 determine_key(EncryptedData, Key, KeyCallback, Options), 121 122 % Then, we must determine what the encrypted data even IS 123 % If the message includes a CipherValue then this is straightfoward - the encrypted data is the base64-encoded child 124 % of this element. 125 ( memberchk(element(XENC:'CipherValue', _, CipherValueElement), CipherData) 126 -> base64_element(CipherValueElement, CipherValueWithIV), 127 string_codes(CipherValueWithIV, CipherValueWithIVCodes), 128 length(IVCodes, IVSize), 129 append(IVCodes, CipherCodes, CipherValueWithIVCodes), 130 string_codes(IV, IVCodes), 131 string_codes(CipherText, CipherCodes), 132 length(CipherValueWithIVCodes, _), 133 crypto_data_decrypt(CipherText, Algorithm, Key, IV, DecryptedStringWithPadding, [padding(none), encoding(octet)]) 134 ; memberchk(element(XENC:'CipherReference', CipherReferenceAttributes, CipherReference), CipherData)-> 135 % However, it is allowed to include CipherReference instead. This is an arbitrary URI and a list of transforms to convert the 136 % data identified by that URI into the raw octets that represent the encrypted data 137 % The URI attribute of the CipherReference element is mandatory 138 memberchk('URI'=CipherURI, CipherReferenceAttributes), 139 % The transforms attribute is optional, though. 140 ( memberchk(element('Transforms', _, Transforms), CipherReference) 141 -> true 142 ; Transforms = [] 143 ), 144 uri_components(CipherURI, uri_components(Scheme, _, _, _, _)), 145 ( ( Scheme == 'http' ; Scheme == 'https') 146 % FIXME: URI may not be an *absolute* URL 147 -> with_output_to(string(RawCipherValue), 148 setup_call_cleanup(http_open(CipherURI, HTTPStream, []), 149 copy_stream_data(HTTPStream, current_output), 150 close(HTTPStream))) 151 ; domain_error(resolvable_uri, CipherURI) 152 ), 153 apply_ciphertext_transforms(RawCipherValue, Transforms, CipherValue), 154 sub_string(CipherValue, 0, IVSize, _, IV), 155 sub_string(CipherValue, IVSize, _, 0, CipherText), 156 crypto_data_decrypt(CipherText, Algorithm, Key, IV, DecryptedStringWithPadding, [padding(none), encoding(octet)]) 157 ), 158 % The XML-ENC padding scheme does not comply with RFC-1423. This has been noted a few times by people trying to write 159 % XML-ENC decryptors backed by OpenSSL, which insists on compliance. The only recourse we have is to disable padding entirely 160 % and do it in our application 161 xmlenc_padding(DecryptedStringWithPadding, DecryptedString), 162 % Now that we have the decrypted data, we can decide whether to turn it into an element or leave it as 163 % content 164 ( Type == 'http://www.w3.org/2001/04/xmlenc#Element' 165 -> setup_call_cleanup(open_string(DecryptedString, StringStream), 166 load_structure(StringStream, [Decrypted], [dialect(xmlns), keep_prefix(true)]), 167 close(StringStream)) 168 ; Decrypted = DecryptedString 169 ). 170 171xmlenc_padding(DecryptedStringWithPadding, DecryptedString):- 172 string_length(DecryptedStringWithPadding, _), 173 string_codes(DecryptedStringWithPadding, Codes), 174 append(_, [LastCode], Codes), 175 length(Padding, LastCode), 176 append(DecryptedCodes, Padding, Codes), 177 !, 178 string_codes(DecryptedString, DecryptedCodes). 179 180apply_ciphertext_transforms(CipherValue, [], CipherValue):- !. 181apply_ciphertext_transforms(_, [_AnythingElse|_], _):- 182 % FIXME: Not implemented 183 throw(error(implementation_missing('CipherReference transforms are not implemented', _))). 184 185:- meta_predicate determine_key(+,-,3,+). 186determine_key(EncryptedData, Key, KeyCallback, Options):- 187 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 188 ( memberchk(element(DS:'KeyInfo', _, KeyInfo), EncryptedData) 189 -> true 190 ; % Technically the KeyInfo is not mandatory. However, without a key we cannot decrypt 191 % so raise an error. In the future Options could contain a key if it is agreed upon 192 % by some other channel 193 existence_error(key_info, EncryptedData) 194 ), 195 resolve_key(KeyInfo, Key, KeyCallback, Options). 196 197:- meta_predicate resolve_key(+,-,3,+). 198 199resolve_key(Info, Key, KeyCallback, Options):- 200 % EncryptedKey 201 XENC = 'http://www.w3.org/2001/04/xmlenc#', 202 memberchk(element(ns(_, XENC):'EncryptedKey', _KeyAttributes, EncryptedKey), Info), 203 !, 204 % The EncryptedKey is slightly different to EncryptedData. For a start, the algorithms used to decrypt the 205 % key are orthogonal to those used for EncryptedData. However we can recursively search for the keys then 206 % decrypt them using the different algorithms as needed 207 memberchk(element(ns(_, XENC):'EncryptionMethod', MethodAttributes, EncryptionMethod), EncryptedKey), 208 memberchk('Algorithm'=Algorithm, MethodAttributes), 209 210 % Now find the KeyInfo 211 determine_key(EncryptedKey, PrivateKey, KeyCallback, Options), 212 213 memberchk(element(ns(_, XENC):'CipherData', _, CipherData), EncryptedKey), 214 memberchk(element(ns(_, XENC):'CipherValue', _, CipherValueElement), CipherData), 215 base64_element(CipherValueElement, CipherValue), 216 ( Algorithm == 'http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p' 217 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1_oaep)]) 218 ; Algorithm == 'http://www.w3.org/2009/xmlenc11#rsa-oaep', 219 memberchk(element(ns(_, 'http://www.w3.org/2009/xmlenc11#'):'MGF', MGFAttributes, _), EncryptionMethod), 220 memberchk('Algorithm'='http://www.w3.org/2009/xmlenc11#mgf1sha1', MGFAttributes) % This is just the same as rsa-oaep-mgf1p! 221 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1_oaep)]) 222 ; Algorithm == 'http://www.w3.org/2001/04/xmlenc#rsa-1_5' 223 -> rsa_private_decrypt(PrivateKey, CipherValue, Key, [encoding(octet), padding(pkcs1)]) 224 ; domain_error(key_transport, Algorithm) 225 ). 226resolve_key(KeyInfo, _Key, _KeyCallback, _Options):- 227 % AgreementMethod. FIXME: Not implemented 228 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'), 229 memberchk(element(XENC:'AgreementMethod', _KeyAttributes, _AgreementMethod), KeyInfo), 230 !, 231 throw(not_implemented). 232% Additionally, we are allowed to use any elements from XML-DSIG 233resolve_key(KeyInfo, Key, KeyCallback, _Options):- 234 % KeyName. Use the callback with type=name and hint=KeyName 235 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 236 memberchk(element(DS:'KeyName', _KeyAttributes, [KeyName]), KeyInfo), 237 !, 238 call(KeyCallback, name, KeyName, Key). 239resolve_key(KeyInfo, _Key, _KeyCallback, _Options):- 240 % RetrievalMethod. FIXME: Not implemented 241 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 242 memberchk(element(DS:'RetrievalMethod', _KeyAttributes, _RetrievalMethod), KeyInfo), 243 !, 244 throw(not_implemented). 245resolve_key(KeyInfo, Key, KeyCallback, _Options):- 246 % KeyValue. 247 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 248 memberchk(element(DS:'KeyValue', _KeyAttributes, KeyValue), KeyInfo), 249 !, 250 ( memberchk(element(DS:'RSAKeyValue', _, RSAKeyValue), KeyInfo) 251 -> memberchk(element(DS:'Modulus', _, [ModulusBase64]), RSAKeyValue), 252 memberchk(element(DS:'Exponent', _, [ExponentBase64]), RSAKeyValue), 253 base64_to_hex(ModulusBase64, Modulus), 254 base64_to_hex(ExponentBase64, Exponent), 255 call(KeyCallback, public_key, public_key(rsa(Modulus, Exponent, -, -, -, -, -, -)), Key) 256 ; memberchk(element(DS:'DSAKeyValue', _, _DSAKeyValue), KeyInfo) 257 -> throw(error(not_implemented(dsa_key), _)) % FIXME: Not implemented 258 ; existence_error(usable_key_value, KeyValue) 259 ). 260resolve_key(KeyInfo, Key, KeyCallback, _Options):- 261 % X509Data. 262 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 263 memberchk(element(DS:'X509Data', _, X509Data), KeyInfo), 264 memberchk(element(DS:'X509Certificate', _, [X509Certificate]), X509Data), 265 !, 266 load_certificate_from_base64_string(X509Certificate, Certificate), 267 call(KeyCallback, certificate, Certificate, Key). 268resolve_key(KeyInfo, _Key, _KeyCallback, _Options):- 269 % PGPData. FIXME: Not implemented 270 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 271 memberchk(element(DS:'PGPData', _KeyAttributes, _PGPData), KeyInfo), 272 !, 273 throw(not_implemented). 274resolve_key(KeyInfo, _Key, _KeyCallback, _Options):- 275 % SPKIData. FIXME: Not implemented 276 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 277 memberchk(element(DS:'SPKIData', _KeyAttributes, _SPKIData), KeyInfo), 278 !, 279 throw(not_implemented). 280resolve_key(KeyInfo, _Key, _KeyCallback, _Options):- 281 % MgmtData. FIXME: Not implemented 282 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'), 283 memberchk(element(DS:'MgmtData', _KeyAttributes, _SPKIData), KeyInfo), 284 !, 285 throw(not_implemented). 286resolve_key(Info, _, _, _):- 287 % The XML-ENC standard allows for arbitrary other means of transmitting keys in application-specific 288 % protocols. This is not supported here, though. In the future a callback could be provided in Options 289 % to obtain the key information from a KeyInfo structure. 290 existence_error(usable_key, Info). 291 292 293base64_to_hex(Base64, Hex):- 294 base64(Raw, Base64), 295 atom_codes(Raw, Codes), 296 hex_bytes(Hex0, Codes), 297 string_upper(Hex0, Hex). 298 299 300determine_encryption_algorithm(EncryptedData, Algorithm, IVSize):- 301 XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'), 302 ( memberchk(element(XENC:'EncryptionMethod', EncryptionMethodAttributes, _), EncryptedData) 303 -> % This is a mandatory attribute 304 memberchk('Algorithm'=XMLAlgorithm, EncryptionMethodAttributes), 305 ( ssl_algorithm(XMLAlgorithm, Algorithm, IVSize) 306 -> true 307 ; domain_error(block_cipher, XMLAlgorithm) 308 ) 309 % In theory the EncryptionMethod is optional. In pracitse though, if the method is not supplied we 310 % cannot decrypt the data. In the future we could support encryption_algorithm/1 as an option to 311 % decrypt_element/3 but for now raise an exception 312 ; existence_error(encryption_method, EncryptedData) 313 ). 314 315base64_element([CipherValueElement], CipherValue):- 316 atom_codes(CipherValueElement, Base64Codes), 317 delete_newlines(Base64Codes, TrimmedCodes), 318 string_codes(Trimmed, TrimmedCodes), 319 base64(CipherValue, Trimmed). 320 321delete_newlines([], []):- !. 322delete_newlines([13|As], B):- !, delete_newlines(As, B). 323delete_newlines([10|As], B):- !, delete_newlines(As, B). 324delete_newlines([A|As], [A|B]):- !, delete_newlines(As, B).

333load_certificate_from_base64_string(UnnormalizedData, Certificate):- 334 normalize_space(codes(Codes), UnnormalizedData), 335 % Break into 64-byte chunks 336 chunk_certificate(Codes, Chunks), 337 atomics_to_string(["-----BEGIN CERTIFICATE-----"|Chunks], '\n', CompleteCertificate), 338 setup_call_cleanup(open_string(CompleteCertificate, StringStream), 339 load_certificate(StringStream, Certificate), 340 close(StringStream)). 341 342chunk_certificate(Codes, [Chunk|Chunks]):- 343 length(ChunkCodes, 64), 344 append(ChunkCodes, Rest, Codes), 345 !, 346 string_codes(Chunk, ChunkCodes), 347 chunk_certificate(Rest, Chunks). 348chunk_certificate([], ["-----END CERTIFICATE-----\n"]):- !. 349chunk_certificate(LastCodes, [LastChunk, "-----END CERTIFICATE-----\n"]):- 350 string_codes(LastChunk, LastCodes)