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:- use_module(library(option)).   40:- use_module(library(sha)).   41:- use_module(library(ssl)).   42:- use_module(library(crypto)).   43:- use_module(library(base64)).   44:- use_module(library(debug)).   45:- use_module(library(dcg/basics)).   46:- use_module(library(c14n2)).   47
   48/** <module> XML Digital signature
   49
   50This library deals with _XMLDSIG_, RSA signed XML documents.
   51
   52@see http://www.di-mgt.com.au/xmldsig.html
   53@see https://www.bmt-online.org/geekisms/RSA_verify
   54@see http://stackoverflow.com/questions/5576777/whats-the-difference-between-nid-sha-and-nid-sha1-in-openssl
   55
   56*/
   57
   58xmldsig_ns('http://www.w3.org/2000/09/xmldsig#').
   59
   60%!  xmld_signed_DOM(+DOM, -SignedDOM, +Options) is det.
   61%
   62%   Translate an XML DOM structure in a signed version.  Options:
   63%
   64%     - key_file(+File)
   65%     File holding the private key needed to sign
   66%     - key_password(+Password)
   67%     String holding the password to op the private key.
   68%
   69%   The   SignedDOM   must   be   emitted   using   xml_write/3   or
   70%   xml_write_canonical/3.  If  xml_write/3  is   used,  the  option
   71%   layout(false) is needed to avoid  changing   the  layout  of the
   72%   =SignedInfo= element and the signed DOM,   which  will cause the
   73%   signature to be invalid.
   74
   75xmld_signed_DOM(DOM, SignedDOM, Options) :-
   76    dom_hash(DOM, ODOM, Hash, Options),
   77    signed_info(Hash, Signature, SDOM, KeyDOM, Options),
   78    signed_xml_dom(ODOM, SDOM, KeyDOM, Signature, SignedDOM, Options).
   79
   80
   81%!  dom_hash(+DOM, -ODOM, -Hash, +Options) is det.
   82%
   83%   Compute the digest for DOM.
   84%
   85%   @arg Hash is the base64  encoded   version  of  the selected SHA
   86%   algorithm.
   87
   88dom_hash(DOM, ODOM, Hash, Options) :-
   89    object_c14n(DOM, ODOM, C14N),
   90    hash(C14N, Hash, Options).
   91
   92object_c14n(DOM, ODOM, C14N) :-
   93    object_dom(DOM, ODOM),
   94    with_output_to(
   95        string(C14N),
   96        xml_write_canonical(current_output, ODOM, [])).
   97
   98object_dom(DOM0,
   99           element(NS:'Object', ['Id'='object', xmlns=NS], DOM)) :-
  100    xmldsig_ns(NS),
  101    to_list(DOM0, DOM).
  102
  103to_list(DOM, DOM) :- DOM = [_|_].
  104to_list(DOM, [DOM]).
  105
  106hash(C14N, Hash, Options) :-
  107    option(hash(Algo), Options, sha1),
  108    sha_hash(C14N, HashCodes, [algorithm(Algo)]),
  109    phrase(base64(HashCodes), Base64Codes),
  110    string_codes(Hash, Base64Codes).
  111
  112%!  signed_info(+Hash, -Signature, -SDOM, -KeyDOM, +Options)
  113
  114signed_info(Hash, Signature, SDOM, KeyDOM, Options) :-
  115    signed_info_dom(Hash, SDOM, Options),
  116    with_output_to(
  117        string(SignedInfo),
  118        xml_write_canonical(current_output, SDOM, [])),
  119    rsa_signature(SignedInfo, Signature, KeyDOM, Options).
  120
  121%!  signed_info_dom(+Hash, -SDOM, +Options) is det.
  122%
  123%   True when SDOM is the xmldsign:Signature  DOM for an object with
  124%   the given Hash.
  125
  126signed_info_dom(Hash, SDOM, _Options) :-
  127    SDOM = element(NS:'SignedInfo', [xmlns=NS],
  128                   [ '\n  ',
  129                     element(NS:'CanonicalizationMethod',
  130                             ['Algorithm'=C14NAlgo], []),
  131                     '\n  ',
  132                     element(NS:'SignatureMethod',
  133                             ['Algorithm'=SignatureMethod], []),
  134                     '\n  ',
  135                     Reference,
  136                     '\n'
  137                   ]),
  138    Reference = element(NS:'Reference', ['URI'='#object'],
  139                        [ '\n    ',
  140                          element(NS:'DigestMethod',
  141                                  ['Algorithm'=DigestMethod], []),
  142                          '\n    ',
  143                          element(NS:'DigestValue', [], [Hash]),
  144                          '\n  '
  145                        ]),
  146    xmldsig_ns(NS),
  147    DigestMethod='http://www.w3.org/2000/09/xmldsig#sha1',
  148    C14NAlgo='http://www.w3.org/TR/2001/REC-xml-c14n-20010315',
  149    SignatureMethod='http://www.w3.org/2000/09/xmldsig#rsa-sha1'.
  150
  151%!  rsa_signature(+SignedInfo:string, -Signature, -KeyDOM, +Options)
  152
  153rsa_signature(SignedInfo, Signature, KeyDOM, Options) :-
  154    option(algorithm(Algorithm), Options, sha1),
  155    crypto_data_hash(SignedInfo, Digest, [algorithm(Algorithm)]),
  156    string_upper(Digest, DIGEST),
  157    debug(xmldsig, 'SignedInfo ~w digest = ~p', [Algorithm, DIGEST]),
  158    private_key(Key, Options),
  159    rsa_key_dom(Key, KeyDOM),
  160    rsa_sign(Key, Digest, String,
  161             [ type(Algorithm)
  162             ]),
  163    string_length(String, Len),
  164    debug(xmldsig, 'RSA signatute length: ~p', [Len]),
  165    string_codes(String, Codes),
  166    phrase(base64(Codes), Codes64),
  167    string_codes(Signature, Codes64).
  168
  169private_key(Key, Options) :-
  170    option(key_file(File), Options),
  171    option(key_password(Password), Options),
  172    !,
  173    setup_call_cleanup(
  174        open(File, read, In, [type(binary)]),
  175        load_private_key(In, Password, Key),
  176        close(In)).
  177private_key(_Key, Options) :-
  178    \+ option(key_file(_), Options),
  179    !,
  180    throw(error(existence_error(option, key_file, Options),_)).
  181private_key(_Key, Options) :-
  182    throw(error(existence_error(option, key_password, Options),_)).
  183
  184
  185
  186%!  rsa_key_dom(+Key, -DOM) is det.
  187%
  188%   Produce the KeyInfo node from the private key.
  189
  190rsa_key_dom(Key,
  191            element(NS:'KeyInfo', [xmlns=NS],
  192                    [ element(NS:'KeyValue', [],
  193                              [ '\n  ',
  194                                element(NS:'RSAKeyValue', [],
  195                                        [ '\n    ',
  196                                          element(NS:'Modulus', [], [Modulus]),
  197                                          '\n    ',
  198                                          element(NS:'Exponent', [], [Exponent]),
  199                                          '\n  '
  200                                        ]),
  201                                '\n'
  202                              ])
  203                    ])) :-
  204    key_info(Key, Info),
  205    _{modulus:Modulus, exponent:Exponent} :< Info,
  206    xmldsig_ns(NS).
  207
  208
  209%!  key_info(+Key, -Info) is det.
  210%
  211%   Extract the RSA modulus and exponent   from a private key. These
  212%   are the first end  second  field  of   the  rsa  term.  They are
  213%   represented as hexadecimal encoded bytes. We must recode this to
  214%   base64.
  215%
  216%   @tbd    Provide better support from library(ssl).
  217
  218key_info(private_key(Key), rsa{modulus:Modulus, exponent:Exponent}) :-
  219    !,
  220    base64_bignum_arg(1, Key, Modulus),
  221    base64_bignum_arg(2, Key, Exponent).
  222key_info(Key, _) :-
  223    type_error(private_key, Key).
  224
  225base64_bignum_arg(I, Key, Value) :-
  226    arg(I, Key, HexModulesString),
  227    string_codes(HexModulesString, HexModules),
  228    hex_bytes(HexModules, Bytes),
  229    phrase(base64(Bytes), Bytes64),
  230    string_codes(Value, Bytes64).
  231
  232
  233signed_xml_dom(ObjectDOM, SDOM, KeyDOM, Signature, SignedDOM, _Options) :-
  234    SignedDOM = element(NS:'Signature', [xmlns=NS],
  235                        [ '\n', SDOM,
  236                          '\n', element(NS:'SignatureValue', [], [Signature]),
  237                          '\n', KeyDOM,
  238                          '\n', ObjectDOM,
  239                          '\n'
  240                        ]),
  241    xmldsig_ns(NS).
  242
  243
  244
  245%!  xmld_verify_signature(+DOM, +SignatureDOM, -Certificate, +Options) is det.
  246%
  247%   Confirm  that  an  `ds:Signature`  element    contains  a  valid
  248%   signature. Certificate is bound to  the certificate that appears
  249%   in the element if the signature is valid. It is up to the caller
  250%   to determine if the certificate is trusted   or not.
  251%
  252%   *Note*: The DOM and SignatureDOM must   have been obtained using
  253%   the load_structure/3 option keep_prefix(true)   otherwise  it is
  254%   impossible to generate an identical   document  for checking the
  255%   signature. See also xml_write_canonical/3.
  256
  257xmld_verify_signature(DOM, SignatureDOM, Certificate, Options) :-
  258    signature_info(DOM, SignatureDOM, SignedInfo, Algorithm, Signature,
  259                   PublicKey, Certificate, CanonicalizationMethod),
  260    base64(RawSignature, Signature),
  261    (   Algorithm = rsa(HashType)
  262    ->  with_output_to(string(C14N),
  263                       xml_write_canonical(current_output, SignedInfo,
  264                                           [method(CanonicalizationMethod)|Options])),
  265        crypto_data_hash(C14N, Digest, [algorithm(HashType)]),
  266        atom_codes(RawSignature, Codes),
  267        hex_bytes(HexSignature, Codes),
  268        rsa_verify(PublicKey, Digest, HexSignature, [type(HashType)])
  269    ;   domain_error(supported_signature_algorithm, Algorithm)
  270    ).
  271
  272ssl_algorithm('http://www.w3.org/2000/09/xmldsig#rsa-sha1', rsa(sha1)).
  273ssl_algorithm('http://www.w3.org/2000/09/xmldsig#dsa-sha1', dsa(sha1)).
  274ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-md5', hmac(md5)).       % NB: Requires a parameter
  275ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha224', hmac(sha224)).
  276ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha256', hmac(sha256)).
  277ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha384', hmac(sha384)).
  278ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#hmac-sha512', hmac(sha512)).
  279ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-md5', rsa(md5)).
  280ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha256', rsa(sha256)).
  281ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha384', rsa(sha384)).
  282ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-sha512', rsa(sha512)).
  283ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#rsa-ripemd160', rsa(ripemd160)).
  284ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha1', ecdsa(sha1)).
  285ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha224', ecdsa(sha224)).
  286ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha256', ecdsa(sha256)).
  287ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha384', ecdsa(sha384)).
  288ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha512', ecdsa(sha512)).
  289ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha1', esign(sha1)).
  290ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha224', esign(sha224)).
  291ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha256', esign(sha256)).
  292ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha384', esign(sha384)).
  293ssl_algorithm('http://www.w3.org/2001/04/xmldsig-more#esign-sha512', esign(sha512)).
  294
  295digest_method('http://www.w3.org/2000/09/xmldsig#sha1', sha1).
  296digest_method('http://www.w3.org/2001/04/xmlenc#sha256', sha256).
  297
  298signature_info(DOM, Signature, SignedData, Algorithm, SignatureValue,
  299               PublicKey, Certificate, CanonicalizationMethod) :-
  300    xmldsig_ns(NSRef),
  301    memberchk(element(ns(_, NSRef):'SignatureValue', _, [RawSignatureValue]), Signature),
  302    atom_codes(RawSignatureValue, RawSignatureCodes),
  303    delete_newlines(RawSignatureCodes, SignatureCodes),
  304    string_codes(SignatureValue, SignatureCodes),
  305    memberchk(element(ns(_, NSRef):'SignedInfo', SignedInfoAttributes, SignedInfo), Signature),
  306    SignedData = element(ns(_, NSRef):'SignedInfo', SignedInfoAttributes, SignedInfo),
  307    memberchk(element(ns(_, NSRef):'CanonicalizationMethod', CanonicalizationMethodAttributes, _), SignedInfo),
  308    memberchk('Algorithm'=CanonicalizationMethod, CanonicalizationMethodAttributes),
  309    forall(memberchk(element(ns(_, NSRef):'Reference', ReferenceAttributes, Reference), SignedInfo),
  310           verify_digest(ReferenceAttributes, Reference, DOM)),
  311
  312    memberchk(element(ns(_, NSRef):'CanonicalizationMethod', _CanonicalizationMethodAttributes, []), SignedInfo),
  313    memberchk(element(ns(_, NSRef):'SignatureMethod', SignatureMethodAttributes, []), SignedInfo),
  314    memberchk('Algorithm'=XMLAlgorithm, SignatureMethodAttributes),
  315    ssl_algorithm(XMLAlgorithm, Algorithm),
  316    memberchk(element(ns(_, NSRef):'KeyInfo', _, KeyInfo), Signature),
  317    ( memberchk(element(ns(_, NSRef):'X509Data', _, X509Data), KeyInfo),
  318      memberchk(element(ns(_, NSRef):'X509Certificate', _, [X509Certificate]), X509Data)->
  319        load_certificate_from_base64_string(X509Certificate, Certificate),
  320        memberchk(key(PublicKey), Certificate)
  321    ; throw(not_implemented)
  322    ).
  323
  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).
  329
  330
  331verify_digest(ReferenceAttributes, Reference, DOM):-
  332    xmldsig_ns(NSRef),
  333    memberchk('URI'=URI, ReferenceAttributes),
  334    atom_concat('#', Id, URI),
  335    % Find the relevant bit of the DOM
  336    resolve_reference(DOM, Id, Digestible, _NSMap),
  337    (  memberchk(element(ns(_, NSRef):'Transforms', _, Transforms), Reference)
  338    -> findall(TransformAttributes-Transform,
  339               member(element(ns(_, NSRef):'Transform', TransformAttributes, Transform), Transforms),
  340               TransformList)
  341    ;  TransformList = []
  342    ),
  343    apply_transforms(TransformList, Digestible, TransformedDigestible),
  344    memberchk(element(ns(_, NSRef):'DigestMethod', DigestMethodAttributes, _), Reference),
  345    memberchk(element(ns(_, NSRef):'DigestValue', _, [DigestBase64]), Reference),
  346    memberchk('Algorithm'=Algorithm, DigestMethodAttributes),
  347    (  digest_method(Algorithm, DigestMethod)
  348    -> true
  349    ;  domain_error(supported_digest_method, DigestMethod)
  350    ),
  351    with_output_to(string(XMLString), xml_write_canonical(current_output, TransformedDigestible, [])),
  352    sha_hash(XMLString, DigestBytes, [algorithm(DigestMethod)]),
  353    base64(ExpectedDigest, DigestBase64),
  354    atom_codes(ExpectedDigest, ExpectedDigestBytes),
  355    (  ExpectedDigestBytes == DigestBytes
  356    -> true
  357    ;  throw(error(invalid_digest, _))
  358    ).
  359
  360resolve_reference([element(Tag, Attributes, Children)|_], ID, element(Tag, Attributes, Children), []):-
  361    memberchk('ID'=ID, Attributes),
  362    !.
  363resolve_reference([element(_, Attributes, Children)|Siblings], ID, Element, Map):-
  364    ( findall(xmlns:Prefix=URI,
  365              member(xmlns:Prefix=URI, Attributes),
  366              Map,
  367              Tail),
  368          resolve_reference(Children, ID, Element, Tail)
  369    ; resolve_reference(Siblings, ID, Element, Map)
  370    ).
  371
  372
  373apply_transforms([], X, X):- !.
  374apply_transforms([Attributes-Children|Transforms], In, Out):-
  375    memberchk('Algorithm'=Algorithm, Attributes),
  376    (  apply_transform(Algorithm, Children, In, I1)
  377    -> true
  378    ;  existence_error(transform_algorithm, Algorithm)
  379    ),
  380    apply_transforms(Transforms, I1, Out).
  381
  382apply_transform('http://www.w3.org/2001/10/xml-exc-c14n#', [], X, X).
  383
  384apply_transform('http://www.w3.org/2000/09/xmldsig#enveloped-signature', [], element(Tag, Attributes, Children), element(Tag, Attributes, NewChildren)):-
  385    delete_signature_element(Children, NewChildren).
  386
  387delete_signature_element([element(ns(_, 'http://www.w3.org/2000/09/xmldsig#'):'Signature', _, _)|Siblings], Siblings):- !.
  388delete_signature_element([A|Siblings], [A|NewSiblings]):-
  389    delete_signature_element(Siblings, NewSiblings)