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, []).
609
610