35
36:-module(saml,
37 [saml_authenticate/4]). 38
39:- use_module(library(sgml)). 40:- use_module(library(base64)). 41:- use_module(library(zlib)). 42:- use_module(library(xmldsig)). 43:- use_module(library(xmlenc)). 44:- use_module(library(http/http_path)). 45:- use_module(library(http/http_dispatch)). 46:- use_module(library(http/http_client)).
109user:term_expansion(:-saml_idp(ServiceProvider, MetadataFile), Clauses):-
110 saml_idp_clauses(ServiceProvider, MetadataFile, Clauses).
111
112user:term_expansion(:-saml_sp(ServiceProvider, Spec, KeyFile, Password, CertFile, Options),
113 [saml:saml_acs_path(ServiceProvider, ACSPath),
114 saml:saml_sp_certificate(ServiceProvider, Certificate, PEMData, PrivateKey),
115 ( :-http_handler(MetadataPath, saml:saml_metadata(ServiceProvider, Options), [])),
116 ( :-http_handler(ACSPath, saml:saml_acs_handler(ServiceProvider, Options), []))]):-
117 http_absolute_location(Spec, Root, []),
118 atom_concat(Root, '/auth', ACSPath),
119 atom_concat(Root, '/metadata.xml', MetadataPath),
120 read_key(KeyFile, Password, PrivateKey),
121 read_certificate(CertFile, Certificate, PEMData).
122
123read_key(Spec, Password, Key):-
124 setup_call_cleanup(open_spec(Spec, Stream),
125 load_private_key(Stream, Password, Key),
126 close(Stream)).
127
128read_certificate(Spec, Certificate, PEMData):-
129 setup_call_cleanup(open_spec(Spec, Stream1),
130 read_string(Stream1, _, PEMData),
131 close(Stream1)),
132 setup_call_cleanup(open_string(PEMData, Stream2),
133 load_certificate(Stream2, Certificate),
134 close(Stream2)).
135
136open_spec(Spec, Stream):-
137 ( Spec = file(Filename)
138 -> open(Filename, read, Stream)
139 ; Spec = resource(Name)
140 -> open_resource(Name, read, Stream)
141 ; Spec = url(URL)
142 -> http_open(URL, Stream, [])
143 ; domain_error(file_specification, Spec)
144 ).
145
146:-multifile(saml:saml_sp_certificate/4). 147:-multifile(saml:saml_idp/3). 148:-multifile(saml:saml_idp_certificate/4). 149:-multifile(saml:saml_idp_binding/4). 150:-multifile(saml:saml_acs_path/2). 151
152saml_idp_clauses(ServiceProvider, MetadataSpec, Clauses):-
153 setup_call_cleanup(open_spec(MetadataSpec, Stream),
154 load_structure(Stream, Metadata, [dialect(xmlns)]),
155 close(Stream)),
156 ( memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntitiesDescriptor', _, EntitiesDescriptor), Metadata)
157 -> ( memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), EntitiesDescriptor),
158 memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
159 -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
160 ; existence_error(idp_descriptor, MetadataSpec)
161 )
162 ; memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'EntityDescriptor', EntityDescriptorAttributes, EntityDescriptor), Metadata),
163 memberchk(element('urn:oasis:names:tc:SAML:2.0:metadata':'IDPSSODescriptor', IDPSSODescriptorAttributes, IDPSSODescriptor), EntityDescriptor)
164 -> trust_saml_idp_descriptor(ServiceProvider, EntityDescriptorAttributes, IDPSSODescriptorAttributes, IDPSSODescriptor, Clauses)
165 ; existence_error(idp_descriptor, MetadataSpec)
166 ).
167
168trust_saml_idp_descriptor(ServiceProvider,
169 EntityDescriptorAttributes,
170 IDPSSODescriptorAttributes,
171 IDPSSODescriptor,
172 [saml:saml_idp(ServiceProvider, EntityID, MustSign)|Clauses]):-
173 memberchk(entityID=EntityID, EntityDescriptorAttributes),
174 findall(saml:saml_idp_binding(ServiceProvider, EntityID, Binding, BindingInfo),
175 ( member(element('urn:oasis:names:tc:SAML:2.0:metadata':'SingleSignOnService', SingleSignOnServiceAttributes, SingleSignOnService), IDPSSODescriptor),
176 process_saml_binding(SingleSignOnServiceAttributes, SingleSignOnService, Binding, BindingInfo)
177 ),
178 Clauses,
179 Tail),
180 ( Tail == Clauses
181 -> existence_error(supported_binding, IDPSSODescriptor)
182 ; true
183 ),
184 findall(saml:saml_idp_certificate(ServiceProvider, EntityID, CertificateUse, Certificate),
185 idp_certificate(IDPSSODescriptor, CertificateUse, Certificate),
186 Tail),
187 ( memberchk('WantAuthnRequestsSigned'=true, IDPSSODescriptorAttributes)
188 -> MustSign = true
189 ; MustSign = false
190 ).
191
192idp_certificate(IDPSSODescriptor, CertificateUse, Certificate):-
193 member(element('urn:oasis:names:tc:SAML:2.0:metadata':'KeyDescriptor', KeyDescriptorAttributes, KeyDescriptor), IDPSSODescriptor),
194 memberchk(use=CertificateUse, KeyDescriptorAttributes),
195 memberchk(element('http://www.w3.org/2000/09/xmldsig#':'KeyInfo', _, KeyInfo), KeyDescriptor),
196 memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Data', _, X509Data), KeyInfo),
197 memberchk(element('http://www.w3.org/2000/09/xmldsig#':'X509Certificate', _, [X509CertificateData]), X509Data),
198 load_certificate_from_base64_string(X509CertificateData, Certificate).
199
200
201process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', Location):-
202 memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', SingleSignOnServiceAttributes),
203 !,
204 memberchk('Location'=Location, SingleSignOnServiceAttributes).
205
206process_saml_binding(SingleSignOnServiceAttributes, _, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', Location):-
207 memberchk('Binding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST', SingleSignOnServiceAttributes),
208 !,
209 memberchk('Location'=Location, SingleSignOnServiceAttributes).
210
211
212
213form_authn_request(Request, ID, Destination, Date, ServiceProvider, ExtraElements, XML):-
214 saml_acs_path(ServiceProvider, Path),
215 subtract(Request, [path(_), search(_)], Request1),
216 parse_url(ACSURL, [path(Path)|Request1]),
217 SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
218 SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
219 XML = element(SAMLP:'AuthnRequest', ['ID'=ID,
220 'Version'='2.0',
221 'IssueInstant'=Date,
222 'Destination'=Destination,
223 'IsPassive'=false,
224 'ProtocolBinding'='urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
225 'AssertionConsumerServiceURL'=ACSURL],
226 [element(SAML:'Issuer', [], [ServiceProvider]),
227 element(SAMLP:'NameIDPolicy', ['AllowCreate'=true,
228 'Format'='urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified'], [])|ExtraElements]).
229
230
231:-meta_predicate(saml_authenticate(+, +, 2, +)). 232saml_authenticate(ServiceProvider, IdentityProvider, Callback, Request):-
233 memberchk(request_uri(RequestingURI), Request),
234 format(atom(RelayState), '~q', [saml(RequestingURI, Callback)]),
235 get_xml_timestamp(Date),
236 uuid(UUID),
237 238 atom_concat(a, UUID, ID),
239 saml_idp(ServiceProvider, IdentityProvider, _MustSign),
240 241 MustSign = true,
242 XMLOptions = [header(false), layout(false)],
243 ( saml_idp_binding(ServiceProvider, IdentityProvider, 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect', BaseURL)
244 -> parse_url(BaseURL, Parts),
245 form_authn_request(Request, ID, BaseURL, Date, ServiceProvider, [], XML),
246 with_output_to(string(XMLString), xml_write(current_output, XML, XMLOptions)),
247 debug(saml, 'XML:~n~s~n', [XMLString]),
248 setup_call_cleanup(new_memory_file(MemFile),
249 (setup_call_cleanup(open_memory_file(MemFile, write, MemWrite, [encoding(octet)]),
250 (setup_call_cleanup(zopen(MemWrite, Write, [format(raw_deflate), level(9), close_parent(false)]),
251 format(Write, '~s', [XMLString]),
252 close(Write))
253 ),
254 close(MemWrite)),
255 memory_file_to_atom(MemFile, SAMLRequestRaw)
256 ),
257 free_memory_file(MemFile)),
258 base64(SAMLRequestRaw, SAMLRequest),
259 debug(saml, 'Encoded request: ~w~n', [SAMLRequest]),
260 ( MustSign == true
261 -> saml_sp_certificate(ServiceProvider, _, _, PrivateKey),
262 saml_sign(PrivateKey, XMLString, SAMLRequest, RelayState, ExtraParameters)
263 ; ExtraParameters = []
264 )
265 ; domain_error(supported_binding, IdentityProvider) 266 ),
267 parse_url(IdPURL, [search(['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState|ExtraParameters])|Parts]),
268 debug(saml, 'Redirecting user to~n~w~n', [IdPURL]),
269 http_redirect(moved_temporary, IdPURL, Request).
270
271saml_simple_sign(PrivateKey, XMLString, _SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Signature]):-
272 SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
273 format(string(DataToSign), 'SAMLRequest=~s&RelayState=~w&SigAlg=~w', [XMLString, RelayState, SigAlg]),
274 debug(saml, 'Data to sign with HTTP-Redirect-SimpleSign:~n~s~n', [DataToSign]),
275 sha_hash(DataToSign, Digest, [algorithm(sha1)]),
276 rsa_sign(PrivateKey, Digest, RawSignature,
277 [ type(sha1),
278 encoding(octet)
279 ]),
280 base64(RawSignature, Signature),
281 debug(saml, 'Signature:~n~w~n', [Signature]).
282
283saml_sign(PrivateKey, _XMLString, SAMLRequest, RelayState, ['SigAlg'=SigAlg,'Signature'=Signature]):-
284 SigAlg = 'http://www.w3.org/2000/09/xmldsig#rsa-sha1',
285 parse_url_search(CodesToSign, ['SAMLRequest'=SAMLRequest, 'RelayState'=RelayState, 'SigAlg'=SigAlg]),
286 string_codes(DataToSign, CodesToSign),
287 debug(saml, 'Data to sign with HTTP-Redirect binding:~n~s~n', [DataToSign]),
288 sha_hash(DataToSign, Digest, [algorithm(sha1)]),
289 rsa_sign(PrivateKey, Digest, RawSignature,
290 [ type(sha1),
291 encoding(octet)
292 ]),
293 base64(RawSignature, Signature),
294 debug(saml, '~nSignature:~n~w~n', [Signature]).
295
296saml_acs_handler(ServiceProvider, Options, Request):-
297 debug(saml, 'Got a message back from IdP!~n', []),
298 http_read_data(Request, PostedData, []),
299 debug(saml, '~w~n', [PostedData]),
300 memberchk('SAMLResponse'=Atom, PostedData),
301 memberchk('RelayState'=Relay, PostedData),
302 ( atom_to_term(Relay, saml(OriginalURI, Callback), _)
303 -> true
304 ; throw(error(invalid_request, _))
305 ),
306 base64(RawData, Atom),
307 atom_string(RawData, RawString),
308 setup_call_cleanup(open_string(RawString, Stream),
309 load_structure(Stream, XML, [dialect(xmlns), keep_prefix(true)]),
310 close(Stream)),
311 ( debugging(saml)
312 -> xml_write(user_error, XML, [])
313 ; true
314 ),
315 process_saml_response(XML, ServiceProvider, Callback, OriginalURI, Options),
316 debug(saml, 'Redirecting successfully authenticated user to ~w~n', [OriginalURI]),
317 http_redirect(moved_temporary, OriginalURI, Request).
318
319
320propagate_ns([], _, []):- !.
321propagate_ns([element(Tag, Attributes, Children)|Siblings],
322 NS,
323 [element(Tag, NewAttributes, NewChildren)|NewSiblings]):-
324 !,
325 merge_ns(NS, Attributes, NewAttributes, NewNS),
326 propagate_ns(Children, NewNS, NewChildren),
327 propagate_ns(Siblings, NS, NewSiblings).
328propagate_ns([X|Siblings], NS, [X|NewSiblings]):-
329 propagate_ns(Siblings, NS, NewSiblings).
330
331merge_ns([xmlns:Prefix=Value|NS], Attributes, NewAttributes, NewNS):-
332 ( select(xmlns:Prefix=NewValue, Attributes, A1)
333 -> NewNS = [xmlns:Prefix=NewValue|T],
334 NewAttributes = [xmlns:Prefix=NewValue|N]
335 ; A1 = Attributes,
336 NewNS = [xmlns:Prefix=Value|T],
337 NewAttributes = [xmlns:Prefix=Value|N]
338 ),
339 merge_ns(NS, A1, N, T).
340
341merge_ns([], A, A, NS):-
342 findall(xmlns:Prefix=Value, member(xmlns:Prefix=Value, A), NS).
343
344
345:-meta_predicate(process_saml_response(+, +, 2, +, +)). 346process_saml_response(XML0, ServiceProvider, Callback, RequestURL, Options):-
347 SAMLP = 'urn:oasis:names:tc:SAML:2.0:protocol',
348 SAML = 'urn:oasis:names:tc:SAML:2.0:assertion',
349 DS = 'http://www.w3.org/2000/09/xmldsig#',
350 propagate_ns(XML0, [], XML),
351 XML = [element(ns(_, SAMLP):'Response', _, Response)],
352 353 354 355 356 ( memberchk(element(ns(_, SAMLP):'Status', _StatusAttributes, Status), Response)->
357 358 ( memberchk(element(ns(_, SAMLP):'StatusCode', StatusCodeAttributes, _StatusCode), Status)->
359 360 ( memberchk('Value'=StatusCodeValue, StatusCodeAttributes)->
361 true
362 ; domain_error(legal_saml_response, XML0)
363 )
364 ; domain_error(legal_saml_response, XML0)
365 )
366 ; domain_error(legal_saml_response, XML0)
367 ),
368 ( memberchk(element(ns(_, SAML):'Issuer', _, [IssuerName]), Response)
369 -> true
370 ; IssuerName = {null}
371 ),
372
373 ( member(element(ns(_, DS):'Signature', _, Signature), Response)->
374 xmld_verify_signature(XML, Signature, Certificate, []),
375 376 ( saml_idp_certificate(ServiceProvider, IssuerName, signing, Certificate)
377 -> true
378 ; domain_error(trusted_certificate, Certificate)
379 )
380 ; otherwise->
381 382 383 true
384 ),
385
386 ( StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Success'->
387 388 389 true
390 ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Requester'->
391 throw(saml_rejected(requester))
392 ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Responder'->
393 throw(saml_rejected(responder))
394 ; StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:VersionMismatch'->
395 throw(saml_rejected(version_mismatch))
396 ; throw(saml_rejected(illegal_response))
397 ),
398
399 400 findall(Attribute,
401 ( ( member(element(ns(SAMLPrefix, SAML):'Assertion', AssertionAttributes, Assertion), Response),
402 process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute))
403 ; member(element(ns(SAMLPrefix, SAML):'EncryptedAssertion', _, EncryptedAssertion), Response),
404 decrypt_xml(EncryptedAssertion, DecryptedAssertion, saml:saml_key_callback(ServiceProvider), Options),
405 member(element(ns(_, SAML):'Assertion', AssertionAttributes, Assertion), DecryptedAssertion),
406 process_assertion(ServiceProvider, IssuerName, XML, AssertionAttributes, Assertion, Attribute)
407 ),
408 AcceptedAttributes),
409 debug(saml, 'Calling SAML callback with these attributes: ~w', [AcceptedAttributes]),
410 call(Callback, RequestURL, AcceptedAttributes).
411
412process_assertion(ServiceProvider, _EntityID, Document, Attributes, Assertion, AssertedAttribute):-
413 SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
414 DS = ns(_, 'http://www.w3.org/2000/09/xmldsig#'),
415 ( memberchk('ID'=_AssertionID, Attributes)->
416 true
417 ; throw(missing_assertion_id)
418 ),
419 420 421 422 423 424 425 memberchk(element(SAML:'Issuer', _, [IssuerName]), Assertion),
426 debug(saml, 'Received assertion from IdP ~w', [IssuerName]),
427 ( member(element(DS:'Signature', _, Signature), Assertion)->
428 xmld_verify_signature(Document, Signature, Certificate, []),
429 430 ( saml_idp_certificate(ServiceProvider, IssuerName, signing, Certificate)
431 -> true
432 ; domain_error(trusted_certificate, Certificate)
433 )
434 ; otherwise->
435 436 437 true
438 439 ),
440 ( memberchk(element(SAML:'Conditions', ConditionsAttributes, Conditions), Assertion)->
441 442 443 get_xml_timestamp(Date),
444 ( memberchk('NotOnOrAfter'=Expiry, ConditionsAttributes)->
445 Date @< Expiry
446 ; true
447 ),
448 ( memberchk('NotBefore'=Expiry, ConditionsAttributes)->
449 Date @> Expiry
450 ; true
451 ),
452 forall(member(element(SAML:'Condition', ConditionAttributes, Condition), Conditions),
453 condition_holds(ConditionAttributes, Condition)),
454 forall(member(element(SAML:'AudienceRestriction', _AudienceRestrictionAttributes, AudienceRestriction), Conditions),
455 ( member(element(SAML:'Audience', _, [Audience]), AudienceRestriction),
456 Audience == ServiceProvider
457 -> true
458 ; permission_error(accept, assertion, AudienceRestriction)
459 )),
460 ( memberchk(element(SAML:'OneTimeUse', _, _), Conditions)->
461 throw(one_time_use_not_supported)
462 ; true
463 ),
464 ( memberchk(element(SAML:'ProxyRestriction', _, _), Conditions)->
465 throw(proxy_restriction_not_supported)
466 ; true
467 )
468 ; true
469 ),
470 471 472 473 474 475 476 477 478 ( memberchk(element(SAML:'Subject', _, Subject), Assertion)->
479 memberchk(element(SAML:'NameID', _, [IdPName]), Subject),
480 debug(saml, 'Assertion is for subject ~w', [IdPName]),
481 482 483 ( member(element(SAML:'SubjectConfirmation', SubjectConfirmationAttributes, SubjectConfirmation), Subject),
484 subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation)->
485 debug(saml, 'Subject is confirmed', [])
486 ; debug(saml, 'No valid subject confirmation could be found', []),
487 throw(no_subject_confirmation)
488 )
489 ; throw(not_supported(assertion_without_subject))
490 ),
491 !,
492 memberchk(element(SAML:'AttributeStatement', _, AttributeStatement), Assertion),
493 member(element(SAML:'Attribute', AttributeAttributes, Attribute), AttributeStatement),
494 memberchk('Name'=AttributeName, AttributeAttributes),
495 ( memberchk('FriendlyName'=FriendlyName, AttributeAttributes)
496 -> true
497 ; FriendlyName = ''
498 ),
499 memberchk(element(SAML:'AttributeValue', _, [AttributeValue]), Attribute),
500 AssertedAttribute = attribute(AttributeName, FriendlyName, AttributeValue).
501
502process_assertion(_Attributes, _Assertion, _, _, _, _):-
503 debug(saml, 'Warning: Assertion was not valid', []).
504
505condition_holds(_ConditionAttributes, _Condition):-
506 throw(conditions_not_implemented).
507
508get_xml_timestamp(Date):-
509 get_time(Time),
510 stamp_date_time(Time, date(Y, M, D, HH, MM, SSF, _, 'UTC', _), 'UTC'),
511 SS is floor(SSF),
512 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]).
513
514
515subject_confirmation_is_valid(SubjectConfirmationAttributes, SubjectConfirmation):-
516 SAML = ns(_, 'urn:oasis:names:tc:SAML:2.0:assertion'),
517 memberchk('Method'='urn:oasis:names:tc:SAML:2.0:cm:bearer', SubjectConfirmationAttributes), 518 memberchk(element(SAML:'SubjectConfirmationData', Attributes, _SubjectConfirmationData), SubjectConfirmation),
519 get_xml_timestamp(Date),
520 ( memberchk('NotOnOrAfter'=Expiry, Attributes)->
521 Date @< Expiry
522 ; true
523 ),
524 ( memberchk('NotBefore'=Expiry, Attributes)->
525 Date @> Expiry
526 ; true
527 ),
528 ( memberchk('InResponseTo'=_InResponseTo, Attributes)->
529 530 true
531 ; true
532 ),
533 ( memberchk('Recipient'=_Recipient, Attributes)->
534 535 true
536 ; true
537 ),
538 539 true.
540
541saml_key_callback(ServiceProvider, certificate, KeyHint, Key):-
542 saml_sp_certificate(ServiceProvider, KeyHint, _, Key),
543 !.
544
545
546saml_metadata(ServiceProvider, _Options, Request):-
547 MD = 'urn:oasis:names:tc:SAML:2.0:metadata',
548 DS = 'http://www.w3.org/2000/09/xmldsig#',
549 saml_sp_certificate(ServiceProvider, _X509Certificate, X509Certificate, _PrivateKey),
550
551 552 EncryptionMethod = 'http://www.w3.org/2009/xmlenc11#rsa-oaep',
553 NameIDFormat = 'urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified',
554 ACSBinding = 'urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST',
555
556 parse_url(RequestURL, Request),
557 http_absolute_location('./auth', ACSLocation, [relative_to(RequestURL)]),
558
559 560 ( sub_string(X509Certificate, CertMarkerStart, CertMarkerLength, _, "-----BEGIN CERTIFICATE-----\n"),
561 sub_string(X509Certificate, CertEnd, _, _, "\n-----END CERTIFICATE-----"),
562 CertStart is CertMarkerStart + CertMarkerLength,
563 CertEnd > CertStart->
564 CertLength is CertEnd - CertStart,
565 sub_string(X509Certificate, CertStart, CertLength, _, PresentableCertificate)
566 ; existence_error(certificate_data, X509Certificate)
567 ),
568 format(current_output, 'Content-type: text/xml~n~n', []),
569 XML = [element(MD:'EntitiesDescriptor', [], [EntityDescriptor])],
570 EntityDescriptor = element(MD:'EntityDescriptor', [entityID=ServiceProvider], [SPSSODescriptor]),
571 SPSSODescriptor = element(MD:'SPSSODescriptor', ['AuthnRequestsSigned'=true,
572 protocolSupportEnumeration='urn:oasis:names:tc:SAML:2.0:protocol'], [EncryptionKeyDescriptor,
573 SigningKeyDescriptor,
574 element(MD:'NameIDFormat', [], [NameIDFormat]),
575 AssertionConsumerService]),
576 EncryptionKeyDescriptor = element(MD:'KeyDescriptor', [use=encryption], [KeyInfo,
577 element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
578 SigningKeyDescriptor = element(MD:'KeyDescriptor', [use=signing], [KeyInfo,
579 element(MD:'EncryptionMethod', ['Algorithm'=EncryptionMethod], [])]),
580
581 KeyInfo = element(DS:'KeyInfo', [], [X509Data]),
582 X509Data = element(DS:'X509Data', [], [element(DS:'X509Certificate', [], [PresentableCertificate])]),
583 AssertionConsumerService = element(MD:'AssertionConsumerService', [index='0', isDefault=true, 'Binding'=ACSBinding, 'Location'=ACSLocation], []),
584 xml_write(current_output, XML, [])
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.
saml_sp(+ServiceProvider: atom, +LocationSpec: term, +PrivateKeySpec: term, +Password: atom +CertificateSpec: term, +Options: list)
.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 requestfile(Filename)
: The local file Filenameresource(Resource)
: The prolog resource Resource. See resource/3url(URL)
: The file identified by the HTTP (or HTTPS if you have the HTTPS plugin loaded) URL*/