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]).   51
   52/** <module> XML Digital signature
   53
   54This library deals with _XMLDSIG_, RSA signed XML documents.
   55
   56@see http://www.di-mgt.com.au/xmldsig.html
   57@see https://www.bmt-online.org/geekisms/RSA_verify
   58@see http://stackoverflow.com/questions/5576777/whats-the-difference-between-nid-sha-and-nid-sha1-in-openssl
   59
   60*/
   61
   62xmldsig_ns('http://www.w3.org/2000/09/xmldsig#').
   63
   64%!  xmld_signed_DOM(+DOM, -SignedDOM, +Options) is det.
   65%
   66%   Translate an XML DOM structure in a signed version.  Options:
   67%
   68%     - key_file(+File)
   69%     File holding the private key needed to sign
   70%     - key_password(+Password)
   71%     String holding the password to op the private key.
   72%
   73%   The   SignedDOM   must   be   emitted   using   xml_write/3   or
   74%   xml_write_canonical/3.  If  xml_write/3  is   used,  the  option
   75%   layout(false) is needed to avoid  changing   the  layout  of the
   76%   =SignedInfo= element and the signed DOM,   which  will cause the
   77%   signature to be invalid.
   78
   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).
   83
   84
   85%!  dom_hash(+DOM, -ODOM, -Hash, +Options) is det.
   86%
   87%   Compute the digest for DOM.
   88%
   89%   @arg Hash is the base64  encoded   version  of  the selected SHA
   90%   algorithm.
   91
   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).
  115
  116%!  signed_info(+Hash, -Signature, -SDOM, -KeyDOM, +Options)
  117
  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).
  124
  125%!  signed_info_dom(+Hash, -SDOM, +Options) is det.
  126%
  127%   True when SDOM is the xmldsign:Signature  DOM for an object with
  128%   the given Hash.
  129
  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'.
  154
  155%!  rsa_signature(+SignedInfo:string, -Signature, -KeyDOM, +Options)
  156
  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),_)).
  187
  188
  189
  190%!  rsa_key_dom(+Key, -DOM) is det.
  191%
  192%   Produce the KeyInfo node from the private key.
  193
  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).
  211
  212
  213%!  key_info(+Key, -Info) is det.
  214%
  215%   Extract the RSA modulus and exponent   from a private key. These
  216%   are the first end  second  field  of   the  rsa  term.  They are
  217%   represented as hexadecimal encoded bytes. We must recode this to
  218%   base64.
  219%
  220%   @tbd    Provide better support from library(ssl).
  221
  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).
  246
  247
  248
  249%!  xmld_verify_signature(+DOM, +SignatureDOM, -Certificate, +Options) is det.
  250%
  251%   Confirm  that  an  `ds:Signature`  element    contains  a  valid
  252%   signature. Certificate is bound to  the certificate that appears
  253%   in the element if the signature is valid. It is up to the caller
  254%   to determine if the certificate is trusted   or not.
  255%
  256%   *Note*: The DOM and SignatureDOM must   have been obtained using
  257%   the load_structure/3 option keep_prefix(true)   otherwise  it is
  258%   impossible to generate an identical   document  for checking the
  259%   signature. See also xml_write_canonical/3.
  260
  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)