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

   62xmldsig_ns('http://www.w3.org/2000/09/xmldsig#').

 xmld_signed_DOM(+DOM, -SignedDOM, +Options) is det

Translate an XML DOM structure in a signed version. Options:

key_file(+File)

File holding the private key needed to sign

key_password(+Password)

String holding the password to op the private key.

The SignedDOM must be emitted using xml_write/3 or xml_write_canonical/3. If xml_write/3 is used, the option layout(false) is needed to avoid changing the layout of the SignedInfo element and the signed DOM, which will cause the signature to be invalid.

   79xmld_signed_DOM(DOM, SignedDOM, Options) :-
   80    dom_hash(DOM, ODOM, Hash, Options),
   81    signed_info(Hash, Signature, SDOM, KeyDOM, Options),
   82    signed_xml_dom(ODOM, SDOM, KeyDOM, Signature, SignedDOM, Options).

 dom_hash(+DOM, -ODOM, -Hash, +Options) is det

Compute the digest for DOM.

Arguments:

Hash	- is the base64 encoded version of the selected SHA algorithm.

   92dom_hash(DOM, ODOM, Hash, Options) :-
   93    object_c14n(DOM, ODOM, C14N),
   94    hash(C14N, Hash, Options).
   95
   96object_c14n(DOM, ODOM, C14N) :-
   97    object_dom(DOM, ODOM),
   98    with_output_to(
   99        string(C14N),
  100        xml_write_canonical(current_output, ODOM, [])).
  101
  102object_dom(DOM0,
  103           element(NS:'Object', ['Id'='object', xmlns=NS], DOM)) :-
  104    xmldsig_ns(NS),
  105    to_list(DOM0, DOM).
  106
  107to_list(DOM, DOM) :- DOM = [_|_].
  108to_list(DOM, [DOM]).
  109
  110hash(C14N, Hash, Options) :-
  111    option(hash(Algo), Options, sha1),
  112    sha_hash(C14N, HashCodes, [algorithm(Algo)]),
  113    phrase(base64(HashCodes), Base64Codes),
  114    string_codes(Hash, Base64Codes).

 signed_info(+Hash, -Signature, -SDOM, -KeyDOM, +Options)

  118signed_info(Hash, Signature, SDOM, KeyDOM, Options) :-
  119    signed_info_dom(Hash, SDOM, Options),
  120    with_output_to(
  121        string(SignedInfo),
  122        xml_write_canonical(current_output, SDOM, [])),
  123    rsa_signature(SignedInfo, Signature, KeyDOM, Options).

 signed_info_dom(+Hash, -SDOM, +Options) is det

