29
30:- module(soap,
31 [ soap_call/3 32 ]). 33:- use_module(library(debug)). 34:- use_module(library(sgml)). 35:- use_module(library(sgml_write)). 36:- use_module(library(xpath)). 37:- use_module(library(http/http_open)). 38:- use_module(library(http/http_header)). 39:- use_module(library(http/http_ssl_plugin)). 40
41:- use_module(wsdl). 42:- use_module(xml_schema). 43
44:- meta_predicate
45 soap_call(:, +, -). 46
47soap_version(soap11,
48 'http://schemas.xmlsoap.org/soap/envelope/',
49 'text/xml; charset=UTF-8'
50 ).
51soap_version(soap12,
52 'http://www.w3.org/2003/05/soap-envelope',
53 'application/soap+xml; charset=UTF-8').
72soap_call(Operation, Input, Reply) :-
73 Operation = M:_,
75 wsdl_function(Operation, Version, URL, Action,
76 InputElements, OutputElements), !,
77 debug(soap, '~w: URL=~q', [Version, URL]),
78 soap_action(Action, Version, SoapOptions),
79 assertion(length(InputElements, 1)),
80 assertion(length(InputElements, 1)),
81 InputElements = [arg(_Name, element(InputElement))],
82 xsd_create_element(InputElement, M:Input, InputContentDOM0),
83 dom_local_ns(InputContentDOM0, InputContentDOM),
84 soap_version(Version, SoapPrefix, ContentType),
85 InputDOM = element(SoapPrefix:'Envelope', [],
86 [ element(SoapPrefix:'Body', [], [InputContentDOM])
87 ]),
88 ( debugging(soap)
89 -> http_post_data(xml(ContentType, InputDOM),
90 user_error, [])
91 ; true
92 ),
93 setup_call_cleanup(
94 http_open(URL, In,
95 [ method(post),
96 post(xml(ContentType, InputDOM)),
97 cert_verify_hook(cert_verify),
98 status_code(Code),
99 header(content_type, ReplyContentType)
100 | SoapOptions
101 ]),
102 soap_read_reply(Code, ReplyContentType, In, ReplyDOM),
103 close(In)),
104 soap_reply(Code, SoapPrefix, ReplyDOM, OutputElements, M, Reply).
105
106
107soap_action(Action, soap11, [request_header('SOAPAction'=QAction)]) :- !,
108 atomic_list_concat(['"',Action,'"'], QAction),
109 debug(soap, 'SOAPAction: ~w', [QAction]).
110soap_action('', _, []).
111
112
113soap_read_reply(Code, ContentType, In, DOM) :-
114 debug(soap, 'Status = ~w; content = ~q', [Code, ContentType]),
115 load_structure(stream(In), DOM,
116 [ dialect(xmlns),
117 space(remove)
118 ]).
124soap_reply(200, SoapPrefix, ReplyDOM, OutputElements, Module, Reply) :- !,
125 xpath_chk(ReplyDOM, //(SoapPrefix:'Body'(self)), Body),
126 Body = element(_,_,Content),
127 Content = [OutputDOM],
128 OutputElements = [arg(_Name, element(OutputElement))],
129 xsd_create_element(OutputElement, Module:Reply, OutputDOM).
130soap_reply(_, _SoapPrefix, ReplyDOM, _, _, _Reply) :-
131 ( debugging(soap)
132 -> xml_write(user_error, ReplyDOM, [])
133 ; true
134 ),
135 xpath(ReplyDOM, //faultstring(text), Text), !,
136 throw(error(soap_error(Text))).
137soap_reply(_, _SoapPrefix, ReplyDOM, _, _, _Reply) :-
138 xml_write(user_error, ReplyDOM, []).
151dom_local_ns(element(DefNS:Name, Attrs, Content), DOM) :-
152 DOM1 = element(DefNS:Name, [xmlns=DefNS|Attrs], Content),
153 sgml_write:add_missing_namespaces(DOM1, [[]=DefNS], DOM).
162cert_verify(_SSL, _ProblemCert, _AllCerts, _FirstCert, _Error) :-
163 format(user_error, 'Accepting certificate~n', [])