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:- use_module(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
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 258 atom_concat(a, UUID, ID),
259 saml_idp(ServiceProvider, IdentityProvider, _MustSign),
260 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) 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 375 376 377 378 ( memberchk(element(ns(_, SAMLP):'Status', _StatusAttributes, Status), Response)->
379 380 ( memberchk(element(ns(_, SAMLP):'StatusCode', StatusCodeAttributes, _StatusCode), Status)->
381 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 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 405 406 true
407 ),
408
409 ( StatusCodeValue == 'urn:oasis:names:tc:SAML:2.0:status:Success'->
410 411 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 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 443 444 445 446 447 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 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 460 461 true
462 463 ),
464 ( memberchk(element(SAML:'Conditions', ConditionsAttributes, Conditions), Assertion)->
465 466 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 495 496 497 498 499 500 501 502 ( memberchk(element(SAML:'Subject', _, Subject), Assertion)->
503 memberchk(element(SAML:'NameID', _, [IdPName]), Subject),
504 debug(saml, 'Assertion is for subject ~w', [IdPName]),
505 506 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), 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 554 true
555 ; true
556 ),
557 ( memberchk('Recipient'=_Recipient, Attributes)->
558 559 true
560 ; true
561 ),
562 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 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 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, [])