True when SDOM is the xmldsign:Signature DOM for an object with the given Hash.

  130signed_info_dom(Hash, SDOM, _Options) :-
  131    SDOM = element(NS:'SignedInfo', [xmlns=NS],
  132                   [ '\n  ',
  133                     element(NS:'CanonicalizationMethod',
  134                             ['Algorithm'=C14NAlgo], []),
  135                     '\n  ',
  136                     element(NS:'SignatureMethod',
  137                             ['Algorithm'=SignatureMethod], []),
  138                     '\n  ',
  139                     Reference,
  140                     '\n'
  141                   ]),
  142    Reference = element(NS:'Reference', ['URI'='#object'],
  143                        [ '\n    ',
  144                          element(NS:'DigestMethod',
  145                                  ['Algorithm'=DigestMethod], []),
  146                          '\n    ',
  147                          element(NS:'DigestValue', [], [Hash]),
  148                          '\n  '
  149                        ]),
  150    xmldsig_ns(NS),
  151    DigestMethod='http://www.w3.org/2000/09/xmldsig#sha1',
  152    C14NAlgo='http://www.w3.org/TR/2001/REC-xml-c14n-20010315',
  153    SignatureMethod='http://www.w3.org/2000/09/xmldsig#rsa-sha1'.

 rsa_signature(+SignedInfo:string, -Signature, -KeyDOM, +Options)

  157rsa_signature(SignedInfo, Signature, KeyDOM, Options) :-
  158    option(algorithm(Algorithm), Options, sha1),
  159    crypto_data_hash(SignedInfo, Digest, [algorithm(Algorithm)]),
  160    string_upper(Digest, DIGEST),
  161    debug(xmldsig, 'SignedInfo ~w digest = ~p', [Algorithm, DIGEST]),
  162    private_key(Key, Options),
  163    rsa_key_dom(Key, KeyDOM),
  164    rsa_sign(Key, Digest, String,
  165             [ type(Algorithm)
  166             ]),
  167    string_length(String, Len),
  168    debug(xmldsig, 'RSA signatute length: ~p', [Len]),
  169    string_codes(String, Codes),
  170    phrase(base64(Codes), Codes64),
  171    string_codes(Signature, Codes64).
  172
  173private_key(Key, Options) :-
  174    option(key_file(File), Options),
  175    option(key_password(Password), Options),
  176    !,
  177    setup_call_cleanup(
  178        open(File, read, In, [type(binary)]),
  179        load_private_key(In, Password, Key),
  180        close(In)).
  181private_key(_Key, Options) :-
  182    \+ option(key_file(_), Options),
  183    !,
  184    throw(error(existence_error(option, key_file, Options),_)).
  185private_key(_Key, Options) :-
  186    throw(error(existence_error(option, key_password, Options),_)).

 rsa_key_dom(+Key, -DOM) is det

Produce the KeyInfo node from the private key.

  194rsa_key_dom(Key,
  195            element(NS:'KeyInfo', [xmlns=NS],
  196                    [ element(NS:'KeyValue', [],
  197                              [ '\n  ',
  198                                element(NS:'RSAKeyValue', [],
  199                                        [ '\n    ',
  200                                          element(NS:'Modulus', [], [Modulus]),
  201                                          '\n    ',
  202                                          element(NS:'Exponent', [], [Exponent]),
  203                                          '\n  '
  204                                        ]),
  205                                '\n'
  206                              ])
  207                    ])) :-
  208    key_info(Key, Info),
  209    _{modulus:Modulus, exponent:Exponent} :< Info,
  210    xmldsig_ns(NS).

 key_info(+Key, -Info) is det

Extract the RSA modulus and exponent from a private key. These are the first end second field of the rsa term. They are represented as hexadecimal encoded bytes. We must recode this to base64.

To be done

- Provide better support from library(ssl).

  222key_info(private_key(Key), rsa{modulus:Modulus, exponent:Exponent}) :-
  223    !,
  224    base64_bignum_arg(1, Key, Modulus),
  225    base64_bignum_arg(2, Key, Exponent).
  226key_info(Key, _) :-
  227    type_error(private_key, Key).
  228
  229base64_bignum_arg(I, Key, Value) :-
  230    arg(I, Key, HexModulesString),
  231    string_codes(HexModulesString, HexModules),
  232    hex_bytes(HexModules, Bytes),
  233    phrase(base64(Bytes), Bytes64),
  234    string_codes(Value, Bytes64).
  235
  236
  237signed_xml_dom(ObjectDOM, SDOM, KeyDOM, Signature, SignedDOM, _Options) :-
  238    SignedDOM = element(NS:'Signature', [xmlns=NS],
  239                        [ '\n', SDOM,
  240                          '\n', element(NS:'SignatureValue', [], [Signature]),
  241                          '\n', KeyDOM,
  242                          '\n', ObjectDOM,
  243                          '\n'
  244                        ]),
  245    xmldsig_ns(NS).

 xmld_verify_signature(+DOM, +SignatureDOM, -Certificate, +Options) is det

Confirm that an ds:Signature element contains a valid signature. Certificate is bound to the certificate that appears in the element if the signature is valid. It is up to the caller to determine if the certificate is trusted or not.

