View source with raw comments or as raw
   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         ]).
  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
  49/** <module> XML encryption library
  50
  51This library is a partial implementation of the XML encryption standard.
  52It implements the _decryption_ part, which is needed by SAML clients.
  53
  54@see https://www.w3.org/TR/xmlenc-core1/
  55@see https://en.wikipedia.org/wiki/Security_Assertion_Markup_Language
  56*/
  57
  58% These are the 4 mandatory block cipher algorithms
  59% (actually aes-192-cbc is not mandatory, but it is easy to support)
  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
  65%!  decrypt_xml(+DOMIn, -DOMOut, :KeyCallback, +Options) is det.
  66%
  67%   @arg KeyCallback may be called as follows:
  68%           - call(KeyCallback, name,        KeyName,         Key)
  69%           - call(KeyCallback, public_key,  public_key(RSA), Key)
  70%           - call(KeyCallback, certificate, Certificate,     Key)
  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
  88%!   decrypt_element(+Attributes,
  89%!                   +EncryptedData,
  90%!                   -DecryptedElement,
  91%!                   +Options).
  92%
  93%    Decrypt an EncryptedData element  with   Attributes  and  child
  94%    EncryptedData DecryptedElement will either be an element/3 term
  95%    or a string as dictacted by   the Type attribute in Attributes.
  96%    If Attributes does not contain a  Type attribute then we assume
  97%    it is a string
  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    % The Type attribute is not mandatory. However, 3.1 states that
 108    % "Without this information, the decryptor will be unable to automatically restore the XML document to its original cleartext form."
 109    (  memberchk('Type'=Type, Attributes)
 110    -> true
 111    ;  Type = 'http://www.w3.org/2001/04/xmlenc#Content'
 112    ),
 113
 114    % First of all, determine the algorithm used to encrypt the data
 115    determine_encryption_algorithm(EncryptedData, Algorithm, IVSize),
 116
 117    % There are now two tasks remaining, and they seem like they ought to be quite simple, but unfortunately they are not
 118    % First, we must determine the key used to encrypt the message
 119    determine_key(EncryptedData, Key, KeyCallback, Options),
 120
 121    % Then, we must determine what the encrypted data even IS
 122    % If the message includes a CipherValue then this is straightfoward - the encrypted data is the base64-encoded child
 123    % of this element.
 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           % However, it is allowed to include CipherReference instead. This is an arbitrary URI and a list of transforms to convert the
 135           % data identified by that URI into the raw octets that represent the encrypted data
 136           % The URI attribute of the CipherReference element is mandatory
 137           memberchk('URI'=CipherURI, CipherReferenceAttributes),
 138           % The transforms attribute is optional, though.
 139           (  memberchk(element('Transforms', _, Transforms), CipherReference)
 140           -> true
 141           ;  Transforms = []
 142           ),
 143           uri_components(CipherURI, uri_components(Scheme, _, _, _, _)),
 144           (  ( Scheme == 'http' ; Scheme == 'https')
 145              % FIXME: URI may not be an *absolute* URL
 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    % The XML-ENC padding scheme does not comply with RFC-1423. This has been noted a few times by people trying to write
 158    % XML-ENC decryptors backed by OpenSSL, which insists on compliance. The only recourse we have is to disable padding entirely
 159    % and do it in our application
 160    xmlenc_padding(DecryptedStringWithPadding, DecryptedString),
 161    % Now that we have the decrypted data, we can decide whether to turn it into an element or leave it as
 162    % content
 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    % FIXME: Not implemented
 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    ;  % Technically the KeyInfo is not mandatory. However, without a key we cannot decrypt
 190           % so raise an error. In the future Options could contain a key if it is agreed upon
 191           % by some other channel
 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    % EncryptedKey
 200    XENC = 'http://www.w3.org/2001/04/xmlenc#',
 201    memberchk(element(ns(_, XENC):'EncryptedKey', _KeyAttributes, EncryptedKey), Info),
 202    !,
 203    % The EncryptedKey is slightly different to EncryptedData. For a start, the algorithms used to decrypt the
 204    % key are orthogonal to those used for EncryptedData. However we can recursively search for the keys then
 205    % decrypt them using the different algorithms as needed
 206    memberchk(element(ns(_, XENC):'EncryptionMethod', MethodAttributes, EncryptionMethod), EncryptedKey),
 207    memberchk('Algorithm'=Algorithm, MethodAttributes),
 208
 209    % Now find the KeyInfo
 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)   % This is just the same as rsa-oaep-mgf1p!
 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    % AgreementMethod. FIXME: Not implemented
 227    XENC = ns(_, 'http://www.w3.org/2001/04/xmlenc#'),
 228    memberchk(element(XENC:'AgreementMethod', _KeyAttributes, _AgreementMethod), KeyInfo),
 229    !,
 230    throw(not_implemented).
 231% Additionally, we are allowed to use any elements from XML-DSIG
 232resolve_key(KeyInfo, Key, KeyCallback, _Options):-
 233    % KeyName. Use the callback with type=name and hint=KeyName
 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    % RetrievalMethod. FIXME: Not implemented
 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    % KeyValue.
 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), _)) % FIXME: Not implemented
 257    ;  existence_error(usable_key_value, KeyValue)
 258    ).
 259resolve_key(KeyInfo, Key, KeyCallback, _Options):-
 260    % X509Data.
 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    % PGPData. FIXME: Not implemented
 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    % SPKIData. FIXME: Not implemented
 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    % MgmtData. FIXME: Not implemented
 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    % The XML-ENC standard allows for arbitrary other means of transmitting keys in application-specific
 291    % protocols. This is not supported here, though. In the future a callback could be provided in Options
 292    % to obtain the key information from a KeyInfo structure.
 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    -> % This is a mandatory attribute
 307           memberchk('Algorithm'=XMLAlgorithm, EncryptionMethodAttributes),
 308           (  ssl_algorithm(XMLAlgorithm, Algorithm, IVSize)
 309           -> true
 310           ; domain_error(block_cipher, XMLAlgorithm)
 311           )
 312        % In theory the EncryptionMethod is optional. In pracitse though, if the method is not supplied we
 313        % cannot decrypt the data. In the future we could support encryption_algorithm/1 as an option to
 314        % decrypt_element/3 but for now raise an exception
 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).