kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/ssl/saml.pl

@@ -0,0 +1,609 @@
+/*  Part of SWI-Prolog
+
+    Author:        Matt Lilley
+    E-mail:        thetrime@gmail.com
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2004-2016, SWI-Prolog Foundation
+                              VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:-module(saml,
+         [saml_authenticate/4]).
+
+:- autoload(library(base64),[base64/2]).
+:- autoload(library(crypto),[rsa_sign/4,hex_bytes/2]).
+:- use_module(library(debug),[debug/3,debugging/1]).
+:- autoload(library(error),
+	    [domain_error/2,existence_error/2,permission_error/3]).
+:- autoload(library(lists),[member/2,subtract/3,select/3]).
+:- autoload(library(memfile),
+	    [ new_memory_file/1,
+	      open_memory_file/4,
+	      memory_file_to_atom/2,
+	      free_memory_file/1
+	    ]).
+:- autoload(library(quintus),[otherwise/0]).
+:- autoload(library(sgml),[load_structure/3]).
+:- autoload(library(sgml_write),[xml_write/3]).
+:- autoload(library(sha),[sha_hash/3]).
+:- autoload(library(ssl),
+	    [load_private_key/3,load_certificate/2,same_certificate/2]).
+:- autoload(library(url),[parse_url/2,parse_url_search/2]).
+:- autoload(library(uuid),[uuid/1]).
+:- autoload(library(xmldsig),[xmld_verify_signature/4]).
+:- autoload(library(xmlenc),
+	    [load_certificate_from_base64_string/2,decrypt_xml/4]).
+:- autoload(library(zlib),[zopen/3]).
+:- autoload(library(http/http_client),[http_read_data/3]).
+:- autoload(library(http/http_dispatch),[http_redirect/3]).
+:- autoload(library(http/http_path),[http_absolute_location/3]).
+:- autoload(library(http/http_open),[http_open/3]).
+
+/** <module> SAML Authentication
+
+This library uses SAML to exchange messages with an Identity Provider to establish
+assertions about the current user's session. It operates only as the service end, not
+the identity provider end.
+
+@see https://docs.oasis-open.org/security/saml/v2.0/saml-core-2.0-os.pdf
+
+There are four primary integration points for applications to use this code:
+   1) You must declare at least one service provider (SP)
+   2) You must declare at least one identity provider (IdP) per SP
+   3) Finally, you can call saml_authenticate(+SP, +IdP, +Callback, +Request) to obtain assertions
+      The asynchronous nature of the SAML process means that a callback must be used. Assuming
+      that the IdP was able to provide at least some valid assertions about the user, after calling
+      Callback with 2 extra arguments (a list of the assertion terms and the URL being request by
+      the user), the user will be redirected back to their original URL. It is therefore up to the
+      callback to ensure that this does not simply trigger another round of SAML negotiations - for
+      example, by throwing http_reply(forbidden(RequestURL)) if the assertions are not strong enough
+   4) Finally, your SP metadata will be available from the web server directly. This is required to
+      configure the IdP. This will be available at './metadata.xml', relative to the LocationSpec
+      provided when the SP was declared.
+
+   Configuring an SP:
+   To declare an SP, use the declaration
+      :-saml_sp(+ServiceProvider: atom,
+                +LocationSpec:    term,
+                +PrivateKeySpec:  term,
+                +Password:        atom
+                +CertificateSpec: term,
+                +Options:         list).
+
+   The ServiceProvider is the identifier of your service. Ideally, this should be a fully-qualified URI
+   The LocationSpec is a location that the HTTP dispatch layer will understand
+      for example '.' or root('saml').
+   The Private KeySpec is a 'file specifier' that resolves to a private key (see below for specifiers)
+   The Password is a password used for reading the private key. If the key is not encrypted, any atom
+      can be supplied as it will be ignored
+   The CertificateSpec is a file specifier that resolves to a certificate holding the public key
+      corresponding to PrivateKeySPec
+   There are currently no implemented options (the list is ignored).
+
+   Configuring an IdP:
+   To declare an IdP, use the declaration
+      :-saml_idp(+ServiceProvider: atom,
+                 +MetadataSpec:    term).
+   ServiceProvider is the identifier used when declaring your SP. You do not need to declare them in a
+      particular order, but both must be present in the system before running saml_authenticate/4.
+   MetadataSpec is a file specifier that resolves to the metadata for the IdP. Most IdPs will be able
+      to provide this on request
+
+
+   File Specifiers:
+   The following specifiers are supported for locating files:
+      * file(Filename): The local file Filename
+      * resource(Resource): The prolog resource Resource. See resource/3
+      * url(URL): The file identified by the HTTP (or HTTPS if you have the HTTPS plugin loaded) URL
+
+
+
+*/
+
+user:term_expansion(:-saml_idp(ServiceProvider, MetadataFile), Clauses):-
+    saml_idp_clauses(ServiceProvider, MetadataFile, Clauses).
+
+user:term_expansion(:-saml_sp(ServiceProvider, Spec, KeyFile, Password, CertFile, Options),
+                    [saml:saml_acs_path(ServiceProvider, ACSPath),
+                     saml:saml_sp_certificate(ServiceProvider, Certificate, PEMData, PrivateKey),
+                     ( :-http_handler(MetadataPath, saml:saml_metadata(ServiceProvider, Options), [])),
+                     ( :-http_handler(ACSPath, saml:saml_acs_handler(ServiceProvider, Options), []))]):-
+    http_absolute_location(Spec, Root, []),
+    atom_concat(Root, '/auth', ACSPath),
+    atom_concat(Root, '/metadata.xml', MetadataPath),
+    read_key(KeyFile, Password, PrivateKey),
+    read_certificate(CertFile, Certificate, PEMData).
+
+read_key(Spec, Password, Key):-
+    setup_call_cleanup(open_spec(Spec, Stream),
+                       load_private_key(Stream, Password, Key),
+                       close(Stream)).
+
+read_certificate(Spec, Certificate, PEMData):-
+    setup_call_cleanup(open_spec(Spec, Stream1),
+                       read_string(Stream1, _, PEMData),
+                       close(Stream1)),
+    setup_call_cleanup(open_string(PEMData, Stream2),
+                       load_certificate(Stream2, Certificate),
+                       close(Stream2)).
+
+open_spec(Spec, Stream):-
+    (  Spec = file(Filename)
+    -> open(Filename, read, Stream)
+    ;  Spec = resource(Name)
+    -> open_resource(Name, read, Stream)
+    ;  Spec = url(URL)
+    -> http_open(URL, Stream, [])
+    ;  domain_error(file_specification, Spec)
+    ).
+
+:-multifile(saml:saml_sp_certificate/4).
+:-multifile(saml:saml_idp/3).
+:-multifile(saml:saml_idp_certificate/4).
+:-multifile(saml:saml_idp_binding/4).
+:-multifile(saml:saml_acs_path/2).
+
+saml_idp_clauses(ServiceProvider, MetadataSpec, Clauses):-
+    setup_call_cleanup(open_spec(MetadataSpec, Stream),
+                       load_structure(Stream, Metadata, [dialect(xmlns)]),
+                       close(Stream)),
+    (  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntitiesDescriptor', _, EntitiesDescriptor), Metadata)
+    -> (  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), EntitiesDescriptor),
+              memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
+           -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
+           ;  existence_error(idp_descriptor, MetadataSpec)
+           )
+    ;  memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), Metadata),
+           memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
+    -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
+    ;  existence_error(idp_descriptor, MetadataSpec)
+    ).
+
+trust_saml_idp_descriptor(ServiceProvider,
+                          EntityDescriptorAttributes,
+                          IDPSSODescriptorAttributes,
+                          IDPSSODescriptor,
+                          [saml:saml_idp(ServiceProvider, EntityID, MustSign)|Clauses]):-
+    memberchk(entityID=EntityID, EntityDescriptorAttributes),
+    findall(saml:saml_idp_binding(ServiceProvider, EntityID, Binding, BindingInfo),
+            ( member(element('urn:oasis:names:tc:SAML:2.0:metadata':'SingleSignOnService', SingleSignOnServiceAttributes, SingleSignOnService), IDPSSODescriptor),
+              process_saml_binding(SingleSignOnServiceAttributes, SingleSignOnService, Binding, BindingInfo)
+            ),
+            Clauses,
+            Tail),
+    (  Tail == Clauses
+    -> existence_error(supported_binding, IDPSSODescriptor)
+    ;  true
+    ),
+    findall(saml:saml_idp_certificate(ServiceProvider, EntityID, CertificateUse, Certificate),
+            idp_certificate(IDPSSODescriptor, CertificateUse, Certificate),
+            Tail),
+    (  memberchk('WantAuthnRequestsSigned'=true, IDPSSODescriptorAttributes)
+    -> MustSign = true
+    ;  MustSign = false
+    ).
+
+idp_certificate(IDPSSODescriptor, CertificateUse, Certificate):-
+    member(element('urn:oasis:names:tc:SAML:2.0:metadata':'KeyDescriptor', KeyDescriptorAttributes, KeyDescriptor), IDPSSODescriptor),
+    memberchk(use=CertificateUse, KeyDescriptorAttributes),
+    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'KeyInfo', _, KeyInfo), KeyDescriptor),
+    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Data', _, X509Data), KeyInfo),
+    memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Certificate', _, [X509CertificateData]), X509Data),
+    load_certificate_from_base64_string(X509CertificateData, Certificate).
+
+
+process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', Location):-
+    memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', SingleSignOnServiceAttributes),
+    !,
+    memberchk('Location'=Location, SingleSignOnServiceAttributes).
+
+process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', Location):-
+    memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', SingleSignOnServiceAttributes),
+    !,
+    memberchk('Location'=Location, SingleSignOnServiceAttributes).
+
+
+
+form_authn_request(Request, ID, Destination, Date, ServiceProvider, ExtraElements, XML):-
+    saml_acs_path(ServiceProvider, Path),
+    subtract(Request, [path(_), search(_)], Request1),
+    parse_url(ACSURL, [path(Path)|Request1]),
+    SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
+    SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
+    XML = element(SAMLP:'AuthnRequest', ['ID'=ID,
+                                         'Version'='2.0',
+                                         'IssueInstant'=Date,
+                                         'Destination'=Destination,
+                                         'IsPassive'=false,
+                                         'ProtocolBinding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
+                                         'AssertionConsumerServiceURL'=ACSURL],
+                  [element(SAML:'Issuer', [], [ServiceProvider]),
+                   element(SAMLP:'NameIDPolicy', ['AllowCreate'=true,
+                                                  'Format'='urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified'], [])|ExtraElements]).
+
+
+:-meta_predicate(saml_authenticate(+, +, 2, +)).
+saml_authenticate(ServiceProvider, IdentityProvider, Callback, Request):-
+    memberchk(request_uri(RequestingURI), Request),
+    format(atom(RelayState), '~q', [saml(RequestingURI, Callback)]),
+    get_xml_timestamp(Date),
+    uuid(UUID),
+    % the ID must start with a letter but the UUID may start with a number. Resolve this by prepending an 'a'
+    atom_concat(a, UUID, ID),
+    saml_idp(ServiceProvider, IdentityProvider, _MustSign),
+    % Always sign the request
+    MustSign = true,
+    XMLOptions = [header(false), layout(false)],
+    (  saml_idp_binding(ServiceProvider, IdentityProvider, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', BaseURL)
+    -> parse_url(BaseURL, Parts),
+           form_authn_request(Request, ID, BaseURL, Date, ServiceProvider, [], XML),
+           with_output_to(string(XMLString), xml_write(current_output, XML, XMLOptions)),
+           debug(saml, 'XML:~n~s~n', [XMLString]),
+           setup_call_cleanup(new_memory_file(MemFile),
+                          (setup_call_cleanup(open_memory_file(MemFile, write, MemWrite, [encoding(octet)]),
+                                               (setup_call_cleanup(zopen(MemWrite, Write, [format(raw_deflate), level(9), close_parent(false)]),
+                                                               format(Write, '~s', [XMLString]),
+                                                               close(Write))
+                                               ),
+                                           close(MemWrite)),
+                            memory_file_to_atom(MemFile, SAMLRequestRaw)
+                          ),
+                          free_memory_file(MemFile)),
+           base64(SAMLRequestRaw, SAMLRequest),
+           debug(saml, 'Encoded request: ~w~n', [SAMLRequest]),
+           (  MustSign == true
+           -> saml_sp_certificate(ServiceProvider, _, _, PrivateKey),
+              saml_sign(PrivateKey, XMLString, SAMLRequest, RelayState, ExtraParameters)
+           ;  ExtraParameters = []
+           )
+    ; domain_error(supported_binding, IdentityProvider) % Other bindings could be implemented here, most obviously HTTP-POST and HTTP-POST-SimpleSign
+    ),
+    parse_url(IdPURL, [search(['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState|ExtraParameters])|Parts]),
+    debug(saml, 'Redirecting user to~n~w~n', [IdPURL]),
+    http_redirect(moved_temporary, IdPURL, Request).
+
+saml_simple_sign(PrivateKey, XMLString, _SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Signature]):-
+    SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
+    format(string(DataToSign), 'SAMLRequest=~s&RelayState=~w&SigAlg=~w', [XMLString, RelayState, SigAlg]),
+    debug(saml, 'Data to sign with HTTP-Redirect-SimpleSign:~n~s~n', [DataToSign]),
+    sha_hash(DataToSign, Digest, [algorithm(sha1)]),
+    rsa_sign(PrivateKey, Digest, RawSignature,
+             [ type(sha1),
+               encoding(octet)
+             ]),
+    base64(RawSignature, Signature),
+    debug(saml, 'Signature:~n~w~n', [Signature]).
+
+saml_sign(PrivateKey, _XMLString, SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Base64Signature]):-
+    SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
+    parse_url_search(CodesToSign, ['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState, 'SigAlg'=SigAlg]),
+    string_codes(DataToSign, CodesToSign),
+    debug(saml, 'Data to sign with HTTP-Redirect binding:~n~s~n', [DataToSign]),
+    sha_hash(DataToSign, Digest, [algorithm(sha1)]),
+    rsa_sign(PrivateKey, Digest, HexSignature,
+             [ type(sha1),
+               encoding(octet)
+             ]),
+    hex_bytes(HexSignature, SignatureBytes),
+    atom_codes(SignatureAtom, SignatureBytes),
+    base64(SignatureAtom, Base64Signature),
+    debug(saml, '~nSignature:~n~w~n', [Base64Signature]).
+
+saml_acs_handler(ServiceProvider, Options, Request):-
+    debug(saml, 'Got a message back from IdP!~n', []),
+    http_read_data(Request, PostedData, []),
+    debug(saml, '~w~n', [PostedData]),
+    memberchk('SAMLResponse'=Atom, PostedData),
+    memberchk('RelayState'=Relay, PostedData),
+    (  atom_to_term(Relay, saml(OriginalURI, Callback), _)
+    -> true
+    ;  throw(error(invalid_request, _))
+    ),
+    base64(RawData, Atom),
+    atom_string(RawData, RawString),
+    setup_call_cleanup(open_string(RawString, Stream),
+                       load_structure(Stream, XML, [dialect(xmlns), keep_prefix(true)]),
+                       close(Stream)),
+    (  debugging(saml)
+    -> xml_write(user_error, XML, [])
+    ;  true
+    ),
+    process_saml_response(XML, ServiceProvider, Callback, OriginalURI, Options),
+    debug(saml, 'Redirecting successfully authenticated user to ~w~n', [OriginalURI]),
+    http_redirect(moved_temporary, OriginalURI, Request).
+
+
+propagate_ns([], _, []):- !.
+propagate_ns([element(Tag, Attributes, Children)|Siblings],
+             NS,
+             [element(Tag, NewAttributes, NewChildren)|NewSiblings]):-
+    !,
+    merge_ns(NS, Attributes, NewAttributes, NewNS),
+    propagate_ns(Children, NewNS, NewChildren),
+    propagate_ns(Siblings, NS, NewSiblings).
+propagate_ns([X|Siblings], NS, [X|NewSiblings]):-
+    propagate_ns(Siblings, NS, NewSiblings).
+
+merge_ns([xmlns:Prefix=Value|NS], Attributes, NewAttributes, NewNS):-
+    (  select(xmlns:Prefix=NewValue, Attributes, A1)
+    -> NewNS = [xmlns:Prefix=NewValue|T],
+           NewAttributes = [xmlns:Prefix=NewValue|N]
+    ;  A1 = Attributes,
+           NewNS = [xmlns:Prefix=Value|T],
+           NewAttributes = [xmlns:Prefix=Value|N]
+    ),
+    merge_ns(NS, A1, N, T).
+
+merge_ns([], A, A, NS):-
+    findall(xmlns:Prefix=Value, member(xmlns:Prefix=Value, A), NS).
+
+
+:-meta_predicate(process_saml_response(+, +, 2, +, +)).
+process_saml_response(XML0, ServiceProvider, Callback, RequestURL, Options):-
+    SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
+    SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
+    DS = 'http://www.w3.org/2000/09/xmldsig#',
+    propagate_ns(XML0, [], XML),
+    XML = [element(ns(_, SAMLP):'Response', _, Response)],
+    % Response MAY  contain the following elements  : Issuer, Signature, Extensions
+    % Response MAY  contain the following attributes: InResponseTo, Destination, Consent
+    % Response MUST contain the following elements  : Status
+    % Response MUST contain the following attributes: ID, IssueInstant, Version
+    ( memberchk(element(ns(_, SAMLP):'Status', _StatusAttributes, Status), Response)->
+        % Status MUST contain a StatusCode element, and MAY contain a StatusMessage and or StatusDetail element
+        ( memberchk(element(ns(_, SAMLP):'StatusCode', StatusCodeAttributes, _StatusCode), Status)->
+            % StatusCode MUST contain a Value attribute
+            ( memberchk('Value'=StatusCodeValue, StatusCodeAttributes)->
+                true
+            ; domain_error(legal_saml_response, XML0)
+            )
+        ; domain_error(legal_saml_response, XML0)
+        )
+    ; domain_error(legal_saml_response, XML0)
+    ),
+    (  memberchk(element(ns(_, SAML):'Issuer', _, [IssuerName]), Response)
+    -> true
+    ;  IssuerName = {null}
+    ),
+
+    ( member(element(ns(_, DS):'Signature', _, Signature), Response)->
+        xmld_verify_signature(XML, Signature, Certificate, []),
+        % Check that the certificate used to sign was one in the metadata
+        (  saml_idp_certificate(ServiceProvider, IssuerName, signing, IDPCertificate),
+           same_certificate(Certificate, IDPCertificate)
+        -> true
+        ;  domain_error(trusted_certificate, Certificate)
+        )
+    ; otherwise->
+        % Warning: Message is not signed. Assertions may be though
+        % FIXME: Determine a policy for handling this - if the SP wants them signed, we must make sure they are
+        true
+    ),
+
+    ( StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Success'->
+        % The user has authenticated in some capacity.
+        % Note that we cannot say anything ABOUT the user yet. That will come once we process the assertions
+        true
+    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Requester'->
+        throw(saml_rejected(requester))
+    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Responder'->
+        throw(saml_rejected(responder))
+    ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:VersionMismatch'->
+        throw(saml_rejected(version_mismatch))
+    ; throw(saml_rejected(illegal_response))
+    ),
+
+    % Response MAY also contain 0..N of the following elements: Assertion, EncryptedAssertion.
+    findall(Attribute,
+            ( ( member(element(ns(SAMLPrefix, SAML):'Assertion', AssertionAttributes, Assertion), Response),
+                process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute))
+            ; member(element(ns(SAMLPrefix, SAML):'EncryptedAssertion', _, EncryptedAssertion), Response),
+              decrypt_xml(EncryptedAssertion, DecryptedAssertion, saml:saml_key_callback(ServiceProvider), Options),
+              member(element(ns(_, SAML):'Assertion', AssertionAttributes, Assertion), DecryptedAssertion),
+              process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute)
+            ),
+            AcceptedAttributes),
+    debug(saml, 'Calling SAML callback with these attributes: ~w', [AcceptedAttributes]),
+    call(Callback, RequestURL, AcceptedAttributes).
+
+process_assertion(ServiceProvider, _EntityID, Document, Attributes, Assertion, AssertedAttribute):-
+    SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
+    DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
+    ( memberchk('ID'=_AssertionID, Attributes)->
+        true
+    ; throw(missing_assertion_id)
+    ),
+    % An Assertion MUST contain an Issuer, and MAY contain a Signature, Subject, Conditions, Advice, plus 0..N of the following:
+    %   Statement
+    %   AuthnStatement
+    %   AuthzDecisionStatement
+    %   AttributeStatement
+    % It must also have all the following attributes, Version, ID, IssueInstant
+    memberchk(element(SAML:'Issuer', _, [IssuerName]), Assertion),
+    debug(saml, 'Received assertion from IdP ~w', [IssuerName]),
+    ( member(element(DS:'Signature', _, Signature), Assertion)->
+        xmld_verify_signature(Document, Signature, Certificate, []),
+        % Check that the certificate used to sign was one in the metadata
+        (  saml_idp_certificate(ServiceProvider, IssuerName, signing, IDPCertificate),
+           same_certificate(Certificate, IDPCertificate)
+        -> true
+        ;  domain_error(trusted_certificate, Certificate)
+        )
+    ; otherwise->
+        % Technically the standard allows this, but it seems like practically it would be useless?
+        % Which part of the response SHOULD be signed? The entire thing or the assertions?
+        true
+        %throw(unsigned_response)
+    ),
+    ( memberchk(element(SAML:'Conditions', ConditionsAttributes, Conditions), Assertion)->
+        % If conditions are present, we MUST check them. These can include arbitrary, user-defined conditions
+        % and things like ProxyRestriction and OneTimeUse
+        get_xml_timestamp(Date),
+        ( memberchk('NotOnOrAfter'=Expiry, ConditionsAttributes)->
+            Date @< Expiry
+        ; true
+        ),
+        ( memberchk('NotBefore'=Expiry, ConditionsAttributes)->
+            Date @> Expiry
+        ; true
+        ),
+        forall(member(element(SAML:'Condition', ConditionAttributes, Condition), Conditions),
+               condition_holds(ConditionAttributes, Condition)),
+        forall(member(element(SAML:'AudienceRestriction', _AudienceRestrictionAttributes, AudienceRestriction), Conditions),
+               (  member(element(SAML:'Audience', _, [Audience]), AudienceRestriction),
+                  Audience == ServiceProvider
+               -> true
+               ;  permission_error(accept, assertion, AudienceRestriction)
+               )),
+        ( memberchk(element(SAML:'OneTimeUse', _, _), Conditions)->
+            throw(one_time_use_not_supported)
+        ; true
+        ),
+        ( memberchk(element(SAML:'ProxyRestriction', _, _), Conditions)->
+            throw(proxy_restriction_not_supported)
+        ; true
+        )
+    ; true
+    ),
+    % The Subject element is not mandatory. In the introduction to section 2, the specification states
+    % "the <Subject> element is optional, and other specifications and profiles may utilize the SAML assertion
+    % structure to make similar statements without specifying a subject, or possibly specifying the subject in an
+    % alternate way"
+    % However, 2.3.3 goes on to say that
+    % "SAML itself defines no such statements, and an assertion without a subject has no defined meaning in this specification."
+    % 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
+    % contain a subject
+    (   memberchk(element(SAML:'Subject', _, Subject), Assertion)
+    ->  memberchk(element(SAML:'NameID', _, [_0IdPName]), Subject),
+        debug(saml, 'Assertion is for subject ~w', [_0IdPName]),
+        % Note that it is not mandatory for there to be any SubjectConfirmation in the message, however, since we must verify at least one
+        % confirmation in order to trust that the subject has really associated with the IdP, a subject with no confirmations is useless anyway
+        (   member(element(SAML:'SubjectConfirmation', SubjectConfirmationAttributes, SubjectConfirmation), Subject),
+            subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation)
+        ->  debug(saml, 'Subject is confirmed', [])
+        ;   debug(saml, 'No valid subject confirmation could be found', []),
+            throw(no_subject_confirmation)
+        )
+    ;   throw(not_supported(assertion_without_subject))
+    ),
+    !,
+    memberchk(element(SAML:'AttributeStatement', _, AttributeStatement), Assertion),
+    member(element(SAML:'Attribute', AttributeAttributes, Attribute), AttributeStatement),
+    memberchk('Name'=AttributeName, AttributeAttributes),
+    (  memberchk('FriendlyName'=FriendlyName, AttributeAttributes)
+    -> true
+    ;  FriendlyName = ''
+    ),
+    memberchk(element(SAML:'AttributeValue', _, [AttributeValue]), Attribute),
+    AssertedAttribute = attribute(AttributeName, FriendlyName, AttributeValue).
+
+process_assertion(_Attributes, _Assertion, _, _, _, _):-
+    debug(saml, 'Warning: Assertion was not valid', []).
+
+condition_holds(_ConditionAttributes, _Condition):-
+    throw(conditions_not_implemented).
+
+get_xml_timestamp(Date):-
+    get_time(Time),
+    stamp_date_time(Time, date(Y, M, D, HH, MM, SSF, _, 'UTC', _), 'UTC'),
+    SS is floor(SSF),
+    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]).
+
+
+subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation):-
+    SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
+    memberchk('Method'='urn:oasis:names:tc:SAML:2.0:cm:bearer', SubjectConfirmationAttributes), % this is the only method we support
+    memberchk(element(SAML:'SubjectConfirmationData', Attributes, _SubjectConfirmationData), SubjectConfirmation),
+    get_xml_timestamp(Date),
+    ( memberchk('NotOnOrAfter'=Expiry, Attributes)->
+        Date @< Expiry
+    ; true
+    ),
+    ( memberchk('NotBefore'=Expiry, Attributes)->
+        Date @> Expiry
+    ; true
+    ),
+    ( memberchk('InResponseTo'=_InResponseTo, Attributes)->
+        % FIXME: Check that we sent the message, somehow?
+        true
+    ; true
+    ),
+    ( memberchk('Recipient'=_Recipient, Attributes)->
+        % FIXME: Check that this is us, somehow?
+        true
+    ; true
+    ),
+    % FIXME: We can also have other arbitrary elements and attributes in here for user-defined extensions. These are ignored.
+    true.
+
+saml_key_callback(ServiceProvider, certificate, KeyHint, Key):-
+    saml_sp_certificate(ServiceProvider, KeyHint, _, Key),
+    !.
+
+
+saml_metadata(ServiceProvider, _Options, Request):-
+    MD = 'urn:oasis:names:tc:SAML:2.0:metadata',
+    DS = 'http://www.w3.org/2000/09/xmldsig#',
+    saml_sp_certificate(ServiceProvider, _X509Certificate, X509Certificate, _PrivateKey),
+
+    % All of this should be configurable, eventually?
+    EncryptionMethod = 'http://www.w3.org/2009/xmlenc11#rsa-oaep',
+    NameIDFormat = 'urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified',
+    ACSBinding = 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
+
+    parse_url(RequestURL, Request),
+    http_absolute_location('./auth', ACSLocation, [relative_to(RequestURL)]),
+
+    % Extract the part of the certificate between the BEGIN and END delimiters
+    ( sub_string(X509Certificate, CertMarkerStart, CertMarkerLength, _, "-----BEGIN CERTIFICATE-----\n"),
+      sub_string(X509Certificate, CertEnd, _, _, "\n-----END CERTIFICATE-----"),
+      CertStart is CertMarkerStart + CertMarkerLength,
+      CertEnd > CertStart->
+        CertLength is CertEnd - CertStart,
+        sub_string(X509Certificate, CertStart, CertLength, _, PresentableCertificate)
+    ; existence_error(certificate_data, X509Certificate)
+    ),
+    format(current_output, 'Content-type: text/xml~n~n', []),
+    XML = [element(MD:'EntitiesDescriptor', [], [EntityDescriptor])],
+    EntityDescriptor = element(MD:'EntityDescriptor', [entityID=ServiceProvider], [SPSSODescriptor]),
+    SPSSODescriptor = element(MD:'SPSSODescriptor', ['AuthnRequestsSigned'=true,
+                                                     protocolSupportEnumeration='urn:oasis:names:tc:SAML:2.0:protocol'], [EncryptionKeyDescriptor,
+                                                                                                                          SigningKeyDescriptor,
+                                                                                                                          element(MD:'NameIDFormat', [], [NameIDFormat]),
+                                                                                                                          AssertionConsumerService]),
+    EncryptionKeyDescriptor = element(MD:'KeyDescriptor', [use=encryption], [KeyInfo,
+                                                                             element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
+    SigningKeyDescriptor = element(MD:'KeyDescriptor', [use=signing], [KeyInfo,
+                                                                          element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
+
+    KeyInfo = element(DS:'KeyInfo', [], [X509Data]),
+    X509Data = element(DS:'X509Data', [], [element(DS:'X509Certificate', [], [PresentableCertificate])]),
+    AssertionConsumerService = element(MD:'AssertionConsumerService', [index='0', isDefault=true, 'Binding'=ACSBinding, 'Location'=ACSLocation], []),
+    xml_write(current_output, XML, []).
+