View source with formatted 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:-module(saml,
   37         [saml_authenticate/4]).   38
   39:- autoload(library(base64),[base64/2]).   40:- autoload(library(crypto),[rsa_sign/4,hex_bytes/2]).   41:- autoload(library(debug),[debug/3,debugging/1]).   42:- autoload(library(error),
   43	    [domain_error/2,existence_error/2,permission_error/3]).   44:- autoload(library(lists),[member/2,subtract/3,select/3]).   45:- autoload(library(memfile),
   46	    [ new_memory_file/1,
   47	      open_memory_file/4,
   48	      memory_file_to_atom/2,
   49	      free_memory_file/1
   50	    ]).   51:- autoload(library(quintus),[otherwise/0]).   52:- autoload(library(sgml),[load_structure/3]).   53:- autoload(library(sgml_write),[xml_write/3]).   54:- autoload(library(sha),[sha_hash/3]).   55:- autoload(library(ssl),
   56	    [load_private_key/3,load_certificate/2,same_certificate/2]).   57:- autoload(library(url),[parse_url/2,parse_url_search/2]).   58:- autoload(library(uuid),[uuid/1]).   59:- autoload(library(xmldsig),[xmld_verify_signature/4]).   60:- autoload(library(xmlenc),
   61	    [load_certificate_from_base64_string/2,decrypt_xml/4]).   62:- autoload(library(zlib),[zopen/3]).   63:- autoload(library(http/http_client),[http_read_data/3]).   64:- autoload(library(http/http_dispatch),[http_redirect/3]).   65:- autoload(library(http/http_path),[http_absolute_location/3]).   66:- autoload(library(http/http_open),[http_open/3]).   67
   68/** <module> SAML Authentication
   69
   70This library uses SAML to exchange messages with an Identity Provider to establish
   71assertions about the current user's session. It operates only as the service end, not
   72the identity provider end.
   73
   74@see https://docs.oasis-open.org/security/saml/v2.0/saml-core-2.0-os.pdf
   75
   76There are four primary integration points for applications to use this code:
   77   1) You must declare at least one service provider (SP)
   78   2) You must declare at least one identity provider (IdP) per SP
   79   3) Finally, you can call saml_authenticate(+SP, +IdP, +Callback, +Request) to obtain assertions
   80      The asynchronous nature of the SAML process means that a callback must be used. Assuming
   81      that the IdP was able to provide at least some valid assertions about the user, after calling
   82      Callback with 2 extra arguments (a list of the assertion terms and the URL being request by
   83      the user), the user will be redirected back to their original URL. It is therefore up to the
   84      callback to ensure that this does not simply trigger another round of SAML negotiations - for
   85      example, by throwing http_reply(forbidden(RequestURL)) if the assertions are not strong enough
   86   4) Finally, your SP metadata will be available from the web server directly. This is required to
   87      configure the IdP. This will be available at './metadata.xml', relative to the LocationSpec
   88      provided when the SP was declared.
   89
   90   Configuring an SP:
   91   To declare an SP, use the declaration
   92      :-saml_sp(+ServiceProvider: atom,
   93                +LocationSpec:    term,
   94                +PrivateKeySpec:  term,
   95                +Password:        atom
   96                +CertificateSpec: term,
   97                +Options:         list).
   98
   99   The ServiceProvider is the identifier of your service. Ideally, this should be a fully-qualified URI
  100   The LocationSpec is a location that the HTTP dispatch layer will understand
  101      for example '.' or root('saml').
  102   The Private KeySpec is a 'file specifier' that resolves to a private key (see below for specifiers)
  103   The Password is a password used for reading the private key. If the key is not encrypted, any atom
  104      can be supplied as it will be ignored
  105   The CertificateSpec is a file specifier that resolves to a certificate holding the public key
  106      corresponding to PrivateKeySPec
  107   There are currently no implemented options (the list is ignored).
  108
  109   Configuring an IdP:
  110   To declare an IdP, use the declaration
  111      :-saml_idp(+ServiceProvider: atom,
  112                 +MetadataSpec:    term).
  113   ServiceProvider is the identifier used when declaring your SP. You do not need to declare them in a
  114      particular order, but both must be present in the system before running saml_authenticate/4.
  115   MetadataSpec is a file specifier that resolves to the metadata for the IdP. Most IdPs will be able
  116      to provide this on request
  117
  118
  119   File Specifiers:
  120   The following specifiers are supported for locating files:
  121      * file(Filename): The local file Filename
  122      * resource(Resource): The prolog resource Resource. See resource/3
  123      * url(URL): The file identified by the HTTP (or HTTPS if you have the HTTPS plugin loaded) URL
  124
  125
  126
  127*/
  128
  129user:term_expansion(:-saml_idp(ServiceProvider, MetadataFile), Clauses):-
  130    saml_idp_clauses(ServiceProvider, MetadataFile, Clauses).
  131
  132user:term_expansion(:-saml_sp(ServiceProvider, Spec, KeyFile, Password, CertFile, Options),
  133                    [saml:saml_acs_path(ServiceProvider, ACSPath),
  134                     saml:saml_sp_certificate(ServiceProvider, Certificate, PEMData, PrivateKey),
  135                     ( :-http_handler(MetadataPath, saml:saml_metadata(ServiceProvider, Options), [])),
  136                     ( :-http_handler(ACSPath, saml:saml_acs_handler(ServiceProvider, Options), []))]):-
  137    http_absolute_location(Spec, Root, []),
  138    atom_concat(Root, '/auth', ACSPath),
  139    atom_concat(Root, '/metadata.xml', MetadataPath),
  140    read_key(KeyFile, Password, PrivateKey),
  141    read_certificate(CertFile, Certificate, PEMData).
  142
  143read_key(Spec, Password, Key):-
  144    setup_call_cleanup(open_spec(Spec, Stream),
  145                       load_private_key(Stream, Password, Key),
  146                       close(Stream)).
  147
  148read_certificate(Spec, Certificate, PEMData):-
  149    setup_call_cleanup(open_spec(Spec, Stream1),
  150                       read_string(Stream1, _, PEMData),
  151                       close(Stream1)),
  152    setup_call_cleanup(open_string(PEMData, Stream2),
  153                       load_certificate(Stream2, Certificate),
  154                       close(Stream2)).
  155
  156open_spec(Spec, Stream):-
  157    (  Spec = file(Filename)
  158    -> open(Filename, read, Stream)
  159    ;  Spec = resource(Name)
  160    -> open_resource(Name, read, Stream)
  161    ;  Spec = url(URL)
  162    -> http_open(URL, Stream, [])
  163    ;  domain_error(file_specification, Spec)
  164    ).
  165
  166:-multifile(saml:saml_sp_certificate/4).  167:-multifile(saml:saml_idp/3).  168:-multifile(saml:saml_idp_certificate/4).  169:-multifile(saml:saml_idp_binding/4).  170:-multifile(saml:saml_acs_path/2).  171
  172saml_idp_clauses(ServiceProvider, MetadataSpec, Clauses):-
  173    setup_call_cleanup(open_spec(MetadataSpec, Stream),
  174                       load_structure(Stream, Metadata, [dialect(xmlns)]),
  175                       close(Stream)),
  176    (  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntitiesDescriptor', _, EntitiesDescriptor), Metadata)
  177    -> (  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), EntitiesDescriptor),
  178              memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
  179           -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
  180           ;  existence_error(idp_descriptor, MetadataSpec)
  181           )
  182    ;  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), Metadata),
  183           memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
  184    -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
  185    ;  existence_error(idp_descriptor, MetadataSpec)
  186    ).
  187
  188trust_saml_idp_descriptor(ServiceProvider,
  189                          EntityDescriptorAttributes,
  190                          IDPSSODescriptorAttributes,
  191                          IDPSSODescriptor,
  192                          [saml:saml_idp(ServiceProvider, EntityID, MustSign)|Clauses]):-
  193    memberchk(entityID=EntityID, EntityDescriptorAttributes),
  194    findall(saml:saml_idp_binding(ServiceProvider, EntityID, Binding, BindingInfo),
  195            ( member(element('urn:oasis:names:tc:SAML:2.0:metadata':'SingleSignOnService', SingleSignOnServiceAttributes, SingleSignOnService), IDPSSODescriptor),
  196              process_saml_binding(SingleSignOnServiceAttributes, SingleSignOnService, Binding, BindingInfo)
  197            ),
  198            Clauses,
  199            Tail),
  200    (  Tail == Clauses
  201    -> existence_error(supported_binding, IDPSSODescriptor)
  202    ;  true
  203    ),
  204    findall(saml:saml_idp_certificate(ServiceProvider, EntityID, CertificateUse, Certificate),
  205            idp_certificate(IDPSSODescriptor, CertificateUse, Certificate),
  206            Tail),
  207    (  memberchk('WantAuthnRequestsSigned'=true, IDPSSODescriptorAttributes)
  208    -> MustSign = true
  209    ;  MustSign = false
  210    ).
  211
  212idp_certificate(IDPSSODescriptor, CertificateUse, Certificate):-
  213    member(element('urn:oasis:names:tc:SAML:2.0:metadata':'KeyDescriptor', KeyDescriptorAttributes, KeyDescriptor), IDPSSODescriptor),
  214    memberchk(use=CertificateUse, KeyDescriptorAttributes),
  215    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'KeyInfo', _, KeyInfo), KeyDescriptor),
  216    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Data', _, X509Data), KeyInfo),
  217    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Certificate', _, [X509CertificateData]), X509Data),
  218    load_certificate_from_base64_string(X509CertificateData, Certificate).
  219
  220
  221process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', Location):-
  222    memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', SingleSignOnServiceAttributes),
  223    !,
  224    memberchk('Location'=Location, SingleSignOnServiceAttributes).
  225
  226process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', Location):-
  227    memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', SingleSignOnServiceAttributes),
  228    !,
  229    memberchk('Location'=Location, SingleSignOnServiceAttributes).
  230
  231
  232
  233form_authn_request(Request, ID, Destination, Date, ServiceProvider, ExtraElements, XML):-
  234    saml_acs_path(ServiceProvider, Path),
  235    subtract(Request, [path(_), search(_)], Request1),
  236    parse_url(ACSURL, [path(Path)|Request1]),
  237    SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
  238    SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
  239    XML = element(SAMLP:'AuthnRequest', ['ID'=ID,
  240                                         'Version'='2.0',
  241                                         'IssueInstant'=Date,
  242                                         'Destination'=Destination,
  243                                         'IsPassive'=false,
  244                                         'ProtocolBinding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
  245                                         'AssertionConsumerServiceURL'=ACSURL],
  246                  [element(SAML:'Issuer', [], [ServiceProvider]),
  247                   element(SAMLP:'NameIDPolicy', ['AllowCreate'=true,
  248                                                  'Format'='urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified'], [])|ExtraElements]).
  249
  250
  251:-meta_predicate(saml_authenticate(+, +, 2, +)).  252saml_authenticate(ServiceProvider, IdentityProvider, Callback, Request):-
  253    memberchk(request_uri(RequestingURI), Request),
  254    format(atom(RelayState), '~q', [saml(RequestingURI, Callback)]),
  255    get_xml_timestamp(Date),
  256    uuid(UUID),
  257    % the ID must start with a letter but the UUID may start with a number. Resolve this by prepending an 'a'
  258    atom_concat(a, UUID, ID),
  259    saml_idp(ServiceProvider, IdentityProvider, _MustSign),
  260    % Always sign the request
  261    MustSign = true,
  262    XMLOptions = [header(false), layout(false)],
  263    (  saml_idp_binding(ServiceProvider, IdentityProvider, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', BaseURL)
  264    -> parse_url(BaseURL, Parts),
  265           form_authn_request(Request, ID, BaseURL, Date, ServiceProvider, [], XML),
  266           with_output_to(string(XMLString), xml_write(current_output, XML, XMLOptions)),
  267           debug(saml, 'XML:~n~s~n', [XMLString]),
  268           setup_call_cleanup(new_memory_file(MemFile),
  269                          (setup_call_cleanup(open_memory_file(MemFile, write, MemWrite, [encoding(octet)]),
  270                                               (setup_call_cleanup(zopen(MemWrite, Write, [format(raw_deflate), level(9), close_parent(false)]),
  271                                                               format(Write, '~s', [XMLString]),
  272                                                               close(Write))
  273                                               ),
  274                                           close(MemWrite)),
  275                            memory_file_to_atom(MemFile, SAMLRequestRaw)
  276                          ),
  277                          free_memory_file(MemFile)),
  278           base64(SAMLRequestRaw, SAMLRequest),
  279           debug(saml, 'Encoded request: ~w~n', [SAMLRequest]),
  280           (  MustSign == true
  281           -> saml_sp_certificate(ServiceProvider, _, _, PrivateKey),
  282              saml_sign(PrivateKey, XMLString, SAMLRequest, RelayState, ExtraParameters)
  283           ;  ExtraParameters = []
  284           )
  285    ; domain_error(supported_binding, IdentityProvider) % Other bindings could be implemented here, most obviously HTTP-POST and HTTP-POST-SimpleSign
  286    ),
  287    parse_url(IdPURL, [search(['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState|ExtraParameters])|Parts]),
  288    debug(saml, 'Redirecting user to~n~w~n', [IdPURL]),
  289    http_redirect(moved_temporary, IdPURL, Request).
  290
  291saml_simple_sign(PrivateKey, XMLString, _SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Signature]):-
  292    SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
  293    format(string(DataToSign), 'SAMLRequest=~s&RelayState=~w&SigAlg=~w', [XMLString, RelayState, SigAlg]),
  294    debug(saml, 'Data to sign with HTTP-Redirect-SimpleSign:~n~s~n', [DataToSign]),
  295    sha_hash(DataToSign, Digest, [algorithm(sha1)]),
  296    rsa_sign(PrivateKey, Digest, RawSignature,
  297             [ type(sha1),
  298               encoding(octet)
  299             ]),
  300    base64(RawSignature, Signature),
  301    debug(saml, 'Signature:~n~w~n', [Signature]).
  302
  303saml_sign(PrivateKey, _XMLString, SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Base64Signature]):-
  304    SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
  305    parse_url_search(CodesToSign, ['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState, 'SigAlg'=SigAlg]),
  306    string_codes(DataToSign, CodesToSign),
  307    debug(saml, 'Data to sign with HTTP-Redirect binding:~n~s~n', [DataToSign]),
  308    sha_hash(DataToSign, Digest, [algorithm(sha1)]),
  309    rsa_sign(PrivateKey, Digest, HexSignature,
  310             [ type(sha1),
  311               encoding(octet)
  312             ]),
  313    hex_bytes(HexSignature, SignatureBytes),
  314    atom_codes(SignatureAtom, SignatureBytes),
  315    base64(SignatureAtom, Base64Signature),
  316    debug(saml, '~nSignature:~n~w~n', [Base64Signature]).
  317
  318saml_acs_handler(ServiceProvider, Options, Request):-
  319    debug(saml, 'Got a message back from IdP!~n', []),
  320    http_read_data(Request, PostedData, []),
  321    debug(saml, '~w~n', [PostedData]),
  322    memberchk('SAMLResponse'=Atom, PostedData),
  323    memberchk('RelayState'=Relay, PostedData),
  324    (  atom_to_term(Relay, saml(OriginalURI, Callback), _)
  325    -> true
  326    ;  throw(error(invalid_request, _))
  327    ),
  328    base64(RawData, Atom),
  329    atom_string(RawData, RawString),
  330    setup_call_cleanup(open_string(RawString, Stream),
  331                       load_structure(Stream, XML, [dialect(xmlns), keep_prefix(true)]),
  332                       close(Stream)),
  333    (  debugging(saml)
  334    -> xml_write(user_error, XML, [])
  335    ;  true
  336    ),
  337    process_saml_response(XML, ServiceProvider, Callback, OriginalURI, Options),
  338    debug(saml, 'Redirecting successfully authenticated user to ~w~n', [OriginalURI]),
  339    http_redirect(moved_temporary, OriginalURI, Request).
  340
  341
  342propagate_ns([], _, []):- !.
  343propagate_ns([element(Tag, Attributes, Children)|Siblings],
  344             NS,
  345             [element(Tag, NewAttributes, NewChildren)|NewSiblings]):-
  346    !,
  347    merge_ns(NS, Attributes, NewAttributes, NewNS),
  348    propagate_ns(Children, NewNS, NewChildren),
  349    propagate_ns(Siblings, NS, NewSiblings).
  350propagate_ns([X|Siblings], NS, [X|NewSiblings]):-
  351    propagate_ns(Siblings, NS, NewSiblings).
  352
  353merge_ns([xmlns:Prefix=Value|NS], Attributes, NewAttributes, NewNS):-
  354    (  select(xmlns:Prefix=NewValue, Attributes, A1)
  355    -> NewNS = [xmlns:Prefix=NewValue|T],
  356           NewAttributes = [xmlns:Prefix=NewValue|N]
  357    ;  A1 = Attributes,
  358           NewNS = [xmlns:Prefix=Value|T],
  359           NewAttributes = [xmlns:Prefix=Value|N]
  360    ),
  361    merge_ns(NS, A1, N, T).
  362
  363merge_ns([], A, A, NS):-
  364    findall(xmlns:Prefix=Value, member(xmlns:Prefix=Value, A), NS).
  365
  366
  367:-meta_predicate(process_saml_response(+, +, 2, +, +)).  368process_saml_response(XML0, ServiceProvider, Callback, RequestURL, Options):-
  369    SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
  370    SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
  371    DS = 'http://www.w3.org/2000/09/xmldsig#',
  372    propagate_ns(XML0, [], XML),
  373    XML = [element(ns(_, SAMLP):'Response', _, Response)],
  374    % Response MAY  contain the following elements  : Issuer, Signature, Extensions
  375    % Response MAY  contain the following attributes: InResponseTo, Destination, Consent
  376    % Response MUST contain the following elements  : Status
  377    % Response MUST contain the following attributes: ID, IssueInstant, Version
  378    ( memberchk(element(ns(_, SAMLP):'Status', _StatusAttributes, Status), Response)->
  379        % Status MUST contain a StatusCode element, and MAY contain a StatusMessage and or StatusDetail element
  380        ( memberchk(element(ns(_, SAMLP):'StatusCode', StatusCodeAttributes, _StatusCode), Status)->
  381            % StatusCode MUST contain a Value attribute
  382            ( memberchk('Value'=StatusCodeValue, StatusCodeAttributes)->
  383                true
  384            ; domain_error(legal_saml_response, XML0)
  385            )
  386        ; domain_error(legal_saml_response, XML0)
  387        )
  388    ; domain_error(legal_saml_response, XML0)
  389    ),
  390    (  memberchk(element(ns(_, SAML):'Issuer', _, [IssuerName]), Response)
  391    -> true
  392    ;  IssuerName = {null}
  393    ),
  394
  395    ( member(element(ns(_, DS):'Signature', _, Signature), Response)->
  396        xmld_verify_signature(XML, Signature, Certificate, []),
  397        % Check that the certificate used to sign was one in the metadata
  398        (  saml_idp_certificate(ServiceProvider, IssuerName, signing, IDPCertificate),
  399           same_certificate(Certificate, IDPCertificate)
  400        -> true
  401        ;  domain_error(trusted_certificate, Certificate)
  402        )
  403    ; otherwise->
  404        % Warning: Message is not signed. Assertions may be though
  405        % FIXME: Determine a policy for handling this - if the SP wants them signed, we must make sure they are
  406        true
  407    ),
  408
  409    ( StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Success'->
  410        % The user has authenticated in some capacity.
  411        % Note that we cannot say anything ABOUT the user yet. That will come once we process the assertions
  412        true
  413    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Requester'->
  414        throw(saml_rejected(requester))
  415    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Responder'->
  416        throw(saml_rejected(responder))
  417    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:VersionMismatch'->
  418        throw(saml_rejected(version_mismatch))
  419    ; throw(saml_rejected(illegal_response))
  420    ),
  421
  422    % Response MAY also contain 0..N of the following elements: Assertion, EncryptedAssertion.
  423    findall(Attribute,
  424            ( ( member(element(ns(SAMLPrefix, SAML):'Assertion', AssertionAttributes, Assertion), Response),
  425                process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute))
  426            ; member(element(ns(SAMLPrefix, SAML):'EncryptedAssertion', _, EncryptedAssertion), Response),
  427              decrypt_xml(EncryptedAssertion, DecryptedAssertion, saml:saml_key_callback(ServiceProvider), Options),
  428              member(element(ns(_, SAML):'Assertion', AssertionAttributes, Assertion), DecryptedAssertion),
  429              process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute)
  430            ),
  431            AcceptedAttributes),
  432    debug(saml, 'Calling SAML callback with these attributes: ~w', [AcceptedAttributes]),
  433    call(Callback, RequestURL, AcceptedAttributes).
  434
  435process_assertion(ServiceProvider, _EntityID, Document, Attributes, Assertion, AssertedAttribute):-
  436    SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
  437    DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
  438    ( memberchk('ID'=_AssertionID, Attributes)->
  439        true
  440    ; throw(missing_assertion_id)
  441    ),
  442    % An Assertion MUST contain an Issuer, and MAY contain a Signature, Subject, Conditions, Advice, plus 0..N of the following:
  443    %   Statement
  444    %   AuthnStatement
  445    %   AuthzDecisionStatement
  446    %   AttributeStatement
  447    % It must also have all the following attributes, Version, ID, IssueInstant
  448    memberchk(element(SAML:'Issuer', _, [IssuerName]), Assertion),
  449    debug(saml, 'Received assertion from IdP ~w', [IssuerName]),
  450    ( member(element(DS:'Signature', _, Signature), Assertion)->
  451        xmld_verify_signature(Document, Signature, Certificate, []),
  452        % Check that the certificate used to sign was one in the metadata
  453        (  saml_idp_certificate(ServiceProvider, IssuerName, signing, IDPCertificate),
  454           same_certificate(Certificate, IDPCertificate)
  455        -> true
  456        ;  domain_error(trusted_certificate, Certificate)
  457        )
  458    ; otherwise->
  459        % Technically the standard allows this, but it seems like practically it would be useless?
  460        % Which part of the response SHOULD be signed? The entire thing or the assertions?
  461        true
  462        %throw(unsigned_response)
  463    ),
  464    ( memberchk(element(SAML:'Conditions', ConditionsAttributes, Conditions), Assertion)->
  465        % If conditions are present, we MUST check them. These can include arbitrary, user-defined conditions
  466        % and things like ProxyRestriction and OneTimeUse
  467        get_xml_timestamp(Date),
  468        ( memberchk('NotOnOrAfter'=Expiry, ConditionsAttributes)->
  469            Date @< Expiry
  470        ; true
  471        ),
  472        ( memberchk('NotBefore'=Expiry, ConditionsAttributes)->
  473            Date @> Expiry
  474        ; true
  475        ),
  476        forall(member(element(SAML:'Condition', ConditionAttributes, Condition), Conditions),
  477               condition_holds(ConditionAttributes, Condition)),
  478        forall(member(element(SAML:'AudienceRestriction', _AudienceRestrictionAttributes, AudienceRestriction), Conditions),
  479               (  member(element(SAML:'Audience', _, [Audience]), AudienceRestriction),
  480                  Audience == ServiceProvider
  481               -> true
  482               ;  permission_error(accept, assertion, AudienceRestriction)
  483               )),
  484        ( memberchk(element(SAML:'OneTimeUse', _, _), Conditions)->
  485            throw(one_time_use_not_supported)
  486        ; true
  487        ),
  488        ( memberchk(element(SAML:'ProxyRestriction', _, _), Conditions)->
  489            throw(proxy_restriction_not_supported)
  490        ; true
  491        )
  492    ; true
  493    ),
  494    % The Subject element is not mandatory. In the introduction to section 2, the specification states
  495    % "the <Subject> element is optional, and other specifications and profiles may utilize the SAML assertion
  496    % structure to make similar statements without specifying a subject, or possibly specifying the subject in an
  497    % alternate way"
  498    % However, 2.3.3 goes on to say that
  499    % "SAML itself defines no such statements, and an assertion without a subject has no defined meaning in this specification."
  500    % Specifically, 2.7.2, 2.7.3, 2.7.4 enumerate all the SAML-defined statements, and all of them say that the assertion MUST
  501    % contain a subject
  502    ( memberchk(element(SAML:'Subject', _, Subject), Assertion)->
  503        memberchk(element(SAML:'NameID', _, [IdPName]), Subject),
  504        debug(saml, 'Assertion is for subject ~w', [IdPName]),
  505        % Note that it is not mandatory for there to be any SubjectConfirmation in the message, however, since we must verify at least one
  506        % confirmation in order to trust that the subject has really associated with the IdP, a subject with no confirmations is useless anyway
  507        ( member(element(SAML:'SubjectConfirmation', SubjectConfirmationAttributes, SubjectConfirmation), Subject),
  508              subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation)->
  509            debug(saml, 'Subject is confirmed', [])
  510        ; debug(saml, 'No valid subject confirmation could be found', []),
  511              throw(no_subject_confirmation)
  512        )
  513    ; throw(not_supported(assertion_without_subject))
  514    ),
  515    !,
  516    memberchk(element(SAML:'AttributeStatement', _, AttributeStatement), Assertion),
  517    member(element(SAML:'Attribute', AttributeAttributes, Attribute), AttributeStatement),
  518    memberchk('Name'=AttributeName, AttributeAttributes),
  519    (  memberchk('FriendlyName'=FriendlyName, AttributeAttributes)
  520    -> true
  521    ;  FriendlyName = ''
  522    ),
  523    memberchk(element(SAML:'AttributeValue', _, [AttributeValue]), Attribute),
  524    AssertedAttribute = attribute(AttributeName, FriendlyName, AttributeValue).
  525
  526process_assertion(_Attributes, _Assertion, _, _, _, _):-
  527    debug(saml, 'Warning: Assertion was not valid', []).
  528
  529condition_holds(_ConditionAttributes, _Condition):-
  530    throw(conditions_not_implemented).
  531
  532get_xml_timestamp(Date):-
  533    get_time(Time),
  534    stamp_date_time(Time, date(Y, M, D, HH, MM, SSF, _, 'UTC', _), 'UTC'),
  535    SS is floor(SSF),
  536    format(atom(Date), '~w-~|~`0t~w~2+-~|~`0t~w~2+T~|~`0t~w~2+:~|~`0t~w~2+:~|~`0t~w~2+Z', [Y,M,D,HH,MM,SS]).
  537
  538
  539subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation):-
  540    SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
  541    memberchk('Method'='urn:oasis:names:tc:SAML:2.0:cm:bearer', SubjectConfirmationAttributes), % this is the only method we support
  542    memberchk(element(SAML:'SubjectConfirmationData', Attributes, _SubjectConfirmationData), SubjectConfirmation),
  543    get_xml_timestamp(Date),
  544    ( memberchk('NotOnOrAfter'=Expiry, Attributes)->
  545        Date @< Expiry
  546    ; true
  547    ),
  548    ( memberchk('NotBefore'=Expiry, Attributes)->
  549        Date @> Expiry
  550    ; true
  551    ),
  552    ( memberchk('InResponseTo'=_InResponseTo, Attributes)->
  553        % FIXME: Check that we sent the message, somehow?
  554        true
  555    ; true
  556    ),
  557    ( memberchk('Recipient'=_Recipient, Attributes)->
  558        % FIXME: Check that this is us, somehow?
  559        true
  560    ; true
  561    ),
  562    % FIXME: We can also have other arbitrary elements and attributes in here for user-defined extensions. These are ignored.
  563    true.
  564
  565saml_key_callback(ServiceProvider, certificate, KeyHint, Key):-
  566    saml_sp_certificate(ServiceProvider, KeyHint, _, Key),
  567    !.
  568
  569
  570saml_metadata(ServiceProvider, _Options, Request):-
  571    MD = 'urn:oasis:names:tc:SAML:2.0:metadata',
  572    DS = 'http://www.w3.org/2000/09/xmldsig#',
  573    saml_sp_certificate(ServiceProvider, _X509Certificate, X509Certificate, _PrivateKey),
  574
  575    % All of this should be configurable, eventually?
  576    EncryptionMethod = 'http://www.w3.org/2009/xmlenc11#rsa-oaep',
  577    NameIDFormat = 'urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified',
  578    ACSBinding = 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
  579
  580    parse_url(RequestURL, Request),
  581    http_absolute_location('./auth', ACSLocation, [relative_to(RequestURL)]),
  582
  583    % Extract the part of the certificate between the BEGIN and END delimiters
  584    ( sub_string(X509Certificate, CertMarkerStart, CertMarkerLength, _, "-----BEGIN CERTIFICATE-----\n"),
  585      sub_string(X509Certificate, CertEnd, _, _, "\n-----END CERTIFICATE-----"),
  586      CertStart is CertMarkerStart + CertMarkerLength,
  587      CertEnd > CertStart->
  588        CertLength is CertEnd - CertStart,
  589        sub_string(X509Certificate, CertStart, CertLength, _, PresentableCertificate)
  590    ; existence_error(certificate_data, X509Certificate)
  591    ),
  592    format(current_output, 'Content-type: text/xml~n~n', []),
  593    XML = [element(MD:'EntitiesDescriptor', [], [EntityDescriptor])],
  594    EntityDescriptor = element(MD:'EntityDescriptor', [entityID=ServiceProvider], [SPSSODescriptor]),
  595    SPSSODescriptor = element(MD:'SPSSODescriptor', ['AuthnRequestsSigned'=true,
  596                                                     protocolSupportEnumeration='urn:oasis:names:tc:SAML:2.0:protocol'], [EncryptionKeyDescriptor,
  597                                                                                                                          SigningKeyDescriptor,
  598                                                                                                                          element(MD:'NameIDFormat', [], [NameIDFormat]),
  599                                                                                                                          AssertionConsumerService]),
  600    EncryptionKeyDescriptor = element(MD:'KeyDescriptor', [use=encryption], [KeyInfo,
  601                                                                             element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
  602    SigningKeyDescriptor = element(MD:'KeyDescriptor', [use=signing], [KeyInfo,
  603                                                                          element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
  604
  605    KeyInfo = element(DS:'KeyInfo', [], [X509Data]),
  606    X509Data = element(DS:'X509Data', [], [element(DS:'X509Certificate', [], [PresentableCertificate])]),
  607    AssertionConsumerService = element(MD:'AssertionConsumerService', [index='0', isDefault=true, 'Binding'=ACSBinding, 'Location'=ACSLocation], []),
  608    xml_write(current_output, XML, [])