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        normalize_space(string(TrimmedCertificate), X509Certificate),
 320        format(string(CompleteCertificate), '-----BEGIN CERTIFICATE-----\n~s\n-----END CERTIFICATE-----', [TrimmedCertificate]),
 321        setup_call_cleanup(open_string(CompleteCertificate, X509Stream),
 322                           load_certificate(X509Stream, Certificate),
 323                           close(X509Stream)),
 324        memberchk(key(PublicKey), Certificate)
 325    ; throw(not_implemented)
 326    ).
 327
 328
 329delete_newlines([], []):- !.
 330delete_newlines([13|As], B):- !, delete_newlines(As, B).
 331delete_newlines([10|As], B):- !, delete_newlines(As, B).
 332delete_newlines([A|As], [A|B]):- !, delete_newlines(As, B).
 333
 334
 335verify_digest(ReferenceAttributes, Reference, DOM):-
 336    xmldsig_ns(NSRef),
 337    memberchk('URI'=URI, ReferenceAttributes),
 338    atom_concat('#', Id, URI),
 339    % Find the relevant bit of the DOM
 340    resolve_reference(DOM, Id, Digestible, _NSMap),
 341    (  memberchk(element(ns(_, NSRef):'Transforms', _, Transforms), Reference)
 342    -> findall(TransformAttributes-Transform,
 343               member(element(ns(_, NSRef):'Transform', TransformAttributes, Transform), Transforms),
 344               TransformList)
 345    ;  TransformList = []
 346    ),
 347    apply_transforms(TransformList, Digestible, TransformedDigestible),
 348    memberchk(element(ns(_, NSRef):'DigestMethod', DigestMethodAttributes, _), Reference),
 349    memberchk(element(ns(_, NSRef):'DigestValue', _, [DigestBase64]), Reference),
 350    memberchk('Algorithm'=Algorithm, DigestMethodAttributes),
 351    (  digest_method(Algorithm, DigestMethod)
 352    -> true
 353    ;  domain_error(supported_digest_method, DigestMethod)
 354    ),
 355    with_output_to(string(XMLString), xml_write_canonical(current_output, TransformedDigestible, [])),
 356    sha_hash(XMLString, DigestBytes, [algorithm(DigestMethod)]),
 357    base64(ExpectedDigest, DigestBase64),
 358    atom_codes(ExpectedDigest, ExpectedDigestBytes),
 359    (  ExpectedDigestBytes == DigestBytes
 360    -> true
 361    ;  throw(error(invalid_digest, _))
 362    ).
 363
 364resolve_reference([element(Tag, Attributes, Children)|_], ID, element(Tag, Attributes, Children), []):-
 365    memberchk('ID'=ID, Attributes),
 366    !.
 367resolve_reference([element(_, Attributes, Children)|Siblings], ID, Element, Map):-
 368    ( findall(xmlns:Prefix=URI,
 369              member(xmlns:Prefix=URI, Attributes),
 370              Map,
 371              Tail),
 372          resolve_reference(Children, ID, Element, Tail)
 373    ; resolve_reference(Siblings, ID, Element, Map)
 374    ).
 375
 376
 377apply_transforms([], X, X):- !.
 378apply_transforms([Attributes-Children|Transforms], In, Out):-
 379    memberchk('Algorithm'=Algorithm, Attributes),
 380    (  apply_transform(Algorithm, Children, In, I1)
 381    -> true
 382    ;  existence_error(transform_algorithm, Algorithm)
 383    ),
 384    apply_transforms(Transforms, I1, Out).
 385
 386apply_transform('http://www.w3.org/2001/10/xml-exc-c14n#', [], X, X).
 387
 388apply_transform('http://www.w3.org/2000/09/xmldsig#enveloped-signature', [], element(Tag, Attributes, Children), element(Tag, Attributes, NewChildren)):-
 389    delete_signature_element(Children, NewChildren).
 390
 391delete_signature_element([element(ns(_, 'http://www.w3.org/2000/09/xmldsig#'):'Signature', _, _)|Siblings], Siblings):- !.
 392delete_signature_element([A|Siblings], [A|NewSiblings]):-
 393    delete_signature_element(Siblings, NewSiblings).