Note: The DOM and SignatureDOM must have been obtained using the load_structure/3 option keep_prefix(true) otherwise it is impossible to generate an identical document for checking the signature. See also xml_write_canonical/3.

  261xmld_verify_signature(DOM, SignatureDOM, Certificate, Options) :-
  262    signature_info(DOM, SignatureDOM, SignedInfo, Algorithm, Signature,
  263                   PublicKey, Certificate, CanonicalizationMethod),
  264    base64(RawSignature, Signature),
  265    (   Algorithm = rsa(HashType)
  266    ->  with_output_to(string(C14N),
  267                       xml_write_canonical(current_output, SignedInfo,
  268                                           [method(CanonicalizationMethod)|Options])),
  269        crypto_data_hash(C14N, Digest, [algorithm(HashType)]),
  270        atom_codes(RawSignature, Codes),
  271        hex_bytes(HexSignature, Codes),
  272        rsa_verify(PublicKey, Digest, HexSignature, [type(HashType)])
  273    ;   domain_error(supported_signature_algorithm, Algorithm)
  274    ).
  275
  276ssl_algorithm('http://www.w3.org/2000/09/xmldsig#rsa-sha1', rsa(sha1)).
  277ssl_algorithm('http://www.w3.org/2000/09/xmldsig#dsa-sha1', dsa(sha1)).
  278ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-md5', hmac(md5)).       % NB: Requires a parameter
  279ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha224', hmac(sha224)).
  280ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha256', hmac(sha256)).
  281ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha384', hmac(sha384)).
  282ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha512', hmac(sha512)).
  283ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-md5', rsa(md5)).
  284ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha256', rsa(sha256)).
  285ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha384', rsa(sha384)).
  286ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha512', rsa(sha512)).
  287ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-ripemd160', rsa(ripemd160)).
  288ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha1', ecdsa(sha1)).
  289ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha224', ecdsa(sha224)).
  290ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha256', ecdsa(sha256)).
  291ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha384', ecdsa(sha384)).
  292ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha512', ecdsa(sha512)).
  293ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha1', esign(sha1)).
  294ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha224', esign(sha224)).
  295ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha256', esign(sha256)).
  296ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha384', esign(sha384)).
  297ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha512', esign(sha512)).
  298
  299digest_method('http://www.w3.org/2000/09/xmldsig#sha1', sha1).
  300digest_method('http://www.w3.org/2001/04/xmlenc#sha256', sha256).
  301
  302signature_info(DOM, Signature, SignedData, Algorithm, SignatureValue,
  303               PublicKey, Certificate, CanonicalizationMethod) :-
  304    xmldsig_ns(NSRef),
  305    memberchk(element(ns(_, NSRef):'SignatureValue', _, [RawSignatureValue]), Signature),
  306    atom_codes(RawSignatureValue, RawSignatureCodes),
  307    delete_newlines(RawSignatureCodes, SignatureCodes),
  308    string_codes(SignatureValue, SignatureCodes),
  309    memberchk(element(ns(Prefix, NSRef):'SignedInfo', SignedInfoAttributes, SignedInfo), Signature),
  310    SignedData = element(ns(Prefix, NSRef):'SignedInfo', SignedInfoAttributes, SignedInfo),
  311    memberchk(element(ns(_, NSRef):'CanonicalizationMethod', CanonicalizationMethodAttributes, _), SignedInfo),
  312    memberchk('Algorithm'=CanonicalizationMethod, CanonicalizationMethodAttributes),
  313    forall(memberchk(element(ns(_, NSRef):'Reference', ReferenceAttributes, Reference), SignedInfo),
  314           verify_digest(ReferenceAttributes, CanonicalizationMethod, Reference, DOM)),
  315    memberchk(element(ns(_, NSRef):'SignatureMethod', SignatureMethodAttributes, []), SignedInfo),
  316    memberchk('Algorithm'=XMLAlgorithm, SignatureMethodAttributes),
  317    ssl_algorithm(XMLAlgorithm, Algorithm),
  318    memberchk(element(ns(_, NSRef):'KeyInfo', _, KeyInfo), Signature),
  319    ( memberchk(element(ns(_, NSRef):'X509Data', _, X509Data), KeyInfo),
  320      memberchk(element(ns(_, NSRef):'X509Certificate', _, [X509Certificate]), X509Data)->
  321        load_certificate_from_base64_string(X509Certificate, Certificate),
  322        certificate_field(Certificate, public_key(PublicKey))
  323    ; throw(not_implemented)
  324    ).
  325
  326
  327delete_newlines([], []):- !.
  328delete_newlines([13|As], B):- !, delete_newlines(As, B).
  329delete_newlines([10|As], B):- !, delete_newlines(As, B).
  330delete_newlines([A|As], [A|B]):- !, delete_newlines(As, B).
  331
  332
  333verify_digest(ReferenceAttributes, CanonicalizationMethod, Reference, DOM):-
  334    xmldsig_ns(NSRef),
  335    memberchk('URI'=URI, ReferenceAttributes),
  336    atom_concat('#', Id, URI),
  337    % Find the relevant bit of the DOM
  338    resolve_reference(DOM, Id, Digestible, _NSMap),
  339    (  memberchk(element(ns(_, NSRef):'Transforms', _, Transforms), Reference)
  340    -> findall(TransformAttributes-Transform,
  341               member(element(ns(_, NSRef):'Transform', TransformAttributes, Transform), Transforms),
  342               TransformList)
  343    ;  TransformList = []
  344    ),
  345    apply_transforms(TransformList, Digestible, TransformedDigestible),
  346    memberchk(element(ns(_, NSRef):'DigestMethod', DigestMethodAttributes, _), Reference),
  347    memberchk(element(ns(_, NSRef):'DigestValue', _, [DigestBase64]), Reference),
  348    memberchk('Algorithm'=Algorithm, DigestMethodAttributes),
  349    (  digest_method(Algorithm, DigestMethod)
  350    -> true
  351    ;  domain_error(supported_digest_method, DigestMethod)
  352    ),
  353    with_output_to(string(XMLString), xml_write_canonical(current_output, TransformedDigestible, [method(CanonicalizationMethod)])),
  354    sha_hash(XMLString, DigestBytes, [algorithm(DigestMethod)]),
  355    base64(ExpectedDigest, DigestBase64),
  356    atom_codes(ExpectedDigest, ExpectedDigestBytes),
  357    (  ExpectedDigestBytes == DigestBytes
  358    -> true
  359    ;  throw(error(invalid_digest, _))
  360    ).
  361
  362resolve_reference([element(Tag, Attributes, Children)|_], ID, element(Tag, Attributes, Children), []):-
  363    memberchk('ID'=ID, Attributes),
  364    !.
  365resolve_reference([element(_, Attributes, Children)|Siblings], ID, Element, Map):-
  366    ( findall(xmlns:Prefix=URI,
  367              member(xmlns:Prefix=URI, Attributes),
  368              Map,
  369              Tail),
  370          resolve_reference(Children, ID, Element, Tail)
  371    ; resolve_reference(Siblings, ID, Element, Map)
  372    ).
  373
  374
  375apply_transforms([], X, X):- !.
  376apply_transforms([Attributes-Children|Transforms], In, Out):-
  377    memberchk('Algorithm'=Algorithm, Attributes),
  378    (  apply_transform(Algorithm, Children, In, I1)
  379    -> true
  380    ;  existence_error(transform_algorithm, Algorithm)
  381    ),
  382    apply_transforms(Transforms, I1, Out).
  383
  384apply_transform('http://www.w3.org/2001/10/xml-exc-c14n#', [], X, X).
  385
  386apply_transform('http://www.w3.org/2000/09/xmldsig#enveloped-signature', [], element(Tag, Attributes, Children), element(Tag, Attributes, NewChildren)):-
  387    delete_signature_element(Children, NewChildren).
  388
  389delete_signature_element([element(ns(_, 'http://www.w3.org/2000/09/xmldsig#'):'Signature', _, _)|Siblings], Siblings):- !.
  390delete_signature_element([A|Siblings], [A|NewSiblings]):-
  391    delete_signature_element(Siblings, NewSiblings)