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:- autoload(library(base64),[base64/2]). 42:- autoload(library(crypto), 43 [crypto_data_decrypt/6,rsa_private_decrypt/4,hex_bytes/2]). 44:- autoload(library(error),[existence_error/2,domain_error/2]). 45:- autoload(library(lists),[append/3]). 46:- autoload(library(sgml),[load_structure/3]). 47:- autoload(library(ssl),[load_certificate/2]). 48:- autoload(library(uri),[uri_components/2]). 49:- autoload(library(http/http_open),[http_open/3]). 50 51:- meta_predicate 52 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 */

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

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

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

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