Menu
▾
▴
quicksilver-developers — Main communication channel between all the quicksilver developers.
You can subscribe to this list here.
| 2000 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(2) |
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2001 |
Jan
(35) |
Feb
(22) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Peter R. <pet...@mi...> - 2001-02-22 10:52:04
|
On Thu, Feb 22, 2001 at 10:22:18AM +1100, Ina Cheng wrote: > > Hi Peter, > > Can you please approve the following email? > Done. |
|
From: Ina C. <in...@st...> - 2001-02-22 07:51:21
|
I've addressed Fergus's comments and here is the document again.
==================================================================
Estimated hours taken: 20
Write a document on how to build the server, how to extend the server
and the interface etc.
/server/USERGUIDE
the newly added document.
===================================================================
Index: USERGUIDE
===================================================================
RCS file: USERGUIDE
diff -N USERGUIDE
--- /dev/null Mon Dec 11 17:26:27 2000
+++ USERGUIDE Wed Feb 21 23:34:31 2001
@@ -0,0 +1,407 @@
+This document covers the following topics:
+
+* Building the web-server
+* Running the web-server
+* Request methods
+ I. GET
+ II. POST
+* Encoding rules and schemas
+ I. Simple types
+ II. Enumerations
+ III. Structures
+ IV. Lists
+ V. Others
+* The interface between the server and the client
+* Implementing a new method and its interface
+* Running the sample program
+* References
+
+
+-----------------------
+Building the web-server
+-----------------------
+
+Step 1: Checkout the web-server module with the following instructions:
+
+ 1. cvs
+ -d:pserver:ano...@cv...:/cvsroot/quicksilver
+ login
+
+ 2. Press the Enter key when prompted for a password.
+
+ 3. cvs -z3
+ -d:pserver:ano...@cv...:/cvsroot/quicksilver
+ co webserver
+
+Step 2: Change to the webserver directory and build the webserver using
+ the following commands:
+
+ 1. mmake GRADE=hlc.par.gc depend
+
+ 2. mmake GRADE=hlc.par.gc
+
+It is recommended to use a recent Mercury ROTD to compile the server.
+Any release of the day more recent than rotd-2000-08-29 should be fine.
+
+
+---------------------
+Running the webserver
+---------------------
+
+To run the webserver, type the following command:
+
+ $ ./server
+
+The server provides 3 options:
+
+ -H or --host ,
+ -P or --port , and
+ -R or --root
+
+The `--host' option specifies the name of the host which will be listening
+for the requests. The default value is `localhost'.
+
+The `--port' option specifies which port the server should listen on.
+The default value is `8080'.
+
+The `--root' options specifies the root directory for the html files to
+be served. The default value is `var/www'.
+
+For example:
+
+ $ ./server --host localhost --port 8080 --root .
+
+The server now listens for any connection, either from its clients or
+from some direct connections to the server (eg. telnet localhost 8080).
+
+
+---------------
+Request Methods
+---------------
+
+Hypertext Transfer Protocol (HTTP) 1.1 is used to transfer requests
+and responses between the server and the client. The server supports
+the following request method:
+
+ I. GET
+ II. POST
+
+I. GET
+
+The GET method requests a document from a specific location on the
+server.
+
+Suppose the client wants to retrieve a file named `server.m' in
+the root directory of the server, the client thus issues the following
+request:
+
+ GET /server.m HTTP/1.1
+
+The corresponding response will be:
+
+ HTTP/1.1 200 OK
+
+ [Body of the document]
+
+
+II. POST
+
+The POST method sends data to the server. In particular, the POST method
+is used to encapsulate and exchange remote procedure calls and responses.
+
+A POST request includes a request, headers, and an entity-body containing
+the data to be sent. The server uses Simple Object Access Protocol (SOAP)
+1.1 to represent the data body. It is an XML based protocol that consists
+of three parts:
+
+ * a SOAP envelope describing what is in a message and how to process it;
+ * SOAP encoding rules defining datatypes;
+ * SOAP RPC representation defining a convention that can be used to
+ represent remote procedure calls and responses.
+
+For example, here's an example of a SOAP message embedded in HTTP issuing
+a call to the predicate "Hello" in the library file "libsoap_test_methods.so":
+
+ POST /libsoap_test_methods.so HTTP/1.1
+ Host: www.cs.mu.oz.au
+ Content-Type: text/xml
+ Content-Length: 227
+ SOAPAction:
+
+ <SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <GetStockPrice>
+ <stocknum xsi:type="xsd:int">1</stocknum>
+ </GetStockPrice>
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+A SOAP envelope consists of a mandatory SOAP envelope, an optional SOAP
+header and a mandatory SOAP body. Currently the server accepts messages
+with header but ignores the header.
+
+Inside the SOAP Body is the RPC, which includes the method name and the
+parameters. Each element name within the method represents the name of
+the parameter and the type represents the type of the parameter. These
+parameters appear in the same order as in the method call.
+
+Extra information:
+
+ * HTTP applications must use the media type "text/xml" when including
+ SOAP entity bodies in HTTP messages
+ * An HTTP client must use "SOAPAction" HTTP request header field when
+ issuing a SOAP HTTP Request.
+ * Both the server and the client assume that there is only one RPC
+ per SOAP message
+
+Responses, similar to requests, bind SOAP with HTTP such that headers
+use HTTP protocol and messages use SOAP protocol. Responses for RPC
+are represented by appending the string "Response" to the method name.
+
+The corresponding response for the above SOAP message will be:
+
+ HTTP/1.1 200 OK
+ Content-Length: 199
+ Content-Type: text/xml
+
+ <SOAP-ENV:Envelope
+ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
+ <SOAP-ENV:Body>
+ <GetStockPriceResponse>
+ <price>34</price>
+ <GetStockPriceResponse>
+ </SOAP-ENV:Body>
+ </SOAP-ENV:Envelope>
+
+(See http://www.w3org/TR/SOAP for more details)
+
+
+--------------------------
+Encoding rules and schemas
+--------------------------
+
+The server uses the following schemas to encode/decode mercury data
+types.
+
+
+I. Simple types
+
+A mercury predicate which takes in an integer, a float and a string will
+have the following schema
+
+ <element name="arg1" type="xsd:int"/>
+ <element name="arg2" type="xsd:float"/>
+ <element name="arg3" type="xsd:string"/>
+ <element name="arg3" type="xsd:char"/>
+
+
+II. Enumerations
+
+For mercury enumerations, eg.
+
+ :- type fruit
+ ---> apple
+ ; orange
+ ; banana
+ ; pear.
+
+The schema will be:
+
+ <element name="fruit" type="tns:fruit"/>
+
+ <simpleType name="fruit">
+ <restriction base="mercury:string">
+ <enumeration value="apple"/>
+ <enumeration value="orange"/>
+ <enumeration value="banana"/>
+ <enumeration value="pear"/>
+ </restriction>
+ </simpleType>
+
+
+III. Structures
+
+For mercury structures, eg.
+
+ :- type book
+ ---> book(
+ title :: string,
+ author :: author
+ ).
+
+ :- type author
+ ---> author(
+ surname :: string,
+ firstname :: string
+ ).
+
+The schema will be:
+
+ <element name="book" type="tns:book"/>
+ <element name="author" base="tns:author"/>
+
+ <complexType name="book">
+ <sequence>
+ <element name="title" type="mercury:string"/>
+ <element name="author" type="tns:author"/>
+ </sequence>
+ </complexType>
+
+ <complexType name="author">
+ <sequence>
+ <element name"surname" type="mercury:string"/>
+ <element name"firstname" type="mercury:string"/>
+ </sequence>
+ </complexType>
+
+
+IV. Lists
+
+For mercury lists, eg.
+
+ :- type list(T)
+ ---> []
+ ; [T|list(T)].
+
+The schema will be:
+
+ <element name="list" type="tns:list"/>
+ <element name="nil" type="tns:nil"/>
+ <element name="cons" type="tns:cons"/>
+
+ <complexType name="list">
+ <choice>
+ <element name="nil" type="tns:nil"/>
+ <element name="cons" type="tns:cons"/>
+ </choice>
+ </complexType>
+
+ <complexType name="nil>
+ <complexContent>
+ <restriction base="xsd:anyType">
+ </restriction>
+ </complexContent>
+ </complexType>
+
+ or <complexType name="nil">
+ </complexType>
+
+ <complexType name="cons">
+ <sequence>
+ <element name="head" type="xsd:anyType">
+ <element name="tail" type="tns:list"/>
+ </sequence>
+ </complexType>
+
+ ( A complex type that defines without <complexContent> is intrepreted
+ as shorthand for complex content that restricts anyType,
+ therefore <complexContent> is omitted in the schema for `cons' )
+
+
+V. Others
+
+For arbitrary discriminated unions, eg.
+
+ :- type foo ---> f(int)
+ ; g(float)
+ ; h(string).
+
+This will be an union of structures. Unions can be viewed as complexType
+with choice inside:
+
+ <element name="foo" type="tns:foo"/>
+
+ <complexType name="foo">
+ <choice>
+ <element name="f" type="tns:f/>
+ <element name="g" type="tns:g/>
+ <element name="h" type="tns:h/>
+ </choice>
+ </complexType>
+
+
+-------------------------------------------
+Interface between the server and the client
+-------------------------------------------
+
+This module, soap_interface.m, provides an interface for programmers
+to send messages to the SOAP server. It is aimed to hide all the
+SOAP and HTTP details away from the client. In doing so, the client
+is able to communicate with the server in mercury types.
+
+In addition, the interface also allow an arbitrary XML message to be
+passed using SOAP (and the response will be returned as XML too).
+This will allow programmers to use their own encodings and communicate
+with any SOAP based service.
+
+
+-----------------------------------------
+Implementing new method and its interface
+-----------------------------------------
+
+When adding a new method, the following steps will have to be taken:
+
+ 1. Add the method in a separate module, for example, soap_test_methods.m
+
+ 2. Inside `load_dynamic_library/7' predicate of web_methods.m,
+ expand the if-then-else-case to handle the new method.
+ This is to make sure the library code is loaded for the
+ new method when the server runs.
+
+ 3. Re-build the server.
+
+ The server now supports the new RPC via direct access (ie. telnet
+ to the server and send the request using HTTP and SOAP protocol).
+
+ 4. Modify soap_interface.m to allow clients to send messages to the
+ server in mercury types. In particular, add predicates to generate
+ SOAP message body for the new method and predicates to decode
+ the response from the server.
+
+An assumption that has been made is that, the client is assumed to have
+a copy of the schema that is used in the server for encoding and decoding
+types in XML.
+
+
+--------------------------
+Running the sample program
+--------------------------
+
+The sample program demonstrates four common examples, ie. printing
+"Hello world", adding 3 integers, placing a query and placing a purchase
+order. In addition, the program accepts xml messages.
+
+To build the sample program, type the following commands:
+
+ $ mmake client_demo.depend
+ $ mmake client_demo
+
+To print "Hello world":
+
+ $ ./client_demo -m Hello
+
+To add 3 integers:
+
+ $ ./client_demo -m Add3Ints --add1 1 --add2 2 --add3 3
+
+To place query for a specific stock's price:
+
+ $ ./client_demo -m GetStockPrice -i stocknumber
+
+To purchase a book:
+
+ $ ./client_demo -m PurchaseBook -t booktitle -a surname,firstname
+
+To print "Hello world" using XML format instead:
+
+ $ ./client_demo -x "<Hello></Hello>"
+
+
+----------
+References
+----------
+
+http://www.w3.org/TR/SOAP
+http://www.oreilly.com/openbook/webclient/
+
|
|
From: Fergus H. <fj...@cs...> - 2001-02-22 07:31:36
|
On 22-Feb-2001, Ina Cheng <in...@st...> wrote:
> +:- pred generate_Hello_body(string, list(univ), string).
> +:- mode generate_Hello_body(in, in, out).
Add `is det' at the end of the mode declaration.
(Sorry, the compiler's error message is awful.)
> + % Generates SOAP message body for GetStockPrice.
> + % XXX assume no namespace and client has a copy of the schema
> + % used in the server side to encode mercury types.
> +:- pred generate_SP_body(method, list(univ), string).
> +:- mode generate_SP_body(in, in, out).
Likewise here.
> +:- pred insert_envelope(string::in, string::in, string::out).
And here.
Not sure if I caught them all, try compiling with `--no-infer-det'.
--
Fergus Henderson <fj...@cs...> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
|
|
From: Ina C. <in...@st...> - 2001-02-22 06:57:12
|
Hi Fergus,
I've made the changes that you've pointed out this morning. However, there
is a bug (software error) inside `soap_interface.m' when I tried to abstract
out the code. I've included the error message and marked as XXX inside the
code. Can you please take a look at it? Sorry for the last minute rush.
ps. Since there is a limit on the size of the mail, I've separated
the diff into 2 parts.
Thanks,
Ina
<in...@st...>
========================================================================
Estimated hours taken: 38
Add an interface between server and client such that the client
can send messages in mercury types to the server.
/server/client_demo.m
new module showing how to call the soap_interface to send
messages to the SOAP server.
/server/options.m
add new options to handle command line arguments.
/server/soap_interface.m
new module - provide an interface for programmers to send messages
to the SOAP server.
/server/soap_test_methods.m
/server/web_methods.m
add a function to demonstrate the soap interface.
/server/soap.m
/server/server.m
modify some error handling code.
[Part 1]
Index: client_demo.m
===================================================================
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ client_demo.m Wed Feb 21 22:48:27 2001
@@ -0,0 +1,184 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University Of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% File: client_demo.m
+% Author: inch
+%
+% This module provide a sample of how to call the SOAP interface to send
+% messages from the client to the SOAP server.
+%
+%---------------------------------------------------------------------------%
+
+:- module client_demo.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module http, options.
+
+:- import_module bool, char, exception, getopt.
+:- import_module int, list, require, std_util, string.
+
+:- import_module soap_interface.
+
+main -->
+ io__command_line_arguments(Args0),
+ { OptionOpts = option_ops(short_option, long_option, option_defaults)},
+ { getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+ (
+ { OptionsResult = ok(OptTable) },
+ { getopt__lookup_bool_option(OptTable, help, Help) },
+ (
+ { Help = yes },
+ options_help
+ ;
+ { Help = no },
+ { getopt__lookup_string_option(OptTable, host, Host) },
+ { getopt__lookup_int_option(OptTable, port, Port) },
+ { getopt__lookup_string_option(OptTable, method, Method) },
+ { getopt__lookup_string_option(OptTable, uri, URI) },
+ { getopt__lookup_string_option(OptTable, xml, XML) },
+ (
+ { XML = "" }
+ ->
+ (
+ { Method_Handler = get_method_handler(Method) }
+ ->
+ call(Method_Handler, OptTable, Host, Port, Method,
+ URI, Responses, Mesg)
+ ;
+ { error("Method not supported.") }
+ ),
+ display_mercury_response(Mesg, Responses)
+ ;
+ soap_call_xml_type(Host, Port, Method, URI, XML,
+ Responses),
+ io__write_string(Responses)
+ )
+ )
+ ;
+ { OptionsResult = error(OptionErrorString) },
+ io__write_string(OptionErrorString),
+ io__nl,
+ options_help
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- type method_handler == pred(option_table(option), string, int, method,
+ uri, list(univ), string, io__state, io__state).
+:- inst method_handler == (pred(in, in, in, in, in, out, out, di, uo) is det).
+
+:- func get_method_handler(string) = method_handler.
+:- mode get_method_handler(in) = out(method_handler) is semidet.
+
+ % Choose a corresponding predicate for a particular method.
+get_method_handler("Hello") = handle_Hello.
+get_method_handler("GetStockPrice") = handle_GetStockPrice.
+get_method_handler("Add3Ints") = handle_Add3Ints.
+get_method_handler("PurchaseBook") = handle_PurchaseBook.
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_Hello(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_Hello(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_Hello(_OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ soap_call_mercury_type(Host, Port, Method, URI, [], Responses),
+ { Mesg = "" }.
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_GetStockPrice(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_GetStockPrice(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_GetStockPrice(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_int_option(OptTable, int, Int) },
+ (
+ { Int = -1 }
+ ->
+ io__write_string("Parameter not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(Int)], Responses),
+ { Mesg = "Stockprice = " }
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- pred handle_Add3Ints(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_Add3Ints(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_Add3Ints(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_int_option(OptTable, add1, X) },
+ { getopt__lookup_int_option(OptTable, add2, Y) },
+ { getopt__lookup_int_option(OptTable, add3, Z) },
+ (
+ % If some of the arguments are not supplied,
+ % they are treated as 0. Only when all
+ % arguments are not supplied, the program
+ % terminates.
+ { X = 0 }, { Y = 0 }, { Z = 0 }
+ ->
+ io__write_string("Parameter not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(X), univ(Y), univ(Z)], Responses),
+ { Mesg = "Add3Ints = " }
+ ).
+%---------------------------------------------------------------------------%
+
+:- pred handle_PurchaseBook(option_table(option), string, int, method, uri,
+ list(univ), string, io__state, io__state).
+:- mode handle_PurchaseBook(in, in, in, in, in, out, out, di, uo) is det.
+
+handle_PurchaseBook(OptTable, Host, Port, Method, URI, Responses, Mesg) -->
+ { getopt__lookup_string_option(OptTable, title, Title) },
+ { getopt__lookup_string_option(OptTable, author, Author)},
+ (
+ { Title = "" }
+ ->
+ io__write_string("Title not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ { Author = "" }
+ ->
+ io__write_string("Author not supplied.\n"),
+ io__write_string("Program terminated.\n"),
+ { Mesg = "" },
+ { Responses = [] }
+ ;
+ soap_call_mercury_type(Host, Port, Method, URI,
+ [univ(Title), univ(Author)], Responses),
+ { Mesg = "" }
+ ).
+
+%---------------------------------------------------------------------------%
+:- pred display_mercury_response(string::in, list(univ)::in, io__state::di,
+ io__state::uo) is det.
+
+display_mercury_response(Message, Responses) -->
+ io__write_string(Message),
+ list__foldl((pred(X::in, di, uo) is det -->
+ write(univ_value(X)), nl),
+ Responses).
+
+
Index: options.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m 2000/11/27 10:02:58 1.1
+++ options.m 2001/02/22 06:48:27
@@ -26,6 +26,17 @@
; port
; root
+ % Client options
+ ; method
+ ; uri
+ ; xml
+ ; int % for GetStockPrice
+ ; add1 % for Add3Ints
+ ; add2 % for Add3Ints
+ ; add3 % for Add3Ints
+ ; title % for PurchaseBook
+ ; author % for PurchaseBook
+
% Miscellaneous Options
; help.
@@ -63,25 +74,55 @@
option_default(port, int(8080)).
option_default(root, string("/var/www")).
+ % General client options
+option_default(method, string("")).
+option_default(uri, string("no value")).
+ % for uri, empty string means that the intent of the
+ % SOAP message is provided by the HTTP Request-URI
+ % whereas no value means that there is no indication
+ % of the intent of the message.
+option_default(xml, string("")).
+option_default(int, int(-1)).
+option_default(add1, int(0)).
+option_default(add2, int(0)).
+option_default(add3, int(0)).
+option_default(title, string("")).
+option_default(author, string("")).
+
% Miscellaneous Options
option_default(help, bool(no)).
% please keep this in alphabetic order
+short_option('a', author).
% short_option('f', config_file).
short_option('h', help).
short_option('H', host).
+short_option('i', int).
+short_option('m', method).
short_option('P', port).
short_option('R', root).
+short_option('t', title).
+short_option('u', uri).
short_option('v', verbose).
short_option('V', very_verbose).
+short_option('x', xml).
% long_option("config-file", config_file).
+long_option("add1", add1).
+long_option("add2", add2).
+long_option("add3", add3).
+long_option("author", author).
long_option("help", help).
long_option("host", host).
+long_option("int", int).
+long_option("method", method).
long_option("port", port).
long_option("root", root).
+long_option("title", title).
+long_option("uri", uri).
long_option("verbose", verbose).
long_option("very-verbose", very_verbose).
+long_option("xml", xml).
options_help -->
io__write_strings([
@@ -99,6 +140,26 @@
"\t\tWhich port quicksilver listens on.\n",
"\t-R, --root\n",
"\t\tThe root directory for the html files to be served.\n",
+
+ "\nClient Options:\n",
+ "\t-m, --method\n",
+ "\t\tMethod Name to be called.\n",
+ "\t-u, --uri\n",
+ "\t\tURI of SOAPAction header.\n",
+ "\t-x, --xml\n",
+ "\t\tAn XML message for the RPC.\n",
+ "\t-i, --int\n",
+ "\t\tStocknum for GetStockPrice.\n",
+ "\t--add1\n",
+ "\t\tFirst integer parameter for Add3Ints.\n",
+ "\t--add2\n",
+ "\t\tSecond integer parameter for Add3Ints.\n",
+ "\t--add3\n",
+ "\t\tThird integer parameter for Add3Ints.\n",
+ "\t-a, --author surname,firstname\n",
+ "\t\tAuthor of the book.\n",
+ "\t-t, --title\n",
+ "\t\tTitle of the book.\n",
"\nVerbosity Options:\n",
"\t-v, --verbose\n",
Index: server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.6
diff -u -r1.6 server.m
--- server.m 2001/02/09 05:15:42 1.6
+++ server.m 2001/02/22 06:48:27
@@ -420,26 +420,29 @@
{ Request^cmd = post },
(
{ Request^body = yes(Body) } ,
- parse_soapmessage(Body, NsBody),
- % XXX parse_soapmessage calls error/1 when failed
- % should change to response with http code = 415
-
- { get_procedure_call(NsBody, Proc) },
- write(Proc), nl, nl,
+ parse_soapmessage(Body, NsBody, ErrMesg),
+ (
+ { ErrMesg = yes(Mesg) },
+ { HttpCode = 415 },
+ { Result = Mesg },
+ { ResBody = no_body }
+ ;
+ { ErrMesg = no },
+ { get_procedure_call(NsBody, Proc) },
- { make_web_request(NsBody, Proc, WebRequest) },
- write(WebRequest), nl, nl,
+ { make_web_request(NsBody, Proc, WebRequest) },
- load_dynamic_library(uri_to_filename(Request^uri),
+ load_dynamic_library(uri_to_filename(Request^uri),
WebRequest, Result, HttpCode, ErrorFlag),
- (
+ (
{ ErrorFlag = no },
{ generate_response_body(NsBody, Proc,
Result, ResBody0) },
{ ResBody = string_body(ResBody0) }
- ;
+ ;
{ ErrorFlag = yes },
{ ResBody = no_body }
+ )
)
;
% 200 - 299 is client request successful
Index: soap.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
retrieving revision 1.2
diff -u -r1.2 soap.m
--- soap.m 2001/02/09 05:15:42 1.2
+++ soap.m 2001/02/22 06:48:27
@@ -14,13 +14,14 @@
:- module soap.
:- interface.
-:- import_module io, string.
+:- import_module io, std_util, string.
:- import_module xml, xml:ns.
:- import_module web_methods.
% Translates SOAP message to namespace aware SOAP message.
-:- pred parse_soapmessage(string, ((xml:ns):nsDocument), io__state, io__state).
-:- mode parse_soapmessage(in, out, di, uo) is det.
+:- pred parse_soapmessage(string, ((xml:ns):nsDocument), maybe(string),
+ io__state, io__state).
+:- mode parse_soapmessage(in, out, out, di, uo) is det.
% Retrieves method name from the SOAP message.
:- pred get_procedure_call(nsDocument, nsElement).
@@ -50,7 +51,7 @@
% Parses soap message.
% NsDoc is namespace aware soap message.
-parse_soapmessage(SoapMessage, NsDoc) -->
+parse_soapmessage(SoapMessage, NsDoc, ErrorMesg) -->
pstate(mkEntity(SoapMessage), mkEncoding(utf8), init),
io((pred(Dirs0::out, di, uo) is det -->
get_environment_var("XML_DIRS", MStr),
@@ -76,14 +77,16 @@
finish(Res),
(
{ Res = ok((_, Doc)) },
- { nsTranslate(Doc, NsDoc) }
+ { nsTranslate(Doc, NsDoc) },
+ { ErrorMesg = no }
;
% XXX instead of error, should change to response
% with http code 415 Unsupported Media Type
{ Res = error(Err) },
{ string__append("parse_soapmessage failed: ", Err, ErrMsg) },
- { error(ErrMsg) }
+ { ErrorMesg = yes(ErrMsg) },
+ { NsDoc = nsDoc([], 0, [], array([comment("")])) }
).
Index: soap_interface.m
===================================================================
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap_interface.m Wed Feb 21 22:48:27 2001
@@ -0,0 +1,458 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% File: soap_inteface.m
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module provide an interface for programmers to send messages
+% to the SOAP server. It will provide as basic functionality the
+% ability to do RPC over SOAP. The hard-coded XML encoding for
+% Mercury datatypes (the same encoding as the SOAP server currently
+% expects) will be used to encode the RPC calls.
+%
+%---------------------------------------------------------------------------%
+
+:- module soap_interface.
+:- interface.
+:- import_module io, list, std_util, string.
+:- import_module tcp.
+
+:- type method == string.
+:- type uri == string.
+:- type xml == string.
+
+ % Sends messages (in mercury types) to the SOAP server and returns
+ % the response (in mercury types).
+ % host and port specifies the host and port number that the client
+ % connects to; method specifies the method name of the RPC;
+ % uri indicates the intent of the SOAP HTTP request (see reference
+ % section 6.1); lists of univ are the input parameters of RPC and
+ % the output responses from the server.
+
+:- pred soap_call_mercury_type(host::in, port::in, method::in,
+ uri::in, list(univ)::in, list(univ)::out,
+ io__state::di, io__state::uo) is det.
+
+ % Sends messages (in XML format) to the SOAP server and returns
+ % the response (in XML format).
+ % host and port specifies the host and port number that the client
+ % connects to; method specifies the method name of the RPC;
+ % uri indicates the intent of the SOAP HTTP request (see reference
+ % section 6.1); xmls are the message sends to the server and
+ % the response receives from it.
+
+:- pred soap_call_xml_type(host::in, port::in, method::in, uri::in,
+ xml::in, xml::out, io__state::di, io__state::uo) is det.
+
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module int, require.
+:- import_module stream.
+
+
+soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
+ Responses) -->
+ { generate_request(Host, Method, SOAPuri, Parameters, Request) },
+ tcp__connect(Host, Port, Result),
+ (
+ { Result = ok(TCP_Connect) },
+ service_connection(TCP_Connect, Request, XMLResponse)
+ ;
+ { Result = error(String) },
+ { error(String) }
+ ),
+ tcp__shutdown(TCP_Connect),
+ (
+ { Decode_Handler = decode_response(Method) },
+ { call(Decode_Handler, XMLResponse, Responses) }
+ ;
+ { error("Soap_call_mercury_type: Method not supported") }
+ ).
+
+
+ % Choose a corresponding predicate to decode response for
+ % a particular method.
+
+:- type decode_handler == pred(string, list(univ)).
+:- inst decode_handler == (pred(in, out) is det).
+
+:- func decode_response(string) = decode_handler.
+:- mode decode_response(in) = out(decode_handler) is semidet.
+
+ % XXX Add a handler for the new method here.
+
+decode_response("Hello") = decode_Hello_response.
+decode_response("GetStockPrice") = decode_SP_response.
+decode_response("Add3Ints") = decode_AddInt_response.
+decode_response("PurchaseBook") = decode_PB_response.
+
+
+%--------------------------------------------------------------------------%
+
+soap_call_xml_type(Host, Port, _Method, SOAPuri, XMLMesg, XMLResponse) -->
+ { generate_xml_request(Host, SOAPuri, XMLMesg, Request) },
+ tcp__connect(Host, Port, Result),
+ (
+ { Result = ok(TCP_Connect) },
+ service_connection(TCP_Connect, Request, Response)
+ ;
+ { Result = error(String) },
+ { error(String) }
+ ),
+ tcp__shutdown(TCP_Connect),
+ { retrieve_body(Response, XMLResponse) }.
+
+
+:- pred generate_xml_request(host::in, uri::in, xml::in, string::out)
+ is det.
+
+generate_xml_request(Host, SOAPuri, XMLMesg, Request) :-
+ generate_xml_body(XMLMesg, Body),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+:- pred generate_xml_body(xml::in, string::out) is det.
+
+generate_xml_body(XMLMesg, SOAPBody) :-
+ SOAPBody = "<Envelope><Body>" ++ XMLMesg ++ "</Body></Envelope>".
+
+:- pred retrieve_body(string::in, xml::out) is det.
+
+retrieve_body(Response, Body) :-
+ (
+ string__sub_string_search(Response, "\r\n<", Pos)
+ ->
+ string__length(Response, Length),
+ string__right(Response, Length - Pos, Body)
+ ;
+ error("error in retrieving body")
+ ).
+
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header information and SOAP message in the body.
+:- pred generate_request(host, method, uri, list(univ), string).
+:- mode generate_request(in, in, in, in, out) is det.
+
+generate_request(Host, Method, SOAPuri, Parameters, Request) :-
+ /*
+ (
+ Body_Handler = generate_body(Method),
+ call(Body_Handler, Method, Parameters, Body)
+
+ */
+ (
+ Method = "Hello"
+ ->
+ generate_Hello_body(Method, Parameters, Body)
+ ;
+ Method = "GetStockPrice"
+ ->
+ generate_SP_body(Method, Parameters, Body)
+ ;
+ Method = "Add3Ints"
+ ->
+ generate_AddInt_body(Method, Parameters, Body)
+ ;
+ Method = "PurchaseBook"
+ ->
+ generate_PB_body(Method, Parameters, Body)
+ ;
+ error("Generate message body failed.\n")
+ ),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+% XXX if I switch to use higher order instead, the following error occur
+%
+% Uncaught exception:
+% Software Error: Sorry, not implemented: determinism inference for
+% higher-order predicate terms
+% Stack dump not available in this grade.
+
+
+:- type body_handler == pred(string, list(univ), string).
+:- inst body_handler == (pred(in, in, out) is det).
+
+/*
+:- func generate_body(string) = body_handler.
+:- mode generate_body(in) = out(body_handler) is semidet.
+
+ % XXX Add a body handler for the new method here.
+
+generate_body("Hello") = generate_Hello_body.
+generate_body("GetStockPrice") = generate_SP_body.
+generate_body("Add3Ints") = generate_AddInt_body.
+generate_body("PurchaseBook") = generate_PB_body.
+
+*/
+
+%-------------------------------------------------------------------------%
+% Hello
+%-------------------------------------------------------------------------%
+
+ % Generates SOAP message.
+ % Hello pred has no input.
+:- pred generate_Hello_body(string, list(univ), string).
+:- mode generate_Hello_body(in, in, out).
+
+generate_Hello_body(MethodName, _Parameters, Body) :-
+ insert_envelope(MethodName, "", Body).
+
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<output>", Start),
+ string__sub_string_search(XMLResponse, "</output>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 8, % <output>
+ string__right(Response0, End-Start-TagLength, Response1),
+ Responses = [univ(Response1)]
+ ;
+ error("decode error")
+ ).
+
+%--------------------------------------------------------------------------%
+% Add3Ints
+%--------------------------------------------------------------------------%
+
+ % Generate message body for Add3Ints.
+:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
+ is det.
+
+generate_AddInt_body(Method, Parameters, Body) :-
+ list__map(create_xml_parameter, Parameters, XMLList),
+ string__append_list(XMLList, XMLString),
+ insert_envelope(Method, XMLString, Body).
+
+:- pred create_xml_parameter(univ::in, string::out) is det.
+
+create_xml_parameter(ParameterAsUniv, ParameterAsXML) :-
+ det_univ_to_type(ParameterAsUniv, ParameterAsInt),
+ string__int_to_string(ParameterAsInt, ParameterAsString),
+ ParameterAsXML = "<int>" ++ ParameterAsString ++ "</int>".
+
+:- pred decode_AddInt_response(string::in, list(univ)::out) is det.
+
+decode_AddInt_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<result>", Start),
+ string__sub_string_search(XMLResponse, "</result>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 8, % <result>
+ string__right(Response0, End-Start-TagLength, Response1),
+ (
+ string__to_int(Response1, ResponseAsInt)
+ ->
+ Responses = [univ(ResponseAsInt)]
+ ;
+ error("decode error")
+ )
+ ;
+ error("decode error")
+ ).
+
+%--------------------------------------------------------------------------%
+% GetStockPrice
+%--------------------------------------------------------------------------%
+
+ % Generates SOAP message body for GetStockPrice.
+ % XXX assume no namespace and client has a copy of the schema
+ % used in the server side to encode mercury types.
+:- pred generate_SP_body(method, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+ % schema for GetStockPrice:
+ % <element name="stocknum" type="xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+ % since client knows that this function takes in only
+ % one parameter, there is no need to call list_foldl to
+ % translate the parameters.
+ list__index1_det(Parameters, 1, Parameter),
+ generate_SP_param(Parameter, ParamAsString),
+ insert_envelope(MethodName, ParamAsString, Body).
+
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :-
+ det_univ_to_type(ParamAsUniv, ParamAsValue),
+ string__int_to_string(ParamAsValue, ParamAsString),
+ Tag = "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<price>", Start),
+ string__sub_string_search(XMLResponse, "</price>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 7, % <price>
+ string__right(Response0, End - Start - TagLength, Response1),
+ (
+ string__to_int(Response1, ResponseAsInt)
+ ->
+ Response = ResponseAsInt
+ ;
+ error("decode error")
+ ),
+ Responses = [univ(Response)]
+ ;
+ error("decode error")
+ ).
+
+%-------------------------------------------------------------------------%
+% PurchaseBook
+%-------------------------------------------------------------------------%
+
+ % Generate message body for PurchaseBook.
+:- pred generate_PB_body(method::in, list(univ)::in, string::out) is det.
+generate_PB_body(Method, Parameters, Body) :-
+ generate_PB_parameters(Parameters, ParameterString0),
+ ParameterString = "<book>" ++ ParameterString0 ++ "</book>",
+ insert_envelope(Method, ParameterString, Body).
+
+:- pred generate_PB_parameters(list(univ)::in, string::out) is det.
+
+generate_PB_parameters(ParamList, Body):-
+ list__index1_det(ParamList, 1, TitleAsUniv),
+ det_univ_to_type(TitleAsUniv, TitleAsString),
+ Title = "<title>" ++ TitleAsString ++ "</title>",
+
+ list__index1_det(ParamList, 2, AuthorAsUniv),
+ det_univ_to_type(AuthorAsUniv, AuthorAsString),
+ (
+ string__sub_string_search(AuthorAsString, ",", Pos)
+ ->
+ string__left(AuthorAsString, Pos, Surname),
+ string__length(AuthorAsString, Length),
+ string__right(AuthorAsString, Length - (Pos + 1), Firstname)
+ ;
+ Surname = AuthorAsString,
+ Firstname = " "
+ ),
+ Author = "<author>" ++
+ "<surname>" ++ Surname ++ "</surname>" ++
+ "<firstname>" ++ Firstname ++ "</firstname>" ++
+ "</author>",
+ Body = Title ++ Author.
+
+:- pred decode_PB_response(string::in, list(univ)::out) is det.
+
+decode_PB_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<comment>", Start),
+ string__sub_string_search(XMLResponse, "</comment>", End)
+ ->
+ string__left(XMLResponse, End, Comment0),
+ TagLength = 9, % <comment>
+ string__right(Comment0, End - Start - TagLength, Comment1),
+ Comment = [univ(Comment1)]
+ ;
+ Comment = []
+ ),
+ (
+ string__sub_string_search(XMLResponse, "<price>", Start1),
+ string__sub_string_search(XMLResponse, "</price>", End1)
+ ->
+ string__left(XMLResponse, End1, Price0),
+ TagLength1 = 7, % <price>
+ string__right(Price0, End1 - Start1 - TagLength1, Price1),
+ Price = [univ("Price = " ++ Price1)]
+ ;
+ Price = []
+ ),
+ list__append(Comment, Price, Responses).
+
+
+%-------------------------------------------------------------------------%
+% Shared functions
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header.
+:- pred generate_header(host::in, int::in, uri::in, string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+ Header1 = "POST /libsoap_test_methods.so HTTP/1.1",
+ Header2 = "Host: " ++ Host,
+ Header3 = "Content-Type: text/xml",
+ string__int_to_string(Length, LengthAsString),
+ Header4 = "Content-Length: " ++ LengthAsString,
+ (
+ SOAPuri = "no value"
+ ->
+ Header5 = "SOAPAction:"
+ ;
+ Header5 = "SOAPAction: " ++ SOAPuri
+ ),
+ Headers = insert_cr(Header1) ++ insert_cr(Header2) ++
+ insert_cr(Header3) ++ insert_cr(Header4) ++
+ insert_cr(Header5).
+
+ % Generate SOAP Envelope
+
+:- pred insert_envelope(string::in, string::in, string::out).
+insert_envelope(MethodName, Parameters, Body) :-
+ Body = "<Envelope><Body><" ++ MethodName ++ ">" ++
+ Parameters ++ "</" ++ MethodName ++ ">" ++
+ "</Body></Envelope>".
+
+ % Insert carriage return into the line.
+:- func insert_cr(string) = string.
+insert_cr(Line) = Line ++ "\r\n".
+
+%------------------------------------------------------------------------%
+
+ % Sends request to server using HTTP and receives response
+ % from server.
+:- pred service_connection(tcp::in, string::in, string::out,
+ io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+ send_request(TCP, Request),
+ read_response(TCP, Response).
+
+ % Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <= stream__output(S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+ stream__write_string(S, Requests).
+
+ % Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <= stream__input(S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+ stream__read_line(S, LineResult),
+ (
+ { LineResult = ok(Line) },
+ { string__from_char_list(Line, String) },
+ { Response = String ++ Response0 },
+ read_response(S, Response0)
+ ;
+ { LineResult = eof },
+ { Response = "" }
+ ;
+ { LineResult = error(Error) },
+ { error(string__format("read_response: %s.", [s(Error)])) }
+ ).
+
+%-------------------------------------------------------------------------%
|
|
From: Ina C. <in...@st...> - 2001-02-22 06:55:15
|
=20
Index: soap_test_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.2
diff -u -r1.2 soap_test_methods.m
--- soap_test_methods.m=092001/02/09 05:15:42=091.2
+++ soap_test_methods.m=092001/02/22 06:48:27
@@ -23,20 +23,27 @@
:- interface.
:- import_module list, std_util.
=20
+ =09% Trivial testing predicate - print out "Hello world".
:- pred hello(univ::out) is det.
=20
+=09% Given a stock number, return its price.=20
:- pred get_sp(list(univ)::in, univ::out) is det.
=20
:- func get_stockprice(list(univ)) =3D univ.
=20
-% :- pred get_bookprice(book::in, univ::out) is det.
-:- pred get_bookprice(list(univ)::in, univ::out) is det.
+=09% Adding 3 integers.
+:- func add3Ints(list(univ)) =3D univ.
=20
+=09% Place a purchase order for a specific book.
+:- pred purchase_book(list(univ)::in, univ::out) is det.
+
+:- pred sum_list(list(univ)::in, univ::out) is det.
+
:- type book
=09--->=09book(
=09=09=09title :: string,
-=09=09=09author :: author,
-=09=09=09intro :: string
+=09=09=09author :: author
+=09=09=09% intro :: string
=09=09).
=09
:- type author
@@ -69,6 +76,20 @@
=09ResultAsUniv =3D univ("<output>Hello, world</output>").
=20
%---------------------------------------------------------------------%
+% Add3Ints
+%---------------------------------------------------------------------%
+
+add3Ints(ParamList) =3D Result :-
+=09list__index1_det(ParamList, 1, XAsUniv),
+=09list__index1_det(ParamList, 2, YAsUniv),
+=09list__index1_det(ParamList, 3, ZAsUniv),
+=09det_univ_to_type(XAsUniv, X),=20
+=09det_univ_to_type(YAsUniv, Y),=20
+=09det_univ_to_type(ZAsUniv, Z),=20
+=09ResultAsUniv =3D X + Y + Z,
+=09Result =3D univ(ResultAsUniv).
+
+%---------------------------------------------------------------------%
% GetStockPrice=20
%---------------------------------------------------------------------%
=20
@@ -100,24 +121,47 @@
=09).
=20
%---------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%---------------------------------------------------------------------%
=20
-get_bookprice(ParamList, ResultAsUniv) :-=20
+purchase_book(ParamList, ResultAsUniv) :-=20
=09list__index1_det(ParamList, 1, ParamAsUniv),
=09Param0 =3D univ_value(ParamAsUniv),
=09Param =3D inst_cast_book(Param0),=20
=09(
-=09=09Param =3D book("Hello world",=20
-=09=09=09=09author("Foo", "Bar"),=20
-=09=09=09=09"This is a book")=20
+=09=09Param =3D book("Hello world", =20
+=09=09=09=09author("Foo", "Bar"))
+=09=09=09=09% "This is a book")=20
=09->
=09=09ResultAsUniv =3D univ(100)
=09;
-=09=09ResultAsUniv =3D univ(50)
+=09=09ResultAsUniv =3D univ(0)
=09).
=20
:- func inst_cast_book(T) =3D book.
:- mode inst_cast_book(in) =3D out is det.
:- pragma c_code(inst_cast_book(X::in) =3D (Y::out),
[will_not_call_mercury, thread_safe], "Y =3D X").
+
+%---------------------------------------------------------------------%
+% SumList
+%---------------------------------------------------------------------%
+
+sum_list(ParamList, ResultAsUniv) :-
+=09list__index1_det(ParamList, 1, ParamAsUniv),
+=09Param0 =3D univ_value(ParamAsUniv),
+=09Param =3D inst_cast_list(Param0),=20
+=09sumlist(Param, 0, Sum),
+=09ResultAsUniv =3D univ(Sum).
+
+:- pred sumlist(list(int)::in, int::in, int::out) is det.
+sumlist([], Acc, Acc).=20
+sumlist([H|T], Acc0, Acc) :-
+=09sumlist(T, Acc0, Acc1),=20
+=09Acc =3D Acc1 + H.
+
+:- func inst_cast_list(T) =3D list(int).
+:- mode inst_cast_list(in) =3D out is det.
+:- pragma c_code(inst_cast_list(X::in) =3D (Y::out),
+ [will_not_call_mercury, thread_safe], "Y =3D X").
+
Index: web_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.2
diff -u -r1.2 web_methods.m
--- web_methods.m=092001/02/09 05:15:42=091.2
+++ web_methods.m=092001/02/22 06:48:27
@@ -132,12 +132,23 @@
=09=09=09call_SP_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)=20
=09=09;
-=09=09=09% GetBookPrice takes in a struct
-=09=09=09{ Request^name =3D "GetBookPrice" }
+=09=09=09% Add3Ints has 3 parameters
+=09=09=09{ Request^name =3D "Add3Ints" }
=09=09->
-=09=09=09call_BP_pred(Handle, Filename, Request,=20
+=09=09=09call_AI_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)
=09=09;
+=09=09=09% PurchaseBook takes in a struct
+=09=09=09{ Request^name =3D "PurchaseBook" }
+=09=09->
+=09=09=09call_PB_pred(Handle, Filename, Request,=20
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
+=09=09=09{ Request^name =3D "Sumlist" }
+=09=09->
+=09=09=09call_list_pred(Handle, Filename, Request,
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
=09=09=09{ Response0 =3D "Method requested not implemented." },=20
=09=09=09{ ErrorFlag0 =3D yes },
=09=09=09{ HttpCode0 =3D 501 }=09% 501 Not Implemented
@@ -227,6 +238,62 @@
[will_not_call_mercury, thread_safe], "Y =3D X").
=20
%-----------------------------------------------------------------------%
+% Add3Ints=20
+%-----------------------------------------------------------------------%
+
+:- pred call_AI_func(handle, string, web_method_request,=20
+=09string, http_code, bool, io__state, io__state).
+:- mode call_AI_func(in, in, in, out, out, out, di, uo) is det.
+
+call_AI_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ AIProc =3D mercury_proc(function, unqualified(Filename),
+=09=09=09=09"add3Ints", 1, 0) },
+=09dl__mercury_sym(Handle, AIProc, MaybeAddInts),
+=09(
+=09=09{ MaybeAddInts =3D error(Msg) },
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }=20
+=09;
+=09=09{ MaybeAddInts =3D ok(AIFunc0) },
+=09=09{ wrapper(AIFunc) =3D inst_cast_addInts(wrapper(AIFunc0)) },
+=09=09{ list__map(lookup_AI_schema, Request^params, UnivList) },
+=09=09{ ResultAsUniv =3D AIFunc(UnivList) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<result>" ++ ResultAsString ++ "</result>" },
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
+
+=09% schema=20
+=09% <element name=3D"int" type=3D"xsd:int">
+
+:- pred lookup_AI_schema(parameter::in, univ::out) is det.
+lookup_AI_schema(Param, ValueAsUniv) :-
+=09(
+=09=09Param^pName =3D "int",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09 =09type_cast_parameter("int", Value, ValueAsUniv)
+=09;
+=09=09string__append("Element Name not defined in schema: ",=20
+=09=09=09=09Param^pName, ErrorMsg),
+=09=09require__error(ErrorMsg)
+=09).
+
+=09% inst cast for add3Ints (function)
+:- type addInts =3D=3D (func(list(univ)) =3D univ ).
+:- type addInts_wrapper ---> wrapper(addInts).
+:- inst addInts_wrapper ---> wrapper(func(in) =3D out is det).
+
+:- func inst_cast_addInts(addInts_wrapper) =3D addInts_wrapper.
+:- mode inst_cast_addInts(in) =3D out(addInts_wrapper) is det.
+:- pragma c_code(inst_cast_addInts(X::in) =3D (Y::out(addInts_wrapper)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
% GetStockPrice=20
%-----------------------------------------------------------------------%
=20
@@ -302,8 +369,6 @@
=09=09% XXX type may contain prefix=20
=09=09% Eg. xsd:int, xsd:float
=20
-=09=09% XXX Do I have to make sure the prefix =3D mercury?
-
=09=09% Case 3 <stocknum xsi:type=3D"xsd:int">1</stocknum>
=09=09% web_method_request("GetStockPrice",=20
=09=09% [parameter("stocknum", yes("xsd:int"), "",
@@ -341,7 +406,7 @@
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%-----------------------------------------------------------------------%
=20
/* see Section 3.4 Complex Type Definition Details=20
@@ -359,7 +424,7 @@
schema components across namespaces (=A76.2.3) for the use of component=20
identifiers when importing one schema into another.
*/
-=09% schema for GetBookPrice:
+=09% schema for PurchaseBook:
=09%
=09% <element name=3D"book" type=3D"tns:book"/>
=09% <element name=3D"author" base=3D"tns:author"/>
@@ -368,7 +433,7 @@
=09% <sequence>
=09% <element name=3D"title" type=3D"xsd:string"/>
=09% <element name=3D"author" type=3D"tns:author"/>
-=09% <element name=3D"intro" type=3D"xsd:string"/>
+=09% % <element name=3D"intro" type=3D"xsd:string"/>
=09% </sequence>
=09% </complexType>
=09% =20
@@ -385,7 +450,7 @@
=09%=09--->=09book(
=09%=09=09=09title =09:: string,
=09%=09=09=09author =09:: author,
-=09%=09=09=09intro=09:: string
+=09%=09=09%=09intro=09:: string
=09%=09=09).
=09%=09
=09% :- type author
@@ -394,64 +459,71 @@
=09%=09=09=09firstname :: string
=09%=09=09).
=20
-:- pred call_BP_pred(handle, string, web_method_request,
+:- pred call_PB_pred(handle, string, web_method_request,
=09string, http_code, bool, io__state, io__state).
-:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det.
+:- mode call_PB_pred(in, in, in, out, out, out, di, uo) is det.
=20
-call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
-=09{ GetBPProc =3D mercury_proc(predicate, unqualified(Filename),
-=09=09=09"get_bookprice", 2, 0) },=20
-=09dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
+call_PB_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ GetPBProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"purchase_book", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetPBProc, MaybePurchaseBook),
=09(
-=09=09{ MaybeGetBookPrice =3D error(Msg) },=20
+=09=09{ MaybePurchaseBook =3D error(Msg) },=20
=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
=09=09{ Response =3D ErrorMsg },
=09=09{ ErrorFlag =3D yes },
=09=09{ HttpCode =3D 500 }
=09;
-=09=09{ MaybeGetBookPrice =3D ok(BPProc0) },=20
+=09=09{ MaybePurchaseBook =3D ok(PBProc0) },=20
=20
=09=09% Cast the higher-order term that we obtained
=09=09% to the correct higher-order inst.
-=09=09{ BPProc =3D inst_cast_bp(BPProc0) },
+=09=09{ PBProc =3D inst_cast_pb(PBProc0) },
=20
=09=09% Convert parameters (string) to the corresponding types
-=09=09{ list__map(lookup_BP_schema, Request^params, UnivList) },
+=09=09{ list__map(lookup_PB_schema, Request^params, UnivList) },
=09=09
=09=09% Call the procedure whose address we just obtained
-=09=09{ call(BPProc, UnivList, BPUniv) },
+=09=09{ call(PBProc, UnivList, PBUniv) },
=20
-=09=09{ det_univ_to_type(BPUniv, BPInt) },=09
-=09=09{ string__int_to_string(BPInt, BPString) },
-
-=09=09{ string__append("<price>", BPString, BPresult0) },
-=09=09{ string__append(BPresult0, "</price>", BPresult) },
-=09=09{ Response =3D BPresult },
+=09=09{ det_univ_to_type(PBUniv, PBInt) },=09
+=09=09(=20
+=09=09 =09{ PBInt \=3D 0 }
+=09=09->
+=09=09=09{ string__int_to_string(PBInt, PBString) },
+=09=09=09{ Response =3D "<comment>Purchase order placed " ++
+=09=09=09=09 =09"successfully</comment>\n<price>" ++
+=09=09=09=09=09PBString ++ "</price>" }
+=09=09;
+=09=09=09{ Response =3D "<comment>No such book. Purchase " ++
+=09=09=09=09=09"order not placed.</comment>" }=09
+=09=09),
=09=09{ ErrorFlag =3D no },
=09=09{ HttpCode =3D 200 }
=09).
=20
=20
-:- pred lookup_BP_schema(parameter::in, univ::out) is det.
+:- pred lookup_PB_schema(parameter::in, univ::out) is det.
=20
-lookup_BP_schema(Param, ValueAsUniv) :- =20
+lookup_PB_schema(Param, ValueAsUniv) :- =20
=09(
=09=09Param^pName =3D "book",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "title", Title0),
-=09=09lookup_BP_schema(Title0, TitleAsUniv),
+=09=09get_PB_param(FieldList, "title", Title0),
+=09=09lookup_PB_schema(Title0, TitleAsUniv),
=09=09det_univ_to_type(TitleAsUniv, Title),
=20
-=09=09get_BP_param(FieldList, "author", Author0),
-=09=09lookup_BP_schema(Author0, AuthorAsUniv),
+=09=09get_PB_param(FieldList, "author", Author0),
+=09=09lookup_PB_schema(Author0, AuthorAsUniv),
=09=09det_univ_to_type(AuthorAsUniv, Author),
=09
-=09=09get_BP_param(FieldList, "intro", Intro0),
-=09=09lookup_BP_schema(Intro0, IntroAsUniv),
-=09=09det_univ_to_type(IntroAsUniv, Intro),
+=09=09% get_PB_param(FieldList, "intro", Intro0),
+=09=09% lookup_PB_schema(Intro0, IntroAsUniv),
+=09=09% det_univ_to_type(IntroAsUniv, Intro),
=20
-=09=09ValueAsBook =3D book(Title, Author, Intro),
+=09=09% ValueAsBook =3D book(Title, Author, Intro),
+=09=09ValueAsBook =3D book(Title, Author),
=09=09ValueAsUniv =3D univ(ValueAsBook)
=09;=09
=09=09Param^pName =3D "title",
@@ -462,12 +534,12 @@
=09=09Param^pName =3D "author",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "surname", Surname0),
-=09=09lookup_BP_schema(Surname0, SurnameAsUniv),
+=09=09get_PB_param(FieldList, "surname", Surname0),
+=09=09lookup_PB_schema(Surname0, SurnameAsUniv),
=09=09det_univ_to_type(SurnameAsUniv, Surname),
=20
-=09=09get_BP_param(FieldList, "firstname", Firstname0),
-=09=09lookup_BP_schema(Firstname0, FirstnameAsUniv),
+=09=09get_PB_param(FieldList, "firstname", Firstname0),
+=09=09lookup_PB_schema(Firstname0, FirstnameAsUniv),
=09=09det_univ_to_type(FirstnameAsUniv, Firstname),
=20
=09=09ValueAsAuthor =3D author(Surname, Firstname),
@@ -491,21 +563,154 @@
=09=09require__error("Element Structure not defined in schema.")
=09).
=20
-:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is d=
et.
+:- pred get_PB_param(list(parameter)::in, string::in, parameter::out) is d=
et.
=20
-get_BP_param(ParamList, SearchString, Parameter) :-
+get_PB_param(ParamList, SearchString, Parameter) :-
=09list__filter((pred(X::in) is semidet :-
=09=09X =3D parameter(SearchString,_,_,_,_)), ParamList, Result),
=09list__index1_det(Result, 1, Parameter).=09
=20
-=09% inst cast for get_bookprice=20
-:- type bp_pred =3D=3D pred(list(univ), univ).
-% :- type bp_pred =3D=3D pred(book, univ).
-:- inst bp_pred =3D=3D (pred(in, out) is det).
+=09% inst cast for purchase_book
+:- type pb_pred =3D=3D pred(list(univ), univ).
+% :- type pb_pred =3D=3D pred(book, univ).
+:- inst pb_pred =3D=3D (pred(in, out) is det).
+=20
+:- func inst_cast_pb(pb_pred) =3D pb_pred.
+:- mode inst_cast_pb(in) =3D out(pb_pred) is det.
+:- pragma c_code(inst_cast_pb(X::in) =3D (Y::out(pb_pred)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
+% Sumlist=20
+%-----------------------------------------------------------------------%
+
+/*
+schema:
+ <element name=3D"list" type=3D"tns:list"/>
+ <element name=3D"nil" type=3D"tns:nil"/>
+ <element name=3D"cons" type=3D"tns:cons"/>
+
+ <complexType name=3D"list">
+ <sequence>
+ <choice>
+ <element name=3D"nil" type=3D"tns:nil"/>
+ <element name=3D"cons" type=3D"tns:cons"/>
+ </choice>
+ </sequence>
+ </complexType>
+
+ <complexType name=3D"nil>
+ <complexContent>
+ <restriction base=3D"xsd:anyType">
+ </restriction>
+ </complexContent>
+ </complexType>
+ =20
+ or <complexType name=3D"nil"> shorthand for complex content
+ </complexType> that restricts anyType
+
+ <complexType name=3D"cons">
+ <sequence>
+ <element name=3D"head" type=3D"xsd:anyType">
+ <element name=3D"tail" type=3D"tns:list"/>
+ </sequence>
+ </complexType>
+*/
+
+:- pred call_list_pred(handle, string, web_method_request,
+=09string, http_code, bool, io__state, io__state).
+:- mode call_list_pred(in, in, in, out, out, out, di, uo) is det.
+
+call_list_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -=
->
+=09{ GetListProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"sum_list", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetListProc, MaybeListProc),
+=09(
+=09=09{ MaybeListProc =3D error(Msg) },=20
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }
+=09;
+=09=09{ MaybeListProc =3D ok(ListProc0) },=20
+
+=09=09{ ListProc =3D inst_cast_list(ListProc0) },
+=09=09% parse the parameters to obtain a list of string
+=09=09{ list__foldl(retrieve_list, Request^params, [], StringList) },
+=09=09% cast the list of string to list of int
+=09=09{ type_cast_list("int", StringList, UnivList) },=09
+=09=09{ call(ListProc, [UnivList], ResultAsUniv) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<sum>" ++ ResultAsString ++ "</sum>" },=20
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
+
+:- pred retrieve_list(parameter::in, list(string)::in, list(string)::out)=
=20
+=09is det.
+
+retrieve_list(Param, Acc0, Acc) :- =20
+=09(
+=09=09Param^pName =3D "list",
+=09=09Param^pFields =3D yes(Nil),
+=09=09Nil =3D [parameter("nil", no, "", no, yes([]))]
+=09->
+=09=09Acc =3D Acc0
+=09;
+=09=09Param^pName =3D "list",
+=09=09Param^pFields =3D yes(Cons)
+=09->
+=09=09list__foldl(retrieve_list, Cons, Acc0, Acc1),
+=09=09Acc =3D Acc1 =20
+=09;
+=09=09Param^pName =3D "cons",
+=09=09Param^pFields =3D yes(Head_Tail)
+=09->
+=09=09list__foldl(retrieve_list, Head_Tail, Acc0, Acc)
+=09;
+=09=09Param^pName =3D "head",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09=09list__reverse(Acc0, RevAcc0),
+=09=09RevAcc =3D [ Value | RevAcc0 ],
+=09=09list__reverse(RevAcc, Acc)
+=09;
+=09=09Param^pName =3D "tail",
+=09=09Param^pFields =3D yes(Tail)
+=09->
+=09=09list__foldl(retrieve_list, Tail, Acc0, Acc)
+=09;
+=09=09error("decode list error")
+=09).
+
+:- pred type_cast_list(string::in, list(string)::in, univ::out) is det.
+type_cast_list(Type, List, UnivList) :- =20
+ =09(
+ =09=09Type =3D "int",
+=09=09list__map(string__to_int, List, ListAsInt)
+ =09->
+=09=09UnivList =3D univ(ListAsInt)
+ =09;
+=09=09Type =3D "float",
+=09=09list__map(string__to_float, List, ListAsFloat)
+=09->
+=09=09UnivList =3D univ(ListAsFloat)
+=09;
+=09=09Type =3D "string"
+=09->
+=09=09UnivList =3D univ(List)
+=09;
+ =09=09require__error("Type cast list failed")
+ =09).
+=09=09=09 =09=09
+=09% inst cast for list=20
+:- type list_pred =3D=3D pred(list(univ), univ).
+:- inst list_pred =3D=3D (pred(in, out) is det).
=20
-:- func inst_cast_bp(bp_pred) =3D bp_pred.
-:- mode inst_cast_bp(in) =3D out(bp_pred) is det.
-:- pragma c_code(inst_cast_bp(X::in) =3D (Y::out(bp_pred)),
+:- func inst_cast_list(list_pred) =3D list_pred.
+:- mode inst_cast_list(in) =3D out(list_pred) is det.
+:- pragma c_code(inst_cast_list(X::in) =3D (Y::out(list_pred)),
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
|
|
From: Fergus H. <fj...@cs...> - 2001-02-22 01:15:16
|
On 19-Feb-2001, Ina Cheng <in...@st...> wrote:
>
> +++ client_demo.m Sun Feb 18 16:23:17 2001
...
> +main -->
> + io__command_line_arguments(Args0),
> + { OptionOpts = option_ops(short_option, long_option, option_defaults)},
> + { getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
> + (
> + { OptionsResult = ok(OptTable) },
> + { getopt__lookup_bool_option(OptTable, help, Help) },
> + (
> + { Help = yes },
> + options_help
> + ;
> + { Help = no },
> + { getopt__lookup_string_option(OptTable, host, Host) },
> + { getopt__lookup_int_option(OptTable, port, Port) },
> + { getopt__lookup_string_option(OptTable, method, Method) },
> + { getopt__lookup_string_option(OptTable, uri, URI) },
> + { getopt__lookup_string_option(OptTable, xml, XML) },
> + (
> + { XML = "" }
> + ->
> + (
> + { Method = "GetStockPrice" }
> + ->
> + { getopt__lookup_int_option(OptTable, int, Int) },
> + (
> + { Int = -1 }
> + ->
> + io__write_string("Parameter not supplied.\n"),
> + io__write_string("Program terminated.\n")
> + ;
> + soap_call_mercury_type(Host, Port, Method,
> + URI, [univ(Int)], Responses),
> + display_mercury_response("Stockprice = ",
> + Responses)
> + )
> + ;
> + { Method = "Hello" }
> + ->
> + soap_call_mercury_type(Host, Port, Method,
> + URI, [], Responses),
> + display_mercury_response("", Responses)
> + ;
> + { Method = "Add3Ints" }
> + ->
> + { getopt__lookup_int_option(OptTable, add1, X) },
> + { getopt__lookup_int_option(OptTable, add2, Y) },
> + { getopt__lookup_int_option(OptTable, add3, Z) },
> + (
> + % If some of the arguments are not supplied,
> + % they are treated as 0. Only when all
> + % arguments are not supplied, the program
> + % terminates.
> + { X = 0 }, { Y = 0 }, { Z = 0 }
> + ->
> + io__write_string("Parameter not supplied.\n"),
> + io__write_string("Program terminated.\n")
> + ;
> + soap_call_mercury_type(Host, Port, Method,
> + URI, [univ(X), univ(Y), univ(Z)],
> + Responses),
> + display_mercury_response("Add3Ints = ",
> + Responses)
> + )
> + ;
> + { Method = "PurchaseBook" }
> + ->
> + { getopt__lookup_string_option(OptTable, title, T) },
> + { getopt__lookup_string_option(OptTable, author, A)},
> + soap_call_mercury_type(Host, Port, Method, URI,
> + [univ(T), univ(A)], Responses),
> + display_mercury_response("", Responses)
> + ;
> + io__write_string("Method not supported.\n"),
> + io__write_string("Program terminated.\n")
> + )
> + ;
> + soap_call_xml_type(Host, Port, Method, URI, XML,
> + Responses),
> + io__write_string(Responses)
> + )
> + )
> + ;
> + { OptionsResult = error(OptionErrorString) },
> + io__write_string(OptionErrorString),
> + io__nl,
> + options_help
> + ).
That predicate is very very long. It would be much nicer to split the code
for handling each different method name into a separate predicate.
And rather than hard-coding the if-then-else on the message names
here, you could use a table, e.g.
:- type method_handler == pred(option_table, ...).
:- inst method_handler == pred(in, ...) is det.
:- func get_method_handler(string, method_handler).
:- mode get_method_handler(in, out(method_handler)) is semidet.
method_handler("PurchaseBook") = handle_purchase_book.
method_handler("...") = ...
soap_interface.m:
> +soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
> + Responses) -->
> + (
> + { Method = "GetStockPrice" }
> + ->
> + { generate_SP_request(Host, Method, SOAPuri,
> + Parameters, Request) }
> + ;
> + { Method = "Hello" }
> + ->
> + { generate_Hello_request(Host, Method, SOAPuri,
> + Parameters, Request) }
> + ;
> + { Method = "Add3Ints" }
> + ->
> + { generate_AddInt_request(Host, Method, SOAPuri,
> + Parameters, Request) }
> + ;
> + { Method = "PurchaseBook" }
> + ->
> + { generate_PB_request(Host, Method, SOAPuri,
> + Parameters, Request) }
> + ;
> + { error("Encode: Method not supported") }
> + ),
It would be nice to use a table here too.
I.e.
soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
Responses) -->
{ generate_request(Method) = Generator ->
call(Generator, Host, Method, SOAPuri,
Parameters, Request)
;
error("Encode: Method not supported")
}.
:- func generate_request(string) =
pred(host, port, method, uri, list(univ), list(univ)).
:- mode generate_request(in) = out(pred(in, in, in, in, in, out) is det.
generate_request("GetStockPrice") = generate_SP_request.
generate_request("Add3Ints") = generate_Add3Int_request.
...
> + % Translates XML response to Mercury types.
> +:- pred decode_response(string::in, string::in, list(univ)::out) is det.
> +
> +decode_response(Method, XMLResponse, Responses) :-
> + (
> + Method = "GetStockPrice"
> + ->
> + decode_SP_response(XMLResponse, Responses)
> + ;
> + Method = "Hello"
> + ->
> + decode_Hello_response(XMLResponse, Responses)
> + ;
> + Method = "Add3Ints"
> + ->
> + decode_AddInt_response(XMLResponse, Responses)
> + ;
> + Method = "PurchaseBook"
> + ->
> + decode_PB_response(XMLResponse, Responses)
> + ;
> + error("Decode: Method not supported")
> + ).
Likewise here.
soap_call_mercury_type(Host, Method, SOAPuri, Parameters,
Responses) -->
{ decode_response(Method) = Generator ->
call(Generator, Host, Method, SOAPuri, Parameters, Responses)
;
error("Encode: Method not supported")
}.
:- func decode_response(string) =
pred(host, port, method, uri, list(univ), list(univ)).
:- mode decode_response(in) = out(pred(in, in, in, in, in, out) is det.
decode_response("GetStockPrice") = decode_SP_Response.
decode_response("Add3Ints") = decode_Add3Int_Response.
...
> +%-------------------------------------------------------------------------%
> +% Hello
> +%-------------------------------------------------------------------------%
> +
> + % Generates HTTP header information and SOAP message in the body.
> +:- pred generate_Hello_request(host, method, uri, list(univ), string).
> +:- mode generate_Hello_request(in, in, in, in, out) is det.
> +
> +generate_Hello_request(Host, Method, SOAPuri, Parameters, Request) :-
> + generate_Hello_body(Method, Parameters, Body),
> + string__length(Body, Length),
> + generate_header(Host, Length, SOAPuri, Header),
> + Request = insert_cr(Header) ++ Body.
...
> +:- pred generate_AddInt_request(host, method, uri, list(univ), string).
> +:- mode generate_AddInt_request(in, in, in, in, out) is det.
> +
> +generate_AddInt_request(Host, Method, SOAPuri, Parameters, Request) :-
> + generate_AddInt_body(Method, Parameters, Body),
> + string__length(Body, Length),
> + generate_header(Host, Length, SOAPuri, Header),
> + Request = insert_cr(Header) ++ Body.
...
> + % Generates HTTP header information and SOAP message in the body.
> +:- pred generate_SP_request(host, method, uri, list(univ), string).
> +:- mode generate_SP_request(in, in, in, in, out) is det.
> +
> +generate_SP_request(Host, Method, SOAPuri, Parameters, Request) :-
> + generate_SP_body(Method, Parameters, Body),
> + string__length(Body, Length),
> + generate_header(Host, Length, SOAPuri, Header),
> + Request = insert_cr(Header) ++ Body.
Can't that code be abstracted out?
It looks like it is the same in all cases.
> + % Generates SOAP message.
> + % Hello pred has no input.
> +:- pred generate_Hello_body(string, list(univ), string).
> +:- mode generate_Hello_body(in, in, out).
> +
> +generate_Hello_body(MethodName, _Parameters, Body) :-
> + Body = "<Envelope><Body><" ++ MethodName ++ ">" ++
> + "</" ++ MethodName ++ "></Body></Envelope>".
> +
> +:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
> + is det.
> +
> +generate_AddInt_body(Method, Parameters, Body) :-
> + list__map(create_xml_parameter, Parameters, XMLList),
> + string__append_list(XMLList, XMLString),
> + Body = "<Envelope><Body><" ++ Method ++ ">" ++ XMLString ++
> + "</" ++ Method ++ "></Body></Envelope>".
Likewise for these ones. (The code for Hello is simplified, because
it assumes that Parameters = [], but you could use the same code as
for AddInt.)
Otherwise that looks fine.
--
Fergus Henderson <fj...@cs...> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
|
|
From: Ina C. <in...@st...> - 2001-02-21 23:21:20
|
Hi Peter,
Can you please approve the following email?
Thanks,
Ina
<in...@st...>
---------- Forwarded message ----------
Date: Tue, 20 Feb 2001 16:45:02 -0800
From: qui...@li...
To: in...@st...
Subject: Your message to Quicksilver-developers awaits moderator approval
Your mail to 'Quicksilver-developers' with the subject
Re: [qs-dev] for review: client interface and sample
Is being held until the list moderator can review it for approval.
The reason it is being held:
Message body is too big: 45341 bytes but there's a limit of 40 KB
Either the message will get posted to the list, or you will receive
notification of the moderator's decision.
|
|
From: Ina C. <in...@st...> - 2001-02-21 00:44:37
|
Hi Fergus,
I've modified the code lately. Can you review this one instead
of the previous version that I've posted? Thanks.
Ina
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
Estimated hours taken: 30
Add an interface between server and client such that the client
can send messages in mercury types to the server.
=20
/server/client_demo.m
new module showing how to call the soap_interface to send
messages to the SOAP server.
/server/options.m
add new options to handle command line arguments.
/server/soap_interface.m
new module - provide an interface for programmers to send messages
to the SOAP server.
/server/soap_test_methods.m
/server/web_methods.m
add a function to demonstrate the soap interface
=09add example to parse list=20
Index: client_demo.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ client_demo.m=09Tue Feb 20 16:37:57 2001
@@ -0,0 +1,130 @@
+%-------------------------------------------------------------------------=
--%
+% Copyright (C) 2001 The University Of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%-------------------------------------------------------------------------=
--%
+%
+% File: client_demo.m
+% Author: inch
+%
+% This module provide a sample of how to call the SOAP interface to send
+% messages from the client to the SOAP server.
+%
+%-------------------------------------------------------------------------=
--%
+
+:- module client_demo.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+%-------------------------------------------------------------------------=
--%
+
+:- implementation.
+:- import_module http, options.
+
+:- import_module bool, char, exception, getopt.
+:- import_module int, list, require, std_util, string.
+
+:- import_module soap_interface.
+
+main -->
+=09io__command_line_arguments(Args0),
+=09{ OptionOpts =3D option_ops(short_option, long_option, option_defaults)=
},
+=09{ getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+=09(
+=09 { OptionsResult =3D ok(OptTable) },
+=09 { getopt__lookup_bool_option(OptTable, help, Help) },
+=09 (
+=09=09{ Help =3D yes },
+=09=09options_help
+=09 ;
+=09=09{ Help =3D no },
+=09=09{ getopt__lookup_string_option(OptTable, host, Host) },
+=09=09{ getopt__lookup_int_option(OptTable, port, Port) },
+=09=09{ getopt__lookup_string_option(OptTable, method, Method) },
+=09=09{ getopt__lookup_string_option(OptTable, uri, URI) },
+=09=09{ getopt__lookup_string_option(OptTable, xml, XML) },
+=09=09(=20
+=09=09 { XML =3D "" }
+=09=09->
+=09=09 (
+=09=09=09{ Method =3D "GetStockPrice" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, int, Int) },
+=09=09=09(
+=09=09=09=09{ Int =3D -1 }
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(Int)], Responses),
+=09=09=09=09display_mercury_response("Stockprice =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;
+=09=09=09{ Method =3D "Hello" }
+=09 =09 ->
+=09=09=09soap_call_mercury_type(Host, Port, Method,
+=09=09=09=09URI, [], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09{ Method =3D "Add3Ints" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, add1, X) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add2, Y) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add3, Z) },
+=09=09=09(
+=09=09=09=09% If some of the arguments are not supplied,=20
+=09=09=09=09% they are treated as 0. Only when all=20
+=09=09=09=09% arguments are not supplied, the program
+=09=09=09=09% terminates.
+=09=09=09=09{ X =3D 0 }, { Y =3D 0 }, { Z =3D 0 }=20
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(X), univ(Y), univ(Z)], =20
+=09=09=09=09 Responses),
+=09=09=09=09display_mercury_response("Add3Ints =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;=09
+=09=09=09{ Method =3D "PurchaseBook" }
+=09=09 ->
+=09=09=09{ getopt__lookup_string_option(OptTable, title, T) },
+=09=09=09{ getopt__lookup_string_option(OptTable, author, A)},
+=09=09=09soap_call_mercury_type(Host, Port, Method, URI,
+=09=09=09=09[univ(T), univ(A)], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09io__write_string("Method not supported.\n"),
+=09=09=09io__write_string("Program terminated.\n")
+=09=09 )
+=09 =09;
+=09 =09 soap_call_xml_type(Host, Port, Method, URI, XML,
+=09=09 =09Responses),
+=09=09 io__write_string(Responses)=20
+=09=09)
+=09 )
+=09;
+ =09 { OptionsResult =3D error(OptionErrorString) },
+=09 io__write_string(OptionErrorString),
+=09 io__nl,
+=09 options_help
+=09).
+
+%-------------------------------------------------------------------------=
--%
+
+:- pred display_mercury_response(string::in, list(univ)::in, io__state::di=
,
+=09io__state::uo) is det.
+
+display_mercury_response(Message, Responses) --> =20
+=09io__write_string(Message),
+=09list__foldl((pred(X::in, di, uo) is det -->=20
+=09=09write(univ_value(X)), nl),=20
+=09=09Responses).
+
+
Index: options.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m=092000/11/27 10:02:58=091.1
+++ options.m=092001/02/21 00:37:57
@@ -26,6 +26,17 @@
=09=09;=09port
=09=09;=09root
=20
+=09% Client options
+=09=09;=09method
+=09=09;=09uri
+=09=09;=09xml
+=09=09;=09int=09=09% for GetStockPrice
+=09=09;=09add1=09=09% for Add3Ints
+=09=09;=09add2=09=09% for Add3Ints
+=09=09;=09add3=09=09% for Add3Ints
+=09=09;=09title=09=09% for PurchaseBook
+=09=09; =09author=09=09% for PurchaseBook
+
=09% Miscellaneous Options
=09=09;=09help.
=20
@@ -63,25 +74,55 @@
option_default(port,=09=09=09int(8080)).
option_default(root,=09=09=09string("/var/www")).
=20
+=09% General client options
+option_default(method, =09=09string("")).
+option_default(uri,=09=09string("no value")).
+=09=09% for uri, empty string means that the intent of the=20
+=09=09% SOAP message is provided by the HTTP Request-URI=20
+=09=09% whereas no value means that there is no indication
+=09=09% of the intent of the message.
+option_default(xml, =09=09string("")).
+option_default(int, =09=09int(-1)).
+option_default(add1,=09=09int(0)).
+option_default(add2,=09=09int(0)).
+option_default(add3,=09=09int(0)).
+option_default(title, =09=09string("")).
+option_default(author,=09=09string("")).
+
=09% Miscellaneous Options
option_default(help,=09=09bool(no)).
=20
=09% please keep this in alphabetic order
+short_option('a', =09=09=09author).
% short_option('f',=09=09=09config_file).
short_option('h', =09=09=09help).
short_option('H', =09=09=09host).
+short_option('i',=09=09=09int).
+short_option('m',=09=09=09method).
short_option('P', =09=09=09port).
short_option('R', =09=09=09root).
+short_option('t', =09=09=09title).
+short_option('u',=09=09=09uri).
short_option('v', =09=09=09verbose).
short_option('V', =09=09=09very_verbose).
+short_option('x', =09=09=09xml).
=20
% long_option("config-file",=09=09config_file).
+long_option("add1", =09=09=09add1).
+long_option("add2", =09=09=09add2).
+long_option("add3", =09=09=09add3).
+long_option("author", =09=09=09author).
long_option("help",=09=09=09help).
long_option("host",=09=09=09host).
+long_option("int", =09=09=09int).
+long_option("method",=09=09=09method).
long_option("port",=09=09=09port).
long_option("root",=09=09=09root).
+long_option("title",=09=09=09title).
+long_option("uri",=09=09=09uri).
long_option("verbose",=09=09=09verbose).
long_option("very-verbose",=09=09very_verbose).
+long_option("xml",=09=09=09xml).
=20
options_help -->
=09io__write_strings([
@@ -99,6 +140,26 @@
=09=09"\t\tWhich port quicksilver listens on.\n",
=09=09"\t-R, --root\n",
=09=09"\t\tThe root directory for the html files to be served.\n",
+
+=09=09"\nClient Options:\n",
+=09=09"\t-m, --method\n",
+=09=09"\t\tMethod Name to be called.\n",
+=09=09"\t-u, --uri\n",
+=09=09"\t\tURI of SOAPAction header.\n",
+=09=09"\t-x, --xml\n",
+=09=09"\t\tAn XML message for the RPC.\n",
+=09=09"\t-i, --int\n",
+=09=09"\t\tStocknum for GetStockPrice.\n",
+=09=09"\t--add1\n",
+=09=09"\t\tFirst integer parameter for Add3Ints.\n",
+=09=09"\t--add2\n",
+=09=09"\t\tSecond integer parameter for Add3Ints.\n",
+=09=09"\t--add3\n",
+=09=09"\t\tThird integer parameter for Add3Ints.\n",
+=09=09"\t-a, --author surname,firstname\n",
+=09=09"\t\tAuthor of the book.\n",
+=09=09"\t-t, --title\n",
+=09=09"\t\tTitle of the book.\n",
=20
=09=09"\nVerbosity Options:\n",
=09=09"\t-v, --verbose\n",
Index: soap_interface.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ soap_interface.m=09Tue Feb 20 16:37:57 2001
@@ -0,0 +1,461 @@
+%-------------------------------------------------------------------------=
--%
+% Copyright (C) 2001 The University of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%-------------------------------------------------------------------------=
--%
+%
+% File: soap_inteface.m=20
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module provide an interface for programmers to send messages
+% to the SOAP server. It will provide as basic functionality the
+% ability to do RPC over SOAP. The hard-coded XML encoding for
+% Mercury datatypes (the same encoding as the SOAP server currently
+% expects) will be used to encode the RPC calls.
+%
+%-------------------------------------------------------------------------=
--%
+
+:- module soap_interface.
+:- interface.
+:- import_module io, list, std_util, string.
+:- import_module tcp.
+
+:- type method =3D=3D string.
+:- type uri =3D=3D string.
+:- type xml =3D=3D string.
+
+=09% Sends messages (in mercury types) to the SOAP server and returns
+=09% the response (in mercury types).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); lists of univ are the input parameters of RPC and
+=09% the output responses from the server.
+ =20
+:- pred soap_call_mercury_type(host::in, port::in, method::in,=20
+=09uri::in, list(univ)::in, list(univ)::out,=20
+=09io__state::di, io__state::uo) is det.
+
+=09% Sends messages (in XML format) to the SOAP server and returns
+=09% the response (in XML format).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); xmls are the message sends to the server and
+=09% the response receives from it.
+
+:- pred soap_call_xml_type(host::in, port::in, method::in, uri::in,=20
+=09xml::in, xml::out, io__state::di, io__state::uo) is det.
+
+
+%-------------------------------------------------------------------------=
--%
+
+:- implementation.
+:- import_module int, require.
+:- import_module stream.
+
+
+soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
+=09Responses) -->=20
+=09(
+=09=09{ Method =3D "GetStockPrice" }
+=09->
+=09 =09{ generate_SP_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }=20
+=09;
+=09=09{ Method =3D "Hello" }
+=09->
+=09=09{ generate_Hello_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "Add3Ints" }
+=09->
+=09=09{ generate_AddInt_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "PurchaseBook" }
+=09->
+=09=09{ generate_PB_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ error("Encode: Method not supported") }
+=09),
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, XMLResponse)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ decode_response(Method, XMLResponse, Responses) }.
+
+
+=09% Translates XML response to Mercury types.
+:- pred decode_response(string::in, string::in, list(univ)::out) is det.
+
+decode_response(Method, XMLResponse, Responses) :- =20
+=09(
+=09=09Method =3D "GetStockPrice"=20
+=09->
+=09=09decode_SP_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Hello"
+=09->
+=09=09decode_Hello_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Add3Ints"
+=09->
+=09=09decode_AddInt_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "PurchaseBook"
+=09->
+=09=09decode_PB_response(XMLResponse, Responses)
+=09;=09
+=09=09error("Decode: Method not supported")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+
+soap_call_xml_type(Host, Port, _Method, SOAPuri, XMLMesg, XMLResponse) -->
+=09{ generate_xml_request(Host, SOAPuri, XMLMesg, Request) },=20
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, Response)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ retrieve_body(Response, XMLResponse) }.
+=09
+
+:- pred generate_xml_request(host::in, uri::in, xml::in, string::out)=20
+=09is det.
+
+generate_xml_request(Host, SOAPuri, XMLMesg, Request) :-=20
+=09generate_xml_body(XMLMesg, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+:- pred generate_xml_body(xml::in, string::out) is det.
+
+generate_xml_body(XMLMesg, SOAPBody) :-
+ =09SOAPBody =3D "<Envelope><Body>" ++ XMLMesg ++ "</Body></Envelope>".
+
+:- pred retrieve_body(string::in, xml::out) is det.
+
+retrieve_body(Response, Body) :-=20
+=09(
+=09=09string__sub_string_search(Response, "\r\n<", Pos)
+=09->
+=09=09string__length(Response, Length),
+=09=09string__right(Response, Length - Pos, Body)=20
+=09;
+=09=09error("error in retrieving body")=20
+=09).
+
+%-------------------------------------------------------------------------=
%=20
+% Hello
+%-------------------------------------------------------------------------=
%=20
+=09
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_Hello_request(host, method, uri, list(univ), string).
+:- mode generate_Hello_request(in, in, in, in, out) is det.
+
+generate_Hello_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_Hello_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),=09
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% Hello pred has no input.
+:- pred generate_Hello_body(string, list(univ), string).
+:- mode generate_Hello_body(in, in, out).
+
+generate_Hello_body(MethodName, _Parameters, Body) :-
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09"</" ++ MethodName ++ "></Body></Envelope>".
+=09=09
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<output>", Start),
+=09=09string__sub_string_search(XMLResponse, "</output>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <output>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09Responses =3D [univ(Response1)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% Add3Ints
+%-------------------------------------------------------------------------=
-%
+
+=09% Generates HTTP header information and SOAP message
+:- pred generate_AddInt_request(host, method, uri, list(univ), string).
+:- mode generate_AddInt_request(in, in, in, in, out) is det.
+
+generate_AddInt_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_AddInt_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+ =09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+
+:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
+=09is det.
+
+generate_AddInt_body(Method, Parameters, Body) :-
+=09list__map(create_xml_parameter, Parameters, XMLList),
+=09string__append_list(XMLList, XMLString),=20
+=09Body =3D "<Envelope><Body><" ++ Method ++ ">" ++ XMLString ++
+=09=09"</" ++ Method ++ "></Body></Envelope>".
+
+:- pred create_xml_parameter(univ::in, string::out) is det.
+
+create_xml_parameter(ParameterAsUniv, ParameterAsXML) :-
+=09det_univ_to_type(ParameterAsUniv, ParameterAsInt),
+=09string__int_to_string(ParameterAsInt, ParameterAsString),
+=09ParameterAsXML =3D "<int>" ++ ParameterAsString ++ "</int>".
+
+:- pred decode_AddInt_response(string::in, list(univ)::out) is det.
+
+decode_AddInt_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<result>", Start),
+=09=09string__sub_string_search(XMLResponse, "</result>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <result>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Responses =3D [univ(ResponseAsInt)]
+=09=09;
+=09=09 error("decode error")
+=09=09)
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% GetStockPrice
+%-------------------------------------------------------------------------=
-%
+
+=09% Assume library file to be loaded in server is
+=09% libsoap_test_methods.so
+=09% client shouldn't need to know the library file name?
+
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_SP_request(host, method, uri, list(univ), string).
+:- mode generate_SP_request(in, in, in, in, out) is det.
+
+generate_SP_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_SP_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% XXX=09assume no namespace and client has a copy of the schema
+=09% =09used in the server side to encode mercury types.
+:- pred generate_SP_body(method, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+=09% schema for GetStockPrice:
+ % <element name=3D"stocknum" type=3D"xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+=09% since client knows that this function takes in only
+=09% one parameter, there is no need to call list_foldl to
+=09% translate the parameters.
+=09list__index1_det(Parameters, 1, Parameter),
+=09generate_SP_param(Parameter, ParamAsString),
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09ParamAsString ++ "</" ++ MethodName ++
+=09=09"></Body></Envelope>".
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :- =20
+=09det_univ_to_type(ParamAsUniv, ParamAsValue),=09
+=09string__int_to_string(ParamAsValue, ParamAsString),
+=09Tag =3D "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<price>", Start),
+=09=09string__sub_string_search(XMLResponse, "</price>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 7,=09=09% <price>
+=09=09string__right(Response0, End - Start - TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Response =3D ResponseAsInt
+=09=09;
+=09=09 error("decode error")
+=09=09),
+=09=09Responses =3D [univ(Response)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
%
+% PurchaseBook
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header information and SOAP message.=20
+:- pred generate_PB_request(host, method, uri, list(univ), string).
+:- mode generate_PB_request(in, in, in, in, out) is det.
+
+generate_PB_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_PB_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+:- pred generate_PB_body(method::in, list(univ)::in, string::out) is det.
+generate_PB_body(Method, Parameters, Body) :-
+=09generate_PB_parameters(Parameters, ParameterString),
+=09Body =3D "<Envelope><Body><" ++ Method ++ "><book>" ++=20
+=09=09ParameterString ++ "</book></" ++ Method ++=20
+=09=09"></Body></Envelope>".
+
+:- pred generate_PB_parameters(list(univ)::in, string::out) is det.
+
+generate_PB_parameters(ParamList, Body):-
+=09list__index1_det(ParamList, 1, TitleAsUniv),
+=09det_univ_to_type(TitleAsUniv, TitleAsString),
+=09Title =3D "<title>" ++ TitleAsString ++ "</title>",
+=09
+=09list__index1_det(ParamList, 2, AuthorAsUniv),
+=09det_univ_to_type(AuthorAsUniv, AuthorAsString),
+=09(
+=09=09string__sub_string_search(AuthorAsString, ",", Pos)
+=09->
+=09=09string__left(AuthorAsString, Pos, Surname),
+=09=09string__length(AuthorAsString, Length),
+=09=09string__right(AuthorAsString, Length - (Pos + 1), Firstname)
+=09;
+=09=09Surname =3D AuthorAsString,
+=09=09Firstname =3D " "
+=09),=09
+=09Author =3D "<author>" ++=20
+=09=09 "<surname>" ++ Surname ++ "</surname>" ++
+=09=09 "<firstname>" ++ Firstname ++ "</firstname>" ++
+=09=09 "</author>",
+=09Body =3D Title ++ Author.
+
+:- pred decode_PB_response(string::in, list(univ)::out) is det.
+
+decode_PB_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<comment>", Start),
+=09=09string__sub_string_search(XMLResponse, "</comment>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Comment0),
+=09=09TagLength =3D 9,=09=09% <comment>
+=09=09string__right(Comment0, End - Start - TagLength, Comment1),
+=09=09Comment =3D [univ(Comment1)]
+=09;
+=09=09Comment =3D []
+=09),
+=09(
+=09 string__sub_string_search(XMLResponse, "<price>", Start1),
+=09 string__sub_string_search(XMLResponse, "</price>", End1)
+=09->
+=09 string__left(XMLResponse, End1, Price0),
+=09 TagLength1 =3D 7,=09=09% <price>
+=09 string__right(Price0, End1 - Start1 - TagLength1, Price1),
+=09 Price =3D [univ("Price =3D " ++ Price1)]
+=09;
+=09 Price =3D []
+=09),
+=09list__append(Comment, Price, Responses).
+
+=09
+%-------------------------------------------------------------------------=
%
+% Shared functions
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header.
+:- pred generate_header(host::in, int::in, uri::in, string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+=09Header1 =3D "POST /libsoap_test_methods.so HTTP/1.1",
+=09Header2 =3D "Host: " ++ Host,
+=09Header3 =3D "Content-Type: text/xml",=20
+=09string__int_to_string(Length, LengthAsString),
+=09Header4 =3D "Content-Length: " ++ LengthAsString,
+=09(
+=09=09SOAPuri =3D "no value"
+=09->
+=09=09Header5 =3D "SOAPAction:"=20
+=09;
+=09=09Header5 =3D "SOAPAction: " ++ SOAPuri
+=09),
+=09Headers =3D insert_cr(Header1) ++ insert_cr(Header2) ++
+=09=09 insert_cr(Header3) ++ insert_cr(Header4) ++
+=09=09 insert_cr(Header5).
+
+=09% Insert carriage return into the line.
+:- func insert_cr(string) =3D string.
+insert_cr(Line) =3D Line ++ "\r\n".=20
+
+%------------------------------------------------------------------------%
+=09
+=09% Sends request to server using HTTP and receives response=20
+=09% from server.=20
+:- pred service_connection(tcp::in, string::in, string::out,=20
+=09io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+=09send_request(TCP, Request),
+=09read_response(TCP, Response).
+
+=09% Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <=3D stream__output(=
S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+=09stream__write_string(S, Requests).
+
+=09% Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <=3D stream__input(=
S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+=09stream__read_line(S, LineResult),
+=09(
+=09=09{ LineResult =3D ok(Line) },
+=09=09{ string__from_char_list(Line, String) },
+=09=09{ Response =3D String ++ Response0 },
+=09=09read_response(S, Response0)
+=09;
+=09=09{ LineResult =3D eof },
+=09=09{ Response =3D "" }
+=09;
+=09=09{ LineResult =3D error(Error) },
+=09=09{ error(string__format("read_response: %s.", [s(Error)])) }
+=09).
+=09=09
+%-------------------------------------------------------------------------=
%
+
Index: soap_test_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.2
diff -u -r1.2 soap_test_methods.m
--- soap_test_methods.m=092001/02/09 05:15:42=091.2
+++ soap_test_methods.m=092001/02/21 00:37:57
@@ -23,20 +23,27 @@
:- interface.
:- import_module list, std_util.
=20
+ =09% Trivial testing predicate - print out "Hello world".
:- pred hello(univ::out) is det.
=20
+=09% Given a stock number, return its price.=20
:- pred get_sp(list(univ)::in, univ::out) is det.
=20
:- func get_stockprice(list(univ)) =3D univ.
=20
-% :- pred get_bookprice(book::in, univ::out) is det.
-:- pred get_bookprice(list(univ)::in, univ::out) is det.
+=09% Adding 3 integers.
+:- func add3Ints(list(univ)) =3D univ.
=20
+=09% Place a purchase order for a specific book.
+:- pred purchase_book(list(univ)::in, univ::out) is det.
+
+:- pred sum_list(list(univ)::in, univ::out) is det.
+
:- type book
=09--->=09book(
=09=09=09title :: string,
-=09=09=09author :: author,
-=09=09=09intro :: string
+=09=09=09author :: author
+=09=09=09% intro :: string
=09=09).
=09
:- type author
@@ -69,6 +76,20 @@
=09ResultAsUniv =3D univ("<output>Hello, world</output>").
=20
%---------------------------------------------------------------------%
+% Add3Ints
+%---------------------------------------------------------------------%
+
+add3Ints(ParamList) =3D Result :-
+=09list__index1_det(ParamList, 1, XAsUniv),
+=09list__index1_det(ParamList, 2, YAsUniv),
+=09list__index1_det(ParamList, 3, ZAsUniv),
+=09det_univ_to_type(XAsUniv, X),=20
+=09det_univ_to_type(YAsUniv, Y),=20
+=09det_univ_to_type(ZAsUniv, Z),=20
+=09ResultAsUniv =3D X + Y + Z,
+=09Result =3D univ(ResultAsUniv).
+
+%---------------------------------------------------------------------%
% GetStockPrice=20
%---------------------------------------------------------------------%
=20
@@ -100,24 +121,47 @@
=09).
=20
%---------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%---------------------------------------------------------------------%
=20
-get_bookprice(ParamList, ResultAsUniv) :-=20
+purchase_book(ParamList, ResultAsUniv) :-=20
=09list__index1_det(ParamList, 1, ParamAsUniv),
=09Param0 =3D univ_value(ParamAsUniv),
=09Param =3D inst_cast_book(Param0),=20
=09(
-=09=09Param =3D book("Hello world",=20
-=09=09=09=09author("Foo", "Bar"),=20
-=09=09=09=09"This is a book")=20
+=09=09Param =3D book("Hello world", =20
+=09=09=09=09author("Foo", "Bar"))
+=09=09=09=09% "This is a book")=20
=09->
=09=09ResultAsUniv =3D univ(100)
=09;
-=09=09ResultAsUniv =3D univ(50)
+=09=09ResultAsUniv =3D univ(0)
=09).
=20
:- func inst_cast_book(T) =3D book.
:- mode inst_cast_book(in) =3D out is det.
:- pragma c_code(inst_cast_book(X::in) =3D (Y::out),
[will_not_call_mercury, thread_safe], "Y =3D X").
+
+%---------------------------------------------------------------------%
+% SumList
+%---------------------------------------------------------------------%
+
+sum_list(ParamList, ResultAsUniv) :-
+=09list__index1_det(ParamList, 1, ParamAsUniv),
+=09Param0 =3D univ_value(ParamAsUniv),
+=09Param =3D inst_cast_list(Param0),=20
+=09sumlist(Param, 0, Sum),
+=09ResultAsUniv =3D univ(Sum).
+
+:- pred sumlist(list(int)::in, int::in, int::out) is det.
+sumlist([], Acc, Acc).=20
+sumlist([H|T], Acc0, Acc) :-
+=09sumlist(T, Acc0, Acc1),=20
+=09Acc =3D Acc1 + H.
+
+:- func inst_cast_list(T) =3D list(int).
+:- mode inst_cast_list(in) =3D out is det.
+:- pragma c_code(inst_cast_list(X::in) =3D (Y::out),
+ [will_not_call_mercury, thread_safe], "Y =3D X").
+
Index: web_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.2
diff -u -r1.2 web_methods.m
--- web_methods.m=092001/02/09 05:15:42=091.2
+++ web_methods.m=092001/02/21 00:37:57
@@ -132,12 +132,23 @@
=09=09=09call_SP_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)=20
=09=09;
-=09=09=09% GetBookPrice takes in a struct
-=09=09=09{ Request^name =3D "GetBookPrice" }
+=09=09=09% Add3Ints has 3 parameters
+=09=09=09{ Request^name =3D "Add3Ints" }
=09=09->
-=09=09=09call_BP_pred(Handle, Filename, Request,=20
+=09=09=09call_AI_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)
=09=09;
+=09=09=09% PurchaseBook takes in a struct
+=09=09=09{ Request^name =3D "PurchaseBook" }
+=09=09->
+=09=09=09call_PB_pred(Handle, Filename, Request,=20
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
+=09=09=09{ Request^name =3D "Sumlist" }
+=09=09->
+=09=09=09call_list_pred(Handle, Filename, Request,
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
=09=09=09{ Response0 =3D "Method requested not implemented." },=20
=09=09=09{ ErrorFlag0 =3D yes },
=09=09=09{ HttpCode0 =3D 501 }=09% 501 Not Implemented
@@ -227,6 +238,62 @@
[will_not_call_mercury, thread_safe], "Y =3D X").
=20
%-----------------------------------------------------------------------%
+% Add3Ints=20
+%-----------------------------------------------------------------------%
+
+:- pred call_AI_func(handle, string, web_method_request,=20
+=09string, http_code, bool, io__state, io__state).
+:- mode call_AI_func(in, in, in, out, out, out, di, uo) is det.
+
+call_AI_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ AIProc =3D mercury_proc(function, unqualified(Filename),
+=09=09=09=09"add3Ints", 1, 0) },
+=09dl__mercury_sym(Handle, AIProc, MaybeAddInts),
+=09(
+=09=09{ MaybeAddInts =3D error(Msg) },
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }=20
+=09;
+=09=09{ MaybeAddInts =3D ok(AIFunc0) },
+=09=09{ wrapper(AIFunc) =3D inst_cast_addInts(wrapper(AIFunc0)) },
+=09=09{ list__map(lookup_AI_schema, Request^params, UnivList) },
+=09=09{ ResultAsUniv =3D AIFunc(UnivList) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<result>" ++ ResultAsString ++ "</result>" },
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
+
+=09% schema=20
+=09% <element name=3D"int" type=3D"xsd:int">
+
+:- pred lookup_AI_schema(parameter::in, univ::out) is det.
+lookup_AI_schema(Param, ValueAsUniv) :-
+=09(
+=09=09Param^pName =3D "int",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09 =09type_cast_parameter("int", Value, ValueAsUniv)
+=09;
+=09=09string__append("Element Name not defined in schema: ",=20
+=09=09=09=09Param^pName, ErrorMsg),
+=09=09require__error(ErrorMsg)
+=09).
+
+=09% inst cast for add3Ints (function)
+:- type addInts =3D=3D (func(list(univ)) =3D univ ).
+:- type addInts_wrapper ---> wrapper(addInts).
+:- inst addInts_wrapper ---> wrapper(func(in) =3D out is det).
+
+:- func inst_cast_addInts(addInts_wrapper) =3D addInts_wrapper.
+:- mode inst_cast_addInts(in) =3D out(addInts_wrapper) is det.
+:- pragma c_code(inst_cast_addInts(X::in) =3D (Y::out(addInts_wrapper)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
% GetStockPrice=20
%-----------------------------------------------------------------------%
=20
@@ -341,7 +408,7 @@
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%-----------------------------------------------------------------------%
=20
/* see Section 3.4 Complex Type Definition Details=20
@@ -359,7 +426,7 @@
schema components across namespaces (=A76.2.3) for the use of component=20
identifiers when importing one schema into another.
*/
-=09% schema for GetBookPrice:
+=09% schema for PurchaseBook:
=09%
=09% <element name=3D"book" type=3D"tns:book"/>
=09% <element name=3D"author" base=3D"tns:author"/>
@@ -368,7 +435,7 @@
=09% <sequence>
=09% <element name=3D"title" type=3D"xsd:string"/>
=09% <element name=3D"author" type=3D"tns:author"/>
-=09% <element name=3D"intro" type=3D"xsd:string"/>
+=09% % <element name=3D"intro" type=3D"xsd:string"/>
=09% </sequence>
=09% </complexType>
=09% =20
@@ -385,7 +452,7 @@
=09%=09--->=09book(
=09%=09=09=09title =09:: string,
=09%=09=09=09author =09:: author,
-=09%=09=09=09intro=09:: string
+=09%=09=09%=09intro=09:: string
=09%=09=09).
=09%=09
=09% :- type author
@@ -394,64 +461,71 @@
=09%=09=09=09firstname :: string
=09%=09=09).
=20
-:- pred call_BP_pred(handle, string, web_method_request,
+:- pred call_PB_pred(handle, string, web_method_request,
=09string, http_code, bool, io__state, io__state).
-:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det.
+:- mode call_PB_pred(in, in, in, out, out, out, di, uo) is det.
=20
-call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
-=09{ GetBPProc =3D mercury_proc(predicate, unqualified(Filename),
-=09=09=09"get_bookprice", 2, 0) },=20
-=09dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
+call_PB_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ GetPBProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"purchase_book", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetPBProc, MaybePurchaseBook),
=09(
-=09=09{ MaybeGetBookPrice =3D error(Msg) },=20
+=09=09{ MaybePurchaseBook =3D error(Msg) },=20
=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
=09=09{ Response =3D ErrorMsg },
=09=09{ ErrorFlag =3D yes },
=09=09{ HttpCode =3D 500 }
=09;
-=09=09{ MaybeGetBookPrice =3D ok(BPProc0) },=20
+=09=09{ MaybePurchaseBook =3D ok(PBProc0) },=20
=20
=09=09% Cast the higher-order term that we obtained
=09=09% to the correct higher-order inst.
-=09=09{ BPProc =3D inst_cast_bp(BPProc0) },
+=09=09{ PBProc =3D inst_cast_pb(PBProc0) },
=20
=09=09% Convert parameters (string) to the corresponding types
-=09=09{ list__map(lookup_BP_schema, Request^params, UnivList) },
+=09=09{ list__map(lookup_PB_schema, Request^params, UnivList) },
=09=09
=09=09% Call the procedure whose address we just obtained
-=09=09{ call(BPProc, UnivList, BPUniv) },
+=09=09{ call(PBProc, UnivList, PBUniv) },
=20
-=09=09{ det_univ_to_type(BPUniv, BPInt) },=09
-=09=09{ string__int_to_string(BPInt, BPString) },
-
-=09=09{ string__append("<price>", BPString, BPresult0) },
-=09=09{ string__append(BPresult0, "</price>", BPresult) },
-=09=09{ Response =3D BPresult },
+=09=09{ det_univ_to_type(PBUniv, PBInt) },=09
+=09=09(=20
+=09=09 =09{ PBInt \=3D 0 }
+=09=09->
+=09=09=09{ string__int_to_string(PBInt, PBString) },
+=09=09=09{ Response =3D "<comment>Purchase order placed " ++
+=09=09=09=09 =09"successfully</comment>\n<price>" ++
+=09=09=09=09=09PBString ++ "</price>" }
+=09=09;
+=09=09=09{ Response =3D "<comment>No such book. Purchase " ++
+=09=09=09=09=09"order not placed.</comment>" }=09
+=09=09),
=09=09{ ErrorFlag =3D no },
=09=09{ HttpCode =3D 200 }
=09).
=20
=20
-:- pred lookup_BP_schema(parameter::in, univ::out) is det.
+:- pred lookup_PB_schema(parameter::in, univ::out) is det.
=20
-lookup_BP_schema(Param, ValueAsUniv) :- =20
+lookup_PB_schema(Param, ValueAsUniv) :- =20
=09(
=09=09Param^pName =3D "book",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "title", Title0),
-=09=09lookup_BP_schema(Title0, TitleAsUniv),
+=09=09get_PB_param(FieldList, "title", Title0),
+=09=09lookup_PB_schema(Title0, TitleAsUniv),
=09=09det_univ_to_type(TitleAsUniv, Title),
=20
-=09=09get_BP_param(FieldList, "author", Author0),
-=09=09lookup_BP_schema(Author0, AuthorAsUniv),
+=09=09get_PB_param(FieldList, "author", Author0),
+=09=09lookup_PB_schema(Author0, AuthorAsUniv),
=09=09det_univ_to_type(AuthorAsUniv, Author),
=09
-=09=09get_BP_param(FieldList, "intro", Intro0),
-=09=09lookup_BP_schema(Intro0, IntroAsUniv),
-=09=09det_univ_to_type(IntroAsUniv, Intro),
+=09=09% get_PB_param(FieldList, "intro", Intro0),
+=09=09% lookup_PB_schema(Intro0, IntroAsUniv),
+=09=09% det_univ_to_type(IntroAsUniv, Intro),
=20
-=09=09ValueAsBook =3D book(Title, Author, Intro),
+=09=09% ValueAsBook =3D book(Title, Author, Intro),
+=09=09ValueAsBook =3D book(Title, Author),
=09=09ValueAsUniv =3D univ(ValueAsBook)
=09;=09
=09=09Param^pName =3D "title",
@@ -462,12 +536,12 @@
=09=09Param^pName =3D "author",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "surname", Surname0),
-=09=09lookup_BP_schema(Surname0, SurnameAsUniv),
+=09=09get_PB_param(FieldList, "surname", Surname0),
+=09=09lookup_PB_schema(Surname0, SurnameAsUniv),
=09=09det_univ_to_type(SurnameAsUniv, Surname),
=20
-=09=09get_BP_param(FieldList, "firstname", Firstname0),
-=09=09lookup_BP_schema(Firstname0, FirstnameAsUniv),
+=09=09get_PB_param(FieldList, "firstname", Firstname0),
+=09=09lookup_PB_schema(Firstname0, FirstnameAsUniv),
=09=09det_univ_to_type(FirstnameAsUniv, Firstname),
=20
=09=09ValueAsAuthor =3D author(Surname, Firstname),
@@ -491,21 +565,154 @@
=09=09require__error("Element Structure not defined in schema.")
=09).
=20
-:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is d=
et.
+:- pred get_PB_param(list(parameter)::in, string::in, parameter::out) is d=
et.
=20
-get_BP_param(ParamList, SearchString, Parameter) :-
+get_PB_param(ParamList, SearchString, Parameter) :-
=09list__filter((pred(X::in) is semidet :-
=09=09X =3D parameter(SearchString,_,_,_,_)), ParamList, Result),
=09list__index1_det(Result, 1, Parameter).=09
+
+=09% inst cast for purchase_book
+:- type pb_pred =3D=3D pred(list(univ), univ).
+% :- type pb_pred =3D=3D pred(book, univ).
+:- inst pb_pred =3D=3D (pred(in, out) is det).
+=20
+:- func inst_cast_pb(pb_pred) =3D pb_pred.
+:- mode inst_cast_pb(in) =3D out(pb_pred) is det.
+:- pragma c_code(inst_cast_pb(X::in) =3D (Y::out(pb_pred)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
+% Sumlist=20
+%-----------------------------------------------------------------------%
+
+/*
+schema:
+ <element name=3D"list" type=3D"tns:list"/>
+ <element name=3D"nil" type=3D"tns:nil"/>
+ <element name=3D"cons" type=3D"tns:cons"/>
+
+ <complexType name=3D"list">
+ <sequence>
+ <choice>
+ <element name=3D"nil" type=3D"tns:nil"/>
+ <element name=3D"cons" type=3D"tns:cons"/>
+ </choice>
+ </sequence>
+ </complexType>
+
+ <complexType name=3D"nil>
+ <complexContent>
+ <restriction base=3D"xsd:anyType">
+ </restriction>
+ </complexContent>
+ </complexType>
+ =20
+ or <complexType name=3D"nil"> shorthand for complex content
+ </complexType> that restricts anyType
+
+ <complexType name=3D"cons">
+ <sequence>
+ <element name=3D"head" type=3D"xsd:anyType">
+ <element name=3D"tail" type=3D"tns:list"/>
+ </sequence>
+ </complexType>
+*/
+
+:- pred call_list_pred(handle, string, web_method_request,
+=09string, http_code, bool, io__state, io__state).
+:- mode call_list_pred(in, in, in, out, out, out, di, uo) is det.
+
+call_list_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -=
->
+=09{ GetListProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"sum_list", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetListProc, MaybeListProc),
+=09(
+=09=09{ MaybeListProc =3D error(Msg) },=20
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }
+=09;
+=09=09{ MaybeListProc =3D ok(ListProc0) },=20
+
+=09=09{ ListProc =3D inst_cast_list(ListProc0) },
+=09=09% parse the parameters to obtain a list of string
+=09=09{ list__foldl(retrieve_list, Request^params, [], StringList) },
+=09=09% cast the list of string to list of int
+=09=09{ type_cast_list("int", StringList, UnivList) },=09
+=09=09{ call(ListProc, [UnivList], ResultAsUniv) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<sum>" ++ ResultAsString ++ "</sum>" },=20
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
=20
-=09% inst cast for get_bookprice=20
-:- type bp_pred =3D=3D pred(list(univ), univ).
-% :- type bp_pred =3D=3D pred(book, univ).
-:- inst bp_pred =3D=3D (pred(in, out) is det).
+:- pred retrieve_list(parameter::in, list(string)::in, list(string)::out)=
=20
+=09is det.
+
+retrieve_list(Param, Acc0, Acc) :- =20
+=09(
+=09=09Param^pName =3D "list",
+=09=09Param^pFields =3D yes(Nil),
+=09=09Nil =3D [parameter("nil", no, "", no, yes([]))]
+=09->
+=09=09Acc =3D Acc0
+=09;
+=09=09Param^pName =3D "list",
+=09=09Param^pFields =3D yes(Cons)
+=09->
+=09=09list__foldl(retrieve_list, Cons, Acc0, Acc1),
+=09=09Acc =3D Acc1 =20
+=09;
+=09=09Param^pName =3D "cons",
+=09=09Param^pFields =3D yes(Head_Tail)
+=09->
+=09=09list__foldl(retrieve_list, Head_Tail, Acc0, Acc)
+=09;
+=09=09Param^pName =3D "head",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09=09list__reverse(Acc0, RevAcc0),
+=09=09RevAcc =3D [ Value | RevAcc0 ],
+=09=09list__reverse(RevAcc, Acc)
+=09;
+=09=09Param^pName =3D "tail",
+=09=09Param^pFields =3D yes(Tail)
+=09->
+=09=09list__foldl(retrieve_list, Tail, Acc0, Acc)
+=09;
+=09=09error("decode list error")
+=09).
+
+:- pred type_cast_list(string::in, list(string)::in, univ::out) is det.
+type_cast_list(Type, List, UnivList) :- =20
+ =09(
+ =09=09Type =3D "int",
+=09=09list__map(string__to_int, List, ListAsInt)
+ =09->
+=09=09UnivList =3D univ(ListAsInt)
+ =09;
+=09=09Type =3D "float",
+=09=09list__map(string__to_float, List, ListAsFloat)
+=09->
+=09=09UnivList =3D univ(ListAsFloat)
+=09;
+=09=09Type =3D "string"
+=09->
+=09=09UnivList =3D univ(List)
+=09;
+ =09=09require__error("Type cast list failed")
+ =09).
+=09=09=09 =09=09
+=09% inst cast for list=20
+:- type list_pred =3D=3D pred(list(univ), univ).
+:- inst list_pred =3D=3D (pred(in, out) is det).
=20
-:- func inst_cast_bp(bp_pred) =3D bp_pred.
-:- mode inst_cast_bp(in) =3D out(bp_pred) is det.
-:- pragma c_code(inst_cast_bp(X::in) =3D (Y::out(bp_pred)),
+:- func inst_cast_list(list_pred) =3D list_pred.
+:- mode inst_cast_list(in) =3D out(list_pred) is det.
+:- pragma c_code(inst_cast_list(X::in) =3D (Y::out(list_pred)),
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
|
|
From: Ina C. <in...@st...> - 2001-02-19 00:31:10
|
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=20
Estimated hours taken: 30=20
Add an interface between server and client such that the client
can send messages in mercury types to the server.
=20
/server/client_demo.m
new module showing how to call the soap_interface to send
messages to the SOAP server.
/server/options.m
add new options to handle command line arguments.
/server/soap_interface.m
new module - provide an interface for programmers to send messages
to the SOAP server.
/server/soap_test_methods.m
/server/web_methods.m
=09add a function to demonstrate the soap interface
Index: client_demo.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ client_demo.m=09Sun Feb 18 16:23:17 2001
@@ -0,0 +1,130 @@
+%-------------------------------------------------------------------------=
--%
+% Copyright (C) 2001 The University Of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%-------------------------------------------------------------------------=
--%
+%
+% File: client_demo.m
+% Author: inch
+%
+% This module provide a sample of how to call the SOAP interface to send
+% messages from the client to the SOAP server.
+%
+%-------------------------------------------------------------------------=
--%
+
+:- module client_demo.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+%-------------------------------------------------------------------------=
--%
+
+:- implementation.
+:- import_module http, options.
+
+:- import_module bool, char, exception, getopt.
+:- import_module int, list, require, std_util, string.
+
+:- import_module soap_interface.
+
+main -->
+=09io__command_line_arguments(Args0),
+=09{ OptionOpts =3D option_ops(short_option, long_option, option_defaults)=
},
+=09{ getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+=09(
+=09 { OptionsResult =3D ok(OptTable) },
+=09 { getopt__lookup_bool_option(OptTable, help, Help) },
+=09 (
+=09=09{ Help =3D yes },
+=09=09options_help
+=09 ;
+=09=09{ Help =3D no },
+=09=09{ getopt__lookup_string_option(OptTable, host, Host) },
+=09=09{ getopt__lookup_int_option(OptTable, port, Port) },
+=09=09{ getopt__lookup_string_option(OptTable, method, Method) },
+=09=09{ getopt__lookup_string_option(OptTable, uri, URI) },
+=09=09{ getopt__lookup_string_option(OptTable, xml, XML) },
+=09=09(=20
+=09=09 { XML =3D "" }
+=09=09->
+=09=09 (
+=09=09=09{ Method =3D "GetStockPrice" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, int, Int) },
+=09=09=09(
+=09=09=09=09{ Int =3D -1 }
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(Int)], Responses),
+=09=09=09=09display_mercury_response("Stockprice =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;
+=09=09=09{ Method =3D "Hello" }
+=09 =09 ->
+=09=09=09soap_call_mercury_type(Host, Port, Method,
+=09=09=09=09URI, [], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09{ Method =3D "Add3Ints" }
+=09=09 ->
+=09=09=09{ getopt__lookup_int_option(OptTable, add1, X) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add2, Y) },
+=09=09=09{ getopt__lookup_int_option(OptTable, add3, Z) },
+=09=09=09(
+=09=09=09=09% If some of the arguments are not supplied,=20
+=09=09=09=09% they are treated as 0. Only when all=20
+=09=09=09=09% arguments are not supplied, the program
+=09=09=09=09% terminates.
+=09=09=09=09{ X =3D 0 }, { Y =3D 0 }, { Z =3D 0 }=20
+=09=09=09->
+=09=09=09=09io__write_string("Parameter not supplied.\n"),
+=09=09=09=09io__write_string("Program terminated.\n")
+=09=09=09;
+=09=09=09=09soap_call_mercury_type(Host, Port, Method,=20
+=09=09=09=09 URI, [univ(X), univ(Y), univ(Z)], =20
+=09=09=09=09 Responses),
+=09=09=09=09display_mercury_response("Add3Ints =3D ",=20
+=09=09=09=09=09Responses)
+=09=09=09)
+=09=09 ;=09
+=09=09=09{ Method =3D "PurchaseBook" }
+=09=09 ->
+=09=09=09{ getopt__lookup_string_option(OptTable, title, T) },
+=09=09=09{ getopt__lookup_string_option(OptTable, author, A)},
+=09=09=09soap_call_mercury_type(Host, Port, Method, URI,
+=09=09=09=09[univ(T), univ(A)], Responses),
+=09=09=09display_mercury_response("", Responses)
+=09=09 ;
+=09=09=09io__write_string("Method not supported.\n"),
+=09=09=09io__write_string("Program terminated.\n")
+=09=09 )
+=09 =09;
+=09 =09 soap_call_xml_type(Host, Port, Method, URI, XML,
+=09=09 =09Responses),
+=09=09 io__write_string(Responses)=20
+=09=09)
+=09 )
+=09;
+ =09 { OptionsResult =3D error(OptionErrorString) },
+=09 io__write_string(OptionErrorString),
+=09 io__nl,
+=09 options_help
+=09).
+
+%-------------------------------------------------------------------------=
--%
+
+:- pred display_mercury_response(string::in, list(univ)::in, io__state::di=
,
+=09io__state::uo) is det.
+
+display_mercury_response(Message, Responses) --> =20
+=09io__write_string(Message),
+=09list__foldl((pred(X::in, di, uo) is det -->=20
+=09=09write(univ_value(X)), nl),=20
+=09=09Responses).
+
+
Index: options.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m=092000/11/27 10:02:58=091.1
+++ options.m=092001/02/19 00:23:17
@@ -26,6 +26,17 @@
=09=09;=09port
=09=09;=09root
=20
+=09% Client options
+=09=09;=09method
+=09=09;=09uri
+=09=09;=09xml
+=09=09;=09int=09=09% for GetStockPrice
+=09=09;=09add1=09=09% for Add3Ints
+=09=09;=09add2=09=09% for Add3Ints
+=09=09;=09add3=09=09% for Add3Ints
+=09=09;=09title=09=09% for PurchaseBook
+=09=09; =09author=09=09% for PurchaseBook
+
=09% Miscellaneous Options
=09=09;=09help.
=20
@@ -63,25 +74,55 @@
option_default(port,=09=09=09int(8080)).
option_default(root,=09=09=09string("/var/www")).
=20
+=09% General client options
+option_default(method, =09=09string("")).
+option_default(uri,=09=09string("no value")).
+=09=09% for uri, empty string means that the intent of the=20
+=09=09% SOAP message is provided by the HTTP Request-URI=20
+=09=09% whereas no value means that there is no indication
+=09=09% of the intent of the message.
+option_default(xml, =09=09string("")).
+option_default(int, =09=09int(-1)).
+option_default(add1,=09=09int(0)).
+option_default(add2,=09=09int(0)).
+option_default(add3,=09=09int(0)).
+option_default(title, =09=09string("")).
+option_default(author,=09=09string("")).
+
=09% Miscellaneous Options
option_default(help,=09=09bool(no)).
=20
=09% please keep this in alphabetic order
+short_option('a', =09=09=09author).
% short_option('f',=09=09=09config_file).
short_option('h', =09=09=09help).
short_option('H', =09=09=09host).
+short_option('i',=09=09=09int).
+short_option('m',=09=09=09method).
short_option('P', =09=09=09port).
short_option('R', =09=09=09root).
+short_option('t', =09=09=09title).
+short_option('u',=09=09=09uri).
short_option('v', =09=09=09verbose).
short_option('V', =09=09=09very_verbose).
+short_option('x', =09=09=09xml).
=20
% long_option("config-file",=09=09config_file).
+long_option("add1", =09=09=09add1).
+long_option("add2", =09=09=09add2).
+long_option("add3", =09=09=09add3).
+long_option("author", =09=09=09author).
long_option("help",=09=09=09help).
long_option("host",=09=09=09host).
+long_option("int", =09=09=09int).
+long_option("method",=09=09=09method).
long_option("port",=09=09=09port).
long_option("root",=09=09=09root).
+long_option("title",=09=09=09title).
+long_option("uri",=09=09=09uri).
long_option("verbose",=09=09=09verbose).
long_option("very-verbose",=09=09very_verbose).
+long_option("xml",=09=09=09xml).
=20
options_help -->
=09io__write_strings([
@@ -99,6 +140,26 @@
=09=09"\t\tWhich port quicksilver listens on.\n",
=09=09"\t-R, --root\n",
=09=09"\t\tThe root directory for the html files to be served.\n",
+
+=09=09"\nClient Options:\n",
+=09=09"\t-m, --method\n",
+=09=09"\t\tMethod Name to be called.\n",
+=09=09"\t-u, --uri\n",
+=09=09"\t\tURI of SOAPAction header.\n",
+=09=09"\t-x, --xml\n",
+=09=09"\t\tAn XML message for the RPC.\n",
+=09=09"\t-i, --int\n",
+=09=09"\t\tStocknum for GetStockPrice.\n",
+=09=09"\t--add1\n",
+=09=09"\t\tFirst integer parameter for Add3Ints.\n",
+=09=09"\t--add2\n",
+=09=09"\t\tSecond integer parameter for Add3Ints.\n",
+=09=09"\t--add3\n",
+=09=09"\t\tThird integer parameter for Add3Ints.\n",
+=09=09"\t-a, --author surname,firstname\n",
+=09=09"\t\tAuthor of the book.\n",
+=09=09"\t-t, --title\n",
+=09=09"\t\tTitle of the book.\n",
=20
=09=09"\nVerbosity Options:\n",
=09=09"\t-v, --verbose\n",
Index: soap_interface.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null=09Mon Dec 11 17:26:27 2000
+++ soap_interface.m=09Sun Feb 18 16:23:17 2001
@@ -0,0 +1,461 @@
+%-------------------------------------------------------------------------=
--%
+% Copyright (C) 2001 The University of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%-------------------------------------------------------------------------=
--%
+%
+% File: soap_inteface.m=20
+% Author: inch
+%
+% Reference:
+% http://www.w3.org/TR/SOAP
+%
+% This module provide an interface for programmers to send messages
+% to the SOAP server. It will provide as basic functionality the
+% ability to do RPC over SOAP. The hard-coded XML encoding for
+% Mercury datatypes (the same encoding as the SOAP server currently
+% expects) will be used to encode the RPC calls.
+%
+%-------------------------------------------------------------------------=
--%
+
+:- module soap_interface.
+:- interface.
+:- import_module io, list, std_util, string.
+:- import_module tcp.
+
+:- type method =3D=3D string.
+:- type uri =3D=3D string.
+:- type xml =3D=3D string.
+
+=09% Sends messages (in mercury types) to the SOAP server and returns
+=09% the response (in mercury types).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); lists of univ are the input parameters of RPC and
+=09% the output responses from the server.
+ =20
+:- pred soap_call_mercury_type(host::in, port::in, method::in,=20
+=09uri::in, list(univ)::in, list(univ)::out,=20
+=09io__state::di, io__state::uo) is det.
+
+=09% Sends messages (in XML format) to the SOAP server and returns
+=09% the response (in XML format).
+=09% host and port specifies the host and port number that the client
+=09% connects to; method specifies the method name of the RPC;=20
+=09% uri indicates the intent of the SOAP HTTP request (see reference
+=09% section 6.1); xmls are the message sends to the server and
+=09% the response receives from it.
+
+:- pred soap_call_xml_type(host::in, port::in, method::in, uri::in,=20
+=09xml::in, xml::out, io__state::di, io__state::uo) is det.
+
+
+%-------------------------------------------------------------------------=
--%
+
+:- implementation.
+:- import_module int, require.
+:- import_module stream.
+
+
+soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
+=09Responses) -->=20
+=09(
+=09=09{ Method =3D "GetStockPrice" }
+=09->
+=09 =09{ generate_SP_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }=20
+=09;
+=09=09{ Method =3D "Hello" }
+=09->
+=09=09{ generate_Hello_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "Add3Ints" }
+=09->
+=09=09{ generate_AddInt_request(Host, Method, SOAPuri,
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ Method =3D "PurchaseBook" }
+=09->
+=09=09{ generate_PB_request(Host, Method, SOAPuri,=20
+=09=09=09Parameters, Request) }
+=09;
+=09=09{ error("Encode: Method not supported") }
+=09),
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, XMLResponse)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ decode_response(Method, XMLResponse, Responses) }.
+
+
+=09% Translates XML response to Mercury types.
+:- pred decode_response(string::in, string::in, list(univ)::out) is det.
+
+decode_response(Method, XMLResponse, Responses) :- =20
+=09(
+=09=09Method =3D "GetStockPrice"=20
+=09->
+=09=09decode_SP_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Hello"
+=09->
+=09=09decode_Hello_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "Add3Ints"
+=09->
+=09=09decode_AddInt_response(XMLResponse, Responses)
+=09;
+=09=09Method =3D "PurchaseBook"
+=09->
+=09=09decode_PB_response(XMLResponse, Responses)
+=09;=09
+=09=09error("Decode: Method not supported")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+
+soap_call_xml_type(Host, Port, _Method, SOAPuri, XMLMesg, XMLResponse) -->
+=09{ generate_xml_request(Host, SOAPuri, XMLMesg, Request) },=20
+=09tcp__connect(Host, Port, Result),
+=09(
+=09=09{ Result =3D ok(TCP_Connect) },
+=09=09service_connection(TCP_Connect, Request, Response)
+=09;
+=09=09{ Result =3D error(String) },
+=09=09{ error(String) }
+=09),=20
+=09tcp__shutdown(TCP_Connect),
+=09{ retrieve_body(Response, XMLResponse) }.
+=09
+
+:- pred generate_xml_request(host::in, uri::in, xml::in, string::out)=20
+=09is det.
+
+generate_xml_request(Host, SOAPuri, XMLMesg, Request) :-=20
+=09generate_xml_body(XMLMesg, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+:- pred generate_xml_body(xml::in, string::out) is det.
+
+generate_xml_body(XMLMesg, SOAPBody) :-
+ =09SOAPBody =3D "<Envelope><Body>" ++ XMLMesg ++ "</Body></Envelope>".
+
+:- pred retrieve_body(string::in, xml::out) is det.
+
+retrieve_body(Response, Body) :-=20
+=09(
+=09=09string__sub_string_search(Response, "\r\n<", Pos)
+=09->
+=09=09string__length(Response, Length),
+=09=09string__right(Response, Length - Pos, Body)=20
+=09;
+=09=09error("error in retrieving body")=20
+=09).
+
+%-------------------------------------------------------------------------=
%=20
+% Hello
+%-------------------------------------------------------------------------=
%=20
+=09
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_Hello_request(host, method, uri, list(univ), string).
+:- mode generate_Hello_request(in, in, in, in, out) is det.
+
+generate_Hello_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_Hello_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),=09
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% Hello pred has no input.
+:- pred generate_Hello_body(string, list(univ), string).
+:- mode generate_Hello_body(in, in, out).
+
+generate_Hello_body(MethodName, _Parameters, Body) :-
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09"</" ++ MethodName ++ "></Body></Envelope>".
+=09=09
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<output>", Start),
+=09=09string__sub_string_search(XMLResponse, "</output>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <output>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09Responses =3D [univ(Response1)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% Add3Ints
+%-------------------------------------------------------------------------=
-%
+
+=09% Generates HTTP header information and SOAP message
+:- pred generate_AddInt_request(host, method, uri, list(univ), string).
+:- mode generate_AddInt_request(in, in, in, in, out) is det.
+
+generate_AddInt_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_AddInt_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+ =09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+=09
+
+:- pred generate_AddInt_body(method::in, list(univ)::in, string::out)
+=09is det.
+
+generate_AddInt_body(Method, Parameters, Body) :-
+=09list__map(create_xml_parameter, Parameters, XMLList),
+=09string__append_list(XMLList, XMLString),=20
+=09Body =3D "<Envelope><Body><" ++ Method ++ ">" ++ XMLString ++
+=09=09"</" ++ Method ++ "></Body></Envelope>".
+
+:- pred create_xml_parameter(univ::in, string::out) is det.
+
+create_xml_parameter(ParameterAsUniv, ParameterAsXML) :-
+=09det_univ_to_type(ParameterAsUniv, ParameterAsInt),
+=09string__int_to_string(ParameterAsInt, ParameterAsString),
+=09ParameterAsXML =3D "<int>" ++ ParameterAsString ++ "</int>".
+
+:- pred decode_AddInt_response(string::in, list(univ)::out) is det.
+
+decode_AddInt_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<result>", Start),
+=09=09string__sub_string_search(XMLResponse, "</result>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 8,=09=09% <result>
+=09=09string__right(Response0, End-Start-TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Responses =3D [univ(ResponseAsInt)]
+=09=09;
+=09=09 error("decode error")
+=09=09)
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
-%
+% GetStockPrice
+%-------------------------------------------------------------------------=
-%
+
+=09% Assume library file to be loaded in server is
+=09% libsoap_test_methods.so
+=09% client shouldn't need to know the library file name?
+
+=09% Generates HTTP header information and SOAP message in the body.=20
+:- pred generate_SP_request(host, method, uri, list(univ), string).
+:- mode generate_SP_request(in, in, in, in, out) is det.
+
+generate_SP_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_SP_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+=09% Generates SOAP message.
+=09% XXX=09assume no namespace and client has a copy of the schema
+=09% =09used in the server side to encode mercury types.
+:- pred generate_SP_body(method, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+=09% schema for GetStockPrice:
+ % <element name=3D"stocknum" type=3D"xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+=09% since client knows that this function takes in only
+=09% one parameter, there is no need to call list_foldl to
+=09% translate the parameters.
+=09list__index1_det(Parameters, 1, Parameter),
+=09generate_SP_param(Parameter, ParamAsString),
+=09Body =3D "<Envelope><Body><" ++ MethodName ++ ">" ++=20
+=09=09ParamAsString ++ "</" ++ MethodName ++
+=09=09"></Body></Envelope>".
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :- =20
+=09det_univ_to_type(ParamAsUniv, ParamAsValue),=09
+=09string__int_to_string(ParamAsValue, ParamAsString),
+=09Tag =3D "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<price>", Start),
+=09=09string__sub_string_search(XMLResponse, "</price>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Response0),
+=09=09TagLength =3D 7,=09=09% <price>
+=09=09string__right(Response0, End - Start - TagLength, Response1),
+=09=09(
+=09=09 string__to_int(Response1, ResponseAsInt)
+=09=09->
+=09=09 Response =3D ResponseAsInt
+=09=09;
+=09=09 error("decode error")
+=09=09),
+=09=09Responses =3D [univ(Response)]
+=09;
+=09=09error("decode error")=20
+=09).
+
+%-------------------------------------------------------------------------=
%
+% PurchaseBook
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header information and SOAP message.=20
+:- pred generate_PB_request(host, method, uri, list(univ), string).
+:- mode generate_PB_request(in, in, in, in, out) is det.
+
+generate_PB_request(Host, Method, SOAPuri, Parameters, Request) :-=20
+=09generate_PB_body(Method, Parameters, Body),
+=09string__length(Body, Length),
+=09generate_header(Host, Length, SOAPuri, Header),
+=09Request =3D insert_cr(Header) ++ Body.
+
+:- pred generate_PB_body(method::in, list(univ)::in, string::out) is det.
+generate_PB_body(Method, Parameters, Body) :-
+=09generate_PB_parameters(Parameters, ParameterString),
+=09Body =3D "<Envelope><Body><" ++ Method ++ "><book>" ++=20
+=09=09ParameterString ++ "</book></" ++ Method ++=20
+=09=09"></Body></Envelope>".
+
+:- pred generate_PB_parameters(list(univ)::in, string::out) is det.
+
+generate_PB_parameters(ParamList, Body):-
+=09list__index1_det(ParamList, 1, TitleAsUniv),
+=09det_univ_to_type(TitleAsUniv, TitleAsString),
+=09Title =3D "<title>" ++ TitleAsString ++ "</title>",
+=09
+=09list__index1_det(ParamList, 2, AuthorAsUniv),
+=09det_univ_to_type(AuthorAsUniv, AuthorAsString),
+=09(
+=09=09string__sub_string_search(AuthorAsString, ",", Pos)
+=09->
+=09=09string__left(AuthorAsString, Pos, Surname),
+=09=09string__length(AuthorAsString, Length),
+=09=09string__right(AuthorAsString, Length - (Pos + 1), Firstname)
+=09;
+=09=09Surname =3D AuthorAsString,
+=09=09Firstname =3D ""
+=09),=09
+=09Author =3D "<author>" ++=20
+=09=09 "<surname>" ++ Surname ++ "</surname>" ++
+=09=09 "<firstname>" ++ Firstname ++ "</firstname>" ++
+=09=09 "</author>",
+=09Body =3D Title ++ Author.
+
+:- pred decode_PB_response(string::in, list(univ)::out) is det.
+
+decode_PB_response(XMLResponse, Responses) :-=20
+=09(=20
+=09=09string__sub_string_search(XMLResponse, "<comment>", Start),
+=09=09string__sub_string_search(XMLResponse, "</comment>", End)=20
+=09->
+=09=09string__left(XMLResponse, End, Comment0),
+=09=09TagLength =3D 9,=09=09% <comment>
+=09=09string__right(Comment0, End - Start - TagLength, Comment1),
+=09=09Comment =3D [univ(Comment1)]
+=09;
+=09=09Comment =3D []
+=09),
+=09(
+=09 string__sub_string_search(XMLResponse, "<price>", Start1),
+=09 string__sub_string_search(XMLResponse, "</price>", End1)
+=09->
+=09 string__left(XMLResponse, End1, Price0),
+=09 TagLength1 =3D 7,=09=09% <price>
+=09 string__right(Price0, End1 - Start1 - TagLength1, Price1),
+=09 Price =3D [univ("Price =3D " ++ Price1)]
+=09;
+=09 Price =3D []
+=09),
+=09list__append(Comment, Price, Responses).
+
+=09
+%-------------------------------------------------------------------------=
%
+% Shared functions
+%-------------------------------------------------------------------------=
%
+
+=09% Generates HTTP header.
+:- pred generate_header(host::in, int::in, uri::in, string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+=09Header1 =3D "POST /libsoap_test_methods.so HTTP/1.1",
+=09Header2 =3D "Host: " ++ Host,
+=09Header3 =3D "Content-Type: text/xml",=20
+=09string__int_to_string(Length, LengthAsString),
+=09Header4 =3D "Content-Length: " ++ LengthAsString,
+=09(
+=09=09SOAPuri =3D "no value"
+=09->
+=09=09Header5 =3D "SOAPAction:"=20
+=09;
+=09=09Header5 =3D "SOAPAction: " ++ SOAPuri
+=09),
+=09Headers =3D insert_cr(Header1) ++ insert_cr(Header2) ++
+=09=09 insert_cr(Header3) ++ insert_cr(Header4) ++
+=09=09 insert_cr(Header5).
+
+=09% Insert carriage return into the line.
+:- func insert_cr(string) =3D string.
+insert_cr(Line) =3D Line ++ "\r\n".=20
+
+%------------------------------------------------------------------------%
+=09
+=09% Sends request to server using HTTP and receives response=20
+=09% from server.=20
+:- pred service_connection(tcp::in, string::in, string::out,=20
+=09io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+=09send_request(TCP, Request),
+=09read_response(TCP, Response).
+
+=09% Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <=3D stream__output(=
S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+=09stream__write_string(S, Requests).
+
+=09% Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <=3D stream__input(=
S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+=09stream__read_line(S, LineResult),
+=09(
+=09=09{ LineResult =3D ok(Line) },
+=09=09{ string__from_char_list(Line, String) },
+=09=09{ Response =3D String ++ Response0 },
+=09=09read_response(S, Response0)
+=09;
+=09=09{ LineResult =3D eof },
+=09=09{ Response =3D "" }
+=09;
+=09=09{ LineResult =3D error(Error) },
+=09=09{ error(string__format("read_response: %s.", [s(Error)])) }
+=09).
+=09=09
+%-------------------------------------------------------------------------=
%
+
Index: soap_test_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.2
diff -u -r1.2 soap_test_methods.m
--- soap_test_methods.m=092001/02/09 05:15:42=091.2
+++ soap_test_methods.m=092001/02/19 00:23:17
@@ -23,20 +23,25 @@
:- interface.
:- import_module list, std_util.
=20
+ =09% Trivial testing predicate - print out "Hello world".
:- pred hello(univ::out) is det.
=20
+=09% Given a stock number, return its price.=20
:- pred get_sp(list(univ)::in, univ::out) is det.
=20
:- func get_stockprice(list(univ)) =3D univ.
=20
-% :- pred get_bookprice(book::in, univ::out) is det.
-:- pred get_bookprice(list(univ)::in, univ::out) is det.
+=09% Adding 3 integers.
+:- func add3Ints(list(univ)) =3D univ.
=20
+=09% Place a purchase order for a specific book.
+:- pred purchase_book(list(univ)::in, univ::out) is det.
+
:- type book
=09--->=09book(
=09=09=09title :: string,
-=09=09=09author :: author,
-=09=09=09intro :: string
+=09=09=09author :: author
+=09=09=09% intro :: string
=09=09).
=09
:- type author
@@ -69,6 +74,20 @@
=09ResultAsUniv =3D univ("<output>Hello, world</output>").
=20
%---------------------------------------------------------------------%
+% Add3Ints
+%---------------------------------------------------------------------%
+
+add3Ints(ParamList) =3D Result :-
+=09list__index1_det(ParamList, 1, XAsUniv),
+=09list__index1_det(ParamList, 2, YAsUniv),
+=09list__index1_det(ParamList, 3, ZAsUniv),
+=09det_univ_to_type(XAsUniv, X),=20
+=09det_univ_to_type(YAsUniv, Y),=20
+=09det_univ_to_type(ZAsUniv, Z),=20
+=09ResultAsUniv =3D X + Y + Z,
+=09Result =3D univ(ResultAsUniv).
+
+%---------------------------------------------------------------------%
% GetStockPrice=20
%---------------------------------------------------------------------%
=20
@@ -100,21 +119,21 @@
=09).
=20
%---------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%---------------------------------------------------------------------%
=20
-get_bookprice(ParamList, ResultAsUniv) :-=20
+purchase_book(ParamList, ResultAsUniv) :-=20
=09list__index1_det(ParamList, 1, ParamAsUniv),
=09Param0 =3D univ_value(ParamAsUniv),
=09Param =3D inst_cast_book(Param0),=20
=09(
-=09=09Param =3D book("Hello world",=20
-=09=09=09=09author("Foo", "Bar"),=20
-=09=09=09=09"This is a book")=20
+=09=09Param =3D book("Hello world", =20
+=09=09=09=09author("Foo", "Bar"))
+=09=09=09=09% "This is a book")=20
=09->
=09=09ResultAsUniv =3D univ(100)
=09;
-=09=09ResultAsUniv =3D univ(50)
+=09=09ResultAsUniv =3D univ(0)
=09).
=20
:- func inst_cast_book(T) =3D book.
Index: web_methods.m
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.2
diff -u -r1.2 web_methods.m
--- web_methods.m=092001/02/09 05:15:42=091.2
+++ web_methods.m=092001/02/19 00:23:17
@@ -132,12 +132,18 @@
=09=09=09call_SP_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)=20
=09=09;
-=09=09=09% GetBookPrice takes in a struct
-=09=09=09{ Request^name =3D "GetBookPrice" }
+=09=09=09% Add3Ints has 3 parameters
+=09=09=09{ Request^name =3D "Add3Ints" }
=09=09->
-=09=09=09call_BP_pred(Handle, Filename, Request,=20
+=09=09=09call_AI_func(Handle, Filename, Request,=20
=09=09=09=09Response0, HttpCode0, ErrorFlag0)
=09=09;
+=09=09=09% PurchaseBook takes in a struct
+=09=09=09{ Request^name =3D "PurchaseBook" }
+=09=09->
+=09=09=09call_PB_pred(Handle, Filename, Request,=20
+=09=09=09=09Response0, HttpCode0, ErrorFlag0)
+=09=09;
=09=09=09{ Response0 =3D "Method requested not implemented." },=20
=09=09=09{ ErrorFlag0 =3D yes },
=09=09=09{ HttpCode0 =3D 501 }=09% 501 Not Implemented
@@ -227,6 +233,62 @@
[will_not_call_mercury, thread_safe], "Y =3D X").
=20
%-----------------------------------------------------------------------%
+% Add3Ints=20
+%-----------------------------------------------------------------------%
+
+:- pred call_AI_func(handle, string, web_method_request,=20
+=09string, http_code, bool, io__state, io__state).
+:- mode call_AI_func(in, in, in, out, out, out, di, uo) is det.
+
+call_AI_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ AIProc =3D mercury_proc(function, unqualified(Filename),
+=09=09=09=09"add3Ints", 1, 0) },
+=09dl__mercury_sym(Handle, AIProc, MaybeAddInts),
+=09(
+=09=09{ MaybeAddInts =3D error(Msg) },
+=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
+=09=09{ Response =3D ErrorMsg },
+=09=09{ ErrorFlag =3D yes },
+=09=09{ HttpCode =3D 500 }=20
+=09;
+=09=09{ MaybeAddInts =3D ok(AIFunc0) },
+=09=09{ wrapper(AIFunc) =3D inst_cast_addInts(wrapper(AIFunc0)) },
+=09=09{ list__map(lookup_AI_schema, Request^params, UnivList) },
+=09=09{ ResultAsUniv =3D AIFunc(UnivList) },
+=09=09{ det_univ_to_type(ResultAsUniv, ResultAsInt) },
+=09=09{ string__int_to_string(ResultAsInt, ResultAsString) },
+=09=09{ Response =3D "<result>" ++ ResultAsString ++ "</result>" },
+=09=09{ ErrorFlag =3D no },
+=09=09{ HttpCode =3D 200 }
+=09).
+
+=09% schema=20
+=09% <element name=3D"int" type=3D"xsd:int">
+
+:- pred lookup_AI_schema(parameter::in, univ::out) is det.
+lookup_AI_schema(Param, ValueAsUniv) :-
+=09(
+=09=09Param^pName =3D "int",
+=09=09Param^pValue =3D yes(Value)
+=09->
+=09 =09type_cast_parameter("int", Value, ValueAsUniv)
+=09;
+=09=09string__append("Element Name not defined in schema: ",=20
+=09=09=09=09Param^pName, ErrorMsg),
+=09=09require__error(ErrorMsg)
+=09).
+
+=09% inst cast for add3Ints (function)
+:- type addInts =3D=3D (func(list(univ)) =3D univ ).
+:- type addInts_wrapper ---> wrapper(addInts).
+:- inst addInts_wrapper ---> wrapper(func(in) =3D out is det).
+
+:- func inst_cast_addInts(addInts_wrapper) =3D addInts_wrapper.
+:- mode inst_cast_addInts(in) =3D out(addInts_wrapper) is det.
+:- pragma c_code(inst_cast_addInts(X::in) =3D (Y::out(addInts_wrapper)),
+=09[will_not_call_mercury, thread_safe], "Y=3DX").
+
+%-----------------------------------------------------------------------%
% GetStockPrice=20
%-----------------------------------------------------------------------%
=20
@@ -341,7 +403,7 @@
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
-% GetBookPrice
+% PurchaseBook
%-----------------------------------------------------------------------%
=20
/* see Section 3.4 Complex Type Definition Details=20
@@ -359,7 +421,7 @@
schema components across namespaces (=A76.2.3) for the use of component=20
identifiers when importing one schema into another.
*/
-=09% schema for GetBookPrice:
+=09% schema for PurchaseBook:
=09%
=09% <element name=3D"book" type=3D"tns:book"/>
=09% <element name=3D"author" base=3D"tns:author"/>
@@ -368,7 +430,7 @@
=09% <sequence>
=09% <element name=3D"title" type=3D"xsd:string"/>
=09% <element name=3D"author" type=3D"tns:author"/>
-=09% <element name=3D"intro" type=3D"xsd:string"/>
+=09% % <element name=3D"intro" type=3D"xsd:string"/>
=09% </sequence>
=09% </complexType>
=09% =20
@@ -385,7 +447,7 @@
=09%=09--->=09book(
=09%=09=09=09title =09:: string,
=09%=09=09=09author =09:: author,
-=09%=09=09=09intro=09:: string
+=09%=09=09%=09intro=09:: string
=09%=09=09).
=09%=09
=09% :- type author
@@ -394,64 +456,71 @@
=09%=09=09=09firstname :: string
=09%=09=09).
=20
-:- pred call_BP_pred(handle, string, web_method_request,
+:- pred call_PB_pred(handle, string, web_method_request,
=09string, http_code, bool, io__state, io__state).
-:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det.
+:- mode call_PB_pred(in, in, in, out, out, out, di, uo) is det.
=20
-call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
-=09{ GetBPProc =3D mercury_proc(predicate, unqualified(Filename),
-=09=09=09"get_bookprice", 2, 0) },=20
-=09dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
+call_PB_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+=09{ GetPBProc =3D mercury_proc(predicate, unqualified(Filename),
+=09=09=09"purchase_book", 2, 0) },=20
+=09dl__mercury_sym(Handle, GetPBProc, MaybePurchaseBook),
=09(
-=09=09{ MaybeGetBookPrice =3D error(Msg) },=20
+=09=09{ MaybePurchaseBook =3D error(Msg) },=20
=09=09{ string__append("dlsym failed: ", Msg, ErrorMsg) },
=09=09{ Response =3D ErrorMsg },
=09=09{ ErrorFlag =3D yes },
=09=09{ HttpCode =3D 500 }
=09;
-=09=09{ MaybeGetBookPrice =3D ok(BPProc0) },=20
+=09=09{ MaybePurchaseBook =3D ok(PBProc0) },=20
=20
=09=09% Cast the higher-order term that we obtained
=09=09% to the correct higher-order inst.
-=09=09{ BPProc =3D inst_cast_bp(BPProc0) },
+=09=09{ PBProc =3D inst_cast_pb(PBProc0) },
=20
=09=09% Convert parameters (string) to the corresponding types
-=09=09{ list__map(lookup_BP_schema, Request^params, UnivList) },
+=09=09{ list__map(lookup_PB_schema, Request^params, UnivList) },
=09=09
=09=09% Call the procedure whose address we just obtained
-=09=09{ call(BPProc, UnivList, BPUniv) },
+=09=09{ call(PBProc, UnivList, PBUniv) },
=20
-=09=09{ det_univ_to_type(BPUniv, BPInt) },=09
-=09=09{ string__int_to_string(BPInt, BPString) },
-
-=09=09{ string__append("<price>", BPString, BPresult0) },
-=09=09{ string__append(BPresult0, "</price>", BPresult) },
-=09=09{ Response =3D BPresult },
+=09=09{ det_univ_to_type(PBUniv, PBInt) },=09
+=09=09(=20
+=09=09 =09{ PBInt \=3D 0 }
+=09=09->
+=09=09=09{ string__int_to_string(PBInt, PBString) },
+=09=09=09{ Response =3D "<comment>Purchase order placed " ++
+=09=09=09=09 =09"successfully</comment>\n<price>" ++
+=09=09=09=09=09PBString ++ "</price>" }
+=09=09;
+=09=09=09{ Response =3D "<comment>No such book. Purchase " ++
+=09=09=09=09=09"order not placed.</comment>" }=09
+=09=09),
=09=09{ ErrorFlag =3D no },
=09=09{ HttpCode =3D 200 }
=09).
=20
=20
-:- pred lookup_BP_schema(parameter::in, univ::out) is det.
+:- pred lookup_PB_schema(parameter::in, univ::out) is det.
=20
-lookup_BP_schema(Param, ValueAsUniv) :- =20
+lookup_PB_schema(Param, ValueAsUniv) :- =20
=09(
=09=09Param^pName =3D "book",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "title", Title0),
-=09=09lookup_BP_schema(Title0, TitleAsUniv),
+=09=09get_PB_param(FieldList, "title", Title0),
+=09=09lookup_PB_schema(Title0, TitleAsUniv),
=09=09det_univ_to_type(TitleAsUniv, Title),
=20
-=09=09get_BP_param(FieldList, "author", Author0),
-=09=09lookup_BP_schema(Author0, AuthorAsUniv),
+=09=09get_PB_param(FieldList, "author", Author0),
+=09=09lookup_PB_schema(Author0, AuthorAsUniv),
=09=09det_univ_to_type(AuthorAsUniv, Author),
=09
-=09=09get_BP_param(FieldList, "intro", Intro0),
-=09=09lookup_BP_schema(Intro0, IntroAsUniv),
-=09=09det_univ_to_type(IntroAsUniv, Intro),
+=09=09% get_PB_param(FieldList, "intro", Intro0),
+=09=09% lookup_PB_schema(Intro0, IntroAsUniv),
+=09=09% det_univ_to_type(IntroAsUniv, Intro),
=20
-=09=09ValueAsBook =3D book(Title, Author, Intro),
+=09=09% ValueAsBook =3D book(Title, Author, Intro),
+=09=09ValueAsBook =3D book(Title, Author),
=09=09ValueAsUniv =3D univ(ValueAsBook)
=09;=09
=09=09Param^pName =3D "title",
@@ -462,12 +531,12 @@
=09=09Param^pName =3D "author",
=09=09Param^pFields =3D yes(FieldList)
=09->
-=09=09get_BP_param(FieldList, "surname", Surname0),
-=09=09lookup_BP_schema(Surname0, SurnameAsUniv),
+=09=09get_PB_param(FieldList, "surname", Surname0),
+=09=09lookup_PB_schema(Surname0, SurnameAsUniv),
=09=09det_univ_to_type(SurnameAsUniv, Surname),
=20
-=09=09get_BP_param(FieldList, "firstname", Firstname0),
-=09=09lookup_BP_schema(Firstname0, FirstnameAsUniv),
+=09=09get_PB_param(FieldList, "firstname", Firstname0),
+=09=09lookup_PB_schema(Firstname0, FirstnameAsUniv),
=09=09det_univ_to_type(FirstnameAsUniv, Firstname),
=20
=09=09ValueAsAuthor =3D author(Surname, Firstname),
@@ -491,21 +560,21 @@
=09=09require__error("Element Structure not defined in schema.")
=09).
=20
-:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is d=
et.
+:- pred get_PB_param(list(parameter)::in, string::in, parameter::out) is d=
et.
=20
-get_BP_param(ParamList, SearchString, Parameter) :-
+get_PB_param(ParamList, SearchString, Parameter) :-
=09list__filter((pred(X::in) is semidet :-
=09=09X =3D parameter(SearchString,_,_,_,_)), ParamList, Result),
=09list__index1_det(Result, 1, Parameter).=09
=20
-=09% inst cast for get_bookprice=20
-:- type bp_pred =3D=3D pred(list(univ), univ).
-% :- type bp_pred =3D=3D pred(book, univ).
-:- inst bp_pred =3D=3D (pred(in, out) is det).
+=09% inst cast for purchase_book
+:- type pb_pred =3D=3D pred(list(univ), univ).
+% :- type pb_pred =3D=3D pred(book, univ).
+:- inst pb_pred =3D=3D (pred(in, out) is det).
=20
-:- func inst_cast_bp(bp_pred) =3D bp_pred.
-:- mode inst_cast_bp(in) =3D out(bp_pred) is det.
-:- pragma c_code(inst_cast_bp(X::in) =3D (Y::out(bp_pred)),
+:- func inst_cast_pb(pb_pred) =3D pb_pred.
+:- mode inst_cast_pb(in) =3D out(pb_pred) is det.
+:- pragma c_code(inst_cast_pb(X::in) =3D (Y::out(pb_pred)),
=09[will_not_call_mercury, thread_safe], "Y=3DX").
=20
%-----------------------------------------------------------------------%
|
|
From: Ina C. <in...@st...> - 2001-02-16 06:28:12
|
Hi,
========================================================================
Estimated hours taken: 18
Write a document on how to build the server, how to extend the server
and the interface etc.
/server/USERGUIDE
the newly added document.
========================================================================
This document covers the following topics:
* Building the web-server
* Running the web-server
* Request methods
I. GET
II. POST
* Encoding rules and schemas
I. Simple types
II. Enumerations
III. Structures
IV. Lists
* Interface between the server and the client
* Implementing new method and its interface
* Running the sample program
* References
-----------------------
Building the web-server
-----------------------
Step 1: Checkout the web-server module with the following instructions:
1. cvs
-d:pserver:ano...@cv...:/cvsroot/quicksilver
login
2. Press the Enter key when prompted for a password.
3. cvs -z3
-d:pserver:ano...@cv...:/cvsroot/quicksilver
co webserver
Step 2: Build the webserver using the following commands:
1. mmake GRADE=hlc.par.gc depend
2. mmake GRADE=hlc.par.gc
It is recommended to use a recent Mercury ROTD to compile the server.
Any release of the day more recent then rotd-2000-08-29 should be fine.
---------------------
Running the webserver
---------------------
To run the webserver, type the following command:
$ ./server
The server provides 3 options: host, port, and root. Host specifies
the name of the host which will be listening for the requests; port
specifies which port the server is listening on; root specifies the
root directory for the html files to be served.
For example:
$ ./server --host localhost --port 8080 --root .
The server now listens for any connection, either from its clients or
from some direct connections to the server (eg. telnet localhost 8080).
---------------
Request Methods
---------------
Hypertext Transfer Protocol (HTTP) 1.1 is used to transfer requests
and responses between the server and the client. The server supports
the following request method:
I. GET
II. POST
I. GET
The GET method requests a document from a specific location on the
server.
For example, the client wants to retrieve a file named `server.m' in
the root directory of the server, thus the client issues the following
request:
GET /server.m HTTP/1.1
The corresponding response will be:
HTTP/1.1 200 OK
[Body of the document]
II. POST
The POST method sends data to the server. In particular, the POST method
is used to encapsulate and exchange remote procedure calls and responses.
A POST request includes a request, headers, and an entity-body containing
the data to be sent. The server uses Simple Object Access Protocol (SOAP)
1.1 to represent the data body. It is an XML based protocol that consists
of three parts:
* a SOAP envelope describing what is in a message and how to process it;
* SOAP encoding rules defining datatypes;
* SOAP RPC representation defining a convention that can be used to
represent remote procedure calls and responses.
An example of SOAP message embedded in HTTP issuing a call to the predicate
"Hello" in the library file "libsoap_test_methods.so" will be:
POST /libsoap_test_methods.so HTTP/1.1
Host: www.cs.mu.oz.au
Content-Type: text/xml
Content-Length: 227
SOAPAction:
<SOAP-ENV:Envelope
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<GetStockPrice>
<stocknum xsi:type="xsd:int">1</stocknum>
</GetStockPrice>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
A SOAP envelope consists of a mandatory SOAP envelope, an optional SOAP
header and a mandatory SOAP body. Currently the server accepts messages
with header without process it.
Inside the SOAP Body is the RPC, which includes the method name and the
parameters. Each element name within the method represents the name of
the parameter and the type represents the type of the parameter. These
parameters appear in the same order as in the method call.
Extra information:
* HTTP applications must use the media type "text/xml" when including
SOAP entity bodies in HTTP messages
* An HTTP client must use "SOAPAction" HTTP request header field when
issuing a SOAP HTTP Request.
* Assume only one RPC per SOAP message
Responses, similar to requests, bind SOAP with HTTP such that headers
use HTTP protocol and messages use SOAP protocol. Responses for RPC
are represented by appending the string "Response" to the method name.
The corresponding response for the above SOAP message will be:
HTTP/1.1 200 OK
Content-Length: 199
Content-Type: text/xml
<SOAP-ENV:Envelope
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<GetStockPriceResponse>
<price>34</price>
<GetStockPriceResponse>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
(See http://www.w3org/TR/SOAP for more details)
--------------------------
Encoding rules and schemas
--------------------------
The server uses the following schemas to encode/decode mercury data
types.
I. Simple types
A mercury predicate which takes in an integer, a float and a string will
have the following schema
<element name="arg1" type="xsd:int"/>
<element name="arg2" type="xsd:float"/>
<element name="arg3" type="xsd:string"/>
II. Enumerations
For mercury enumerations, eg.
:- type fruit
---> apple
; orange
; banana
; pear.
The schema will be:
<element name="fruit" type="tns:fruit"/>
<simpleType name="fruit">
<restriction base="mercury:string">
<enumeration value="apple"/>
<enumeration value="orange"/>
<enumeration value="banana"/>
<enumeration value="pear"/>
</restriction>
</simpleType>
III. Structure
For mercury structures, eg.
:- type book
---> book(
title :: string,
author :: author
).
:- type author
---> author(
surname :: string,
firstname :: string
).
The schema will be:
<element name="book" type="tns:book"/>
<element name="author" base="tns:author"/>
<complexType name="book">
<sequence>
<element name="title" type="mercury:string"/>
<element name="author" type="tns:author"/>
</sequence>
</complexType>
<complexType name="author">
<sequence>
<element name"surname" type="mercury:string"/>
<element name"firstname" type="mercury:string"/>
</sequence>
</complexType>
IV. Lists
For mercury lists, eg.
:- type list(T)
---> []
; [T|list(T)].
The schema will be:
<element name="list" type="tns:list"/>
<element name="nil" type="tns:nil"/>
<element name="cons" type="tns:cons"/>
<complexType name="list">
<sequence>
<choice>
<element name="nil" type="tns:nil"/>
<element name="cons" type="tns:cons"/>
</choice>
</sequence>
</complexType>
<complexType name="nil>
<complexContent>
<restriction base="xsd:anyType">
</restriction>
</complexContent>
</complexType>
<complexType name="cons">
<sequence>
<element name="head" type="xsd:anyType">
<element name="tail" type="tns:list"/>
</sequence>
</complexType>
-------------------------------------------
Interface between the server and the client
-------------------------------------------
This module, soap_interface.m, provides an interface for programmers
to send messages to the SOAP server. It is aimed to hide all the
SOAP and HTTP details away from the client. In doing so, the client
is able to communicate with the server in mercury types.
In addition, the interface also allow an arbitrary XML message to be
passed using SOAP (and the response will be returned as XML too).
This will allow programmers to use their own encodings and communicate
with any SOAP based service.
-----------------------------------------
Implementing new method and its interface
-----------------------------------------
When adding a new method, the following steps will have to be taken:
1. Add the method in a separate module, for example, soap_test_methods.m
2. Modify web_methods.m such that the library code is loaded for the
new method when the server runs.
3. Re-build the server.
The server now supports the new RPC via direct access (ie. telnet
to the server and send the request using HTTP and SOAP protocol).
4. Modify soap_interface.m to allow clients to send messages to the
server in mercury types.
An assumption that has been made is that, the client is assumed to have
a copy of the schema that is used in the server for encoding and decoding
types in XML.
--------------------------
Running the sample program
--------------------------
The sample program demonstrates four common examples, ie. printing
"Hello world", adding 3 integers, placing a query and placing a purchase
order. In addition, the program accepts xml messages.
To build the sample program, type the following commands:
$ mmake client_demo.depend
$ mmake client_demo
To print "Hello world":
$ ./client_demo -m Hello
To add 3 integers:
$ ./client_demo -m Add3Ints --add1 1 --add2 2 --add3 3
To place query for a specific stock's price:
$ ./client_demo -m GetStockPrice -i stocknumber
To purchase a book:
$ ./client_demo -m PurchaseBook -t booktitle -a surname,firstname
To print "Hello world" using XML format instead:
$ ./client_demo -x "<Hello></Hello>"
----------
References
----------
http://www.w3.org/TR/SOAP
http://www.oreilly.com/openbook/webclient/
|
|
From: Ina C. <in...@st...> - 2001-02-09 13:03:16
|
On Fri, 9 Feb 2001, Peter Ross wrote: > On Fri, Feb 09, 2001 at 05:06:33PM +1100, Ina Cheng wrote: > > Is there a standard way of specifying which method you wish to call? > > I would presume so. If there is then I would imagine that you use the > standard way to specify which method you wanted to call and then you > would just pass the given XML string as is to the method and return the > exact XML string which the SOAP method returns back to the programmer. > > If there isn't, then I would imagine you would just pass the XML string > as is to the SOAP server and appending any headers that are necessary > and then strip any unecessary headers from the response and hand that > back to the programmer. > > Make sense? > I'm afraid to say not really. Most of the references I've looked at involve sending messages using SOAP for RPC, however, Tyson 'somehow' mentioned about sending messages using SOAP but not for RPC. That's why I'm so confused now and need to stay up at night emailing you (you're on the other side of earth!). Thanks Ina |
|
From: Peter R. <pet...@mi...> - 2001-02-09 09:37:49
|
On Fri, Feb 09, 2001 at 05:06:33PM +1100, Ina Cheng wrote: > > Hi Peter, > > I hope you can clarify the following feature that Tyson hopes to implement > in the client side: > > For the design of the client side, Tyson wrote: > > In addition, an interface will be provided that allows an > arbitrary XML message to be passed using SOAP (and the response > will be returned as XML too). This will allow programmers to > use their own encodings and communicate with any SOAP based > service. > Good question. Is there a standard way of specifying which method you wish to call? I would presume so. If there is then I would imagine that you use the standard way to specify which method you wanted to call and then you would just pass the given XML string as is to the method and return the exact XML string which the SOAP method returns back to the programmer. If there isn't, then I would imagine you would just pass the XML string as is to the SOAP server and appending any headers that are necessary and then strip any unecessary headers from the response and hand that back to the programmer. Make sense? Pete |
|
From: Ina C. <in...@st...> - 2001-02-09 06:06:14
|
Hi Peter,
I hope you can clarify the following feature that Tyson hopes to implement
in the client side:
For the design of the client side, Tyson wrote:
In addition, an interface will be provided that allows an
arbitrary XML message to be passed using SOAP (and the response
will be returned as XML too). This will allow programmers to
use their own encodings and communicate with any SOAP based
service.
I'm not sure what `an arbitrary XML message' means here.
It can either be something to do with the RPC like:
<Envelope>
<Body>
<methodname>
<argument>1</argument>
</methodname>
</Body>
</Envelope>
or
just the RPC:
<methodname>
<argument>1</argument>
</methodname>
or
something have nothing to do with RPC like:
<Envelope>
<Body>
<Message>Echo Hello World</Message>
</Body>
</Envelope>
I hope you can help me to sort this out. Thanks.
Ina
<in...@st...>
|
|
From: Peter R. <pet...@mi...> - 2001-02-08 09:34:50
|
On Thu, Feb 08, 2001 at 03:30:09PM +1100, Ina Cheng wrote: > > Hi, > > I've addressed Peter's comments and here is the new diff. > If everything looks ok, I would like to commit the changes. > > Ina > <in...@st...> > > ======================================================================== > > Estimated hours taken: 5 > > Address Peter's comment for last diff ( the diff for adding example > to handle mercury structure). > > /server/server.m > add predicates to check request header. > change the header to request a library filename to be loaded for dl. > > /server/soap.m > clean up some code. > (Peter mentioned that I should do this in a separate change, > but I can't remember how to change it back to the original, > sorry, please bear with it now. I'll remember it next time.) > > /server/soap_test_methods.m > /server/web_methods.m > add example to handle mercury structure > You should reuse the log message from your original change, because that is the log message that was reviewed. No need to mention the review process. Otherwise that looks fine. |
|
From: Fergus H. <fj...@cs...> - 2001-02-08 04:57:46
|
On 08-Feb-2001, Ina Cheng <in...@st...> wrote:
> +++ options.m 2001/02/08 04:19:22
> + % General client options
> +option_default(uri, string("\"\"")).
Why isn't that just
option_default(uri, string("")).
?
The default of using "\"\"" (i.e. "") rather than
"" (i.e. the empty string) is odd.
I think at least you should put a comment explaining it.
> +% XXX if the default value is not defined, the option cannot
> +% be recognised, but this has no default value
> +option_default(method, string("Hello")).
Use
option_default(method, string("")).
and then have the code which uses that option check whether the value
of the option is the empty string.
> +:- module soap_interface.
> +:- interface.
> +:- import_module io, list, std_util, string.
> +:- import_module tcp.
> +
> +:- pred soap_call_mercury_type(host::in, port::in, string::in,
> + string::in, list(univ)::in, list(univ)::out,
> + io__state::di, io__state::uo) is det.
You should document *in the interface section*
what that predicate does and what it's arguments mean.
> +/* Outline:
> +soap_call_mercury_type(uri, method_name, list_of_univ_in,
> + list_of_univ_out) :-
> + generate SOAP message in XML format and SOAP protocol,
> + tcp__connect to the server,
> + service_connection,
> + ( which will handle:
> + send the request to the server using HTTP,
> + wait for the response,
> + read response in XML format,
> + )
> + decode the response to mercury types,
> + return list_of_univ as response.
> +
> +soap_call_xml_type:
> + tcp__connect to the server,
> + service_connection,
> + ( which will handle:
> + send the request to the server using HTTP,
> + wait for the response,
> + read response in XML format,
> + )
> + return response.
> +
> +*/
Shouldn't you disconnect from the server at some point?
The tcp__disconnect should be done at the same level as the
tcp__connect. If the disconnect is done from within
service_connection, then I think the tcp__connect should
also be done from within service_connection.
> +decode_SP_response(XMLResponse, Responses) :-
> + (
> + string__sub_string_search(XMLResponse, "<price>", Start),
> + string__sub_string_search(XMLResponse, "</price>", End)
> + ->
> + string__left(XMLResponse, End, Response0),
> + TagLength = 7, % <price>
> + string__right(Response0, End-Start-TagLength, Response1),
Put whitespace around operators, i.e. s/-/ - /g
> +%------------------------------------------------------------------------%
> +
> + % Connects to the server using TCP/IP, sends request to server
> + % using HTTP, receives response from server and terminates
> + % the connection.
> +:- pred service_connection(tcp::in, string::in, string::out,
> + % io__state::di, io__state::uo) is cc_multi.
> + io__state::di, io__state::uo) is det.
> +
> +service_connection(TCP, Request, Response) -->
> + send_request(TCP, Request),
> + read_response(TCP, Response),
> + tcp__shutdown(TCP).
The documentation says this connects to the server,
but the code doesn't do the connect.
In the long term of course the hard-coding of the method names
("Hello", etc.) needs to be fixed. But otherwise this looks good.
--
Fergus Henderson <fj...@cs...> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
|
|
From: Ina C. <in...@st...> - 2001-02-08 04:38:58
|
Hi,
I've implemented the first part of the client interface. Can someone
please review it? Thanks.
Ina
<in...@st...>
========================================================================
Estimated hours taken: 24
Add 2 modules for the client side.
/server/Mmakefile
modify makefile to accommodate the client side.
/server/client_demo.m
new module showing how to call the soap_interface to send
messages to the SOAP server.
/server/options.m
add new options to handle command line arguments for client.
/server/soap_interface.m
new module - provide an interface for programmers to send messages
to the SOAP server.
========================================================================
Index: Mmakefile
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/Mmakefile,v
retrieving revision 1.4
diff -u -r1.4 Mmakefile
--- Mmakefile 2001/01/25 06:54:42 1.4
+++ Mmakefile 2001/02/08 04:19:22
@@ -1,4 +1,4 @@
-MAIN_TARGET=server libsoap_test_methods
+MAIN_TARGET=server client_demo libsoap_test_methods
-include ../Mmake.params
@@ -18,6 +18,7 @@
# Link in the '-ldl' library (this may not be needed on some systems)
MLLIBS += -ldl
-depend: server.depend soap_test_methods.depend
+depend: server.depend client_demo.depend soap_test_methods.depend
+
server: $(MLLIBS)
Index: client_demo.m
===================================================================
RCS file: client_demo.m
diff -N client_demo.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ client_demo.m Wed Feb 7 20:19:22 2001
@@ -0,0 +1,77 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University Of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% This module provide a sample of how to call the SOAP interface to send
+% messages from the client to the SOAP server.
+%---------------------------------------------------------------------------%
+
+:- module client_demo.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module http, options.
+
+:- import_module bool, char, exception, getopt.
+:- import_module int, list, require, std_util, string.
+
+:- import_module soap_interface.
+
+main -->
+ io__command_line_arguments(Args0),
+ { OptionOpts = option_ops(short_option, long_option, option_defaults)},
+ { getopt__process_options(OptionOpts, Args0, _Args, OptionsResult) },
+ (
+ { OptionsResult = ok(OptTable) },
+ { getopt__lookup_bool_option(OptTable, help, Help) },
+ (
+ { Help = yes },
+ options_help
+ ;
+ { Help = no },
+ { getopt__lookup_string_option(OptTable, host, Host) },
+ { getopt__lookup_int_option(OptTable, port, Port) },
+ { getopt__lookup_string_option(OptTable, method, Method) },
+ { getopt__lookup_string_option(OptTable, uri, URI) },
+ (
+ { Method = "GetStockPrice" }
+ ->
+ { getopt__lookup_int_option(OptTable, int, Int) },
+ soap_call_mercury_type(Host, Port, Method,
+ URI, [univ(Int)], Responses),
+ display_response("Stockprice = ", Responses)
+ ;
+ { Method = "Hello" }
+ ->
+ soap_call_mercury_type(Host, Port, Method,
+ URI, [], Responses),
+ display_response("", Responses)
+ ;
+ { error("Method not supported") }
+ )
+ )
+ ;
+ { OptionsResult = error(OptionErrorString) },
+ io__write_string(OptionErrorString),
+ io__nl,
+ options_help
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- pred display_response(string::in, list(univ)::in, io__state::di,
+ io__state::uo) is det.
+
+display_response(Message, Responses) -->
+ { list__index1_det(Responses, 1, ResponseAsUniv) },
+ { ResponseAsValue = univ_value(ResponseAsUniv) },
+ io__print(Message),
+ write(ResponseAsValue),
+ nl.
Index: options.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/options.m,v
retrieving revision 1.1
diff -u -r1.1 options.m
--- options.m 2000/11/27 10:02:58 1.1
+++ options.m 2001/02/08 04:19:22
@@ -26,6 +26,12 @@
; port
; root
+ % Client options
+ ; method
+ ; uri
+ ; int
+
+
% Miscellaneous Options
; help.
@@ -63,6 +69,14 @@
option_default(port, int(8080)).
option_default(root, string("/var/www")).
+ % General client options
+option_default(uri, string("\"\"")).
+
+% XXX if the default value is not defined, the option cannot
+% be recognised, but this has no default value
+option_default(method, string("Hello")).
+option_default(int, int(0)).
+
% Miscellaneous Options
option_default(help, bool(no)).
@@ -70,16 +84,22 @@
% short_option('f', config_file).
short_option('h', help).
short_option('H', host).
+short_option('i', int).
+short_option('m', method).
short_option('P', port).
short_option('R', root).
+short_option('u', uri).
short_option('v', verbose).
short_option('V', very_verbose).
% long_option("config-file", config_file).
long_option("help", help).
long_option("host", host).
+long_option("int", int).
+long_option("method", method).
long_option("port", port).
long_option("root", root).
+long_option("uri", uri).
long_option("verbose", verbose).
long_option("very-verbose", very_verbose).
@@ -99,6 +119,14 @@
"\t\tWhich port quicksilver listens on.\n",
"\t-R, --root\n",
"\t\tThe root directory for the html files to be served.\n",
+
+ "\nClient Options:\n",
+ "\t-m, --method\n",
+ "\t\tMethod Name to be called.\n",
+ "\t-u, --uri\n",
+ "\t\tURI of SOAPAction header.\n",
+ "\t-i, --int\n",
+ "\t\tAn integer parameter for the RPC.\n",
"\nVerbosity Options:\n",
"\t-v, --verbose\n",
Index: soap_interface.m
===================================================================
RCS file: soap_interface.m
diff -N soap_interface.m
--- /dev/null Mon Dec 11 17:26:27 2000
+++ soap_interface.m Wed Feb 7 20:19:23 2001
@@ -0,0 +1,268 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne
+% This file may only be copied under the terms of the GNU General Public
+% License - see the file COPYING
+%---------------------------------------------------------------------------%
+%
+% This module provide an interface for programmers to send messages
+% to the SOAP server. It will provide as basic functionality the
+% ability to do RPC over SOAP. The hard-coded XML encoding for
+% Mercury datatypes (the same encoding as the SOAP server currently
+% expects) will be used to encode the RPC calls.
+%
+%---------------------------------------------------------------------------%
+
+:- module soap_interface.
+:- interface.
+:- import_module io, list, std_util, string.
+:- import_module tcp.
+
+:- pred soap_call_mercury_type(host::in, port::in, string::in,
+ string::in, list(univ)::in, list(univ)::out,
+ io__state::di, io__state::uo) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module int, require.
+:- import_module stream.
+
+
+/* Outline:
+soap_call_mercury_type(uri, method_name, list_of_univ_in,
+ list_of_univ_out) :-
+ generate SOAP message in XML format and SOAP protocol,
+ tcp__connect to the server,
+ service_connection,
+ ( which will handle:
+ send the request to the server using HTTP,
+ wait for the response,
+ read response in XML format,
+ )
+ decode the response to mercury types,
+ return list_of_univ as response.
+
+soap_call_xml_type:
+ tcp__connect to the server,
+ service_connection,
+ ( which will handle:
+ send the request to the server using HTTP,
+ wait for the response,
+ read response in XML format,
+ )
+ return response.
+
+*/
+
+soap_call_mercury_type(Host, Port, Method, SOAPuri, Parameters,
+ Responses) -->
+ (
+ { Method = "GetStockPrice" }
+ ->
+ { generate_SP_request(Host, Method, SOAPuri,
+ Parameters, Request) }
+ ;
+ { Method = "Hello" }
+ ->
+ { generate_Hello_request(Host, Method, SOAPuri,
+ Parameters, Request) }
+ ;
+ { error("Method not supported") }
+ ),
+ tcp__connect(Host, Port, Result),
+ (
+ { Result = ok(Connect) },
+ service_connection(Connect, Request, XMLResponse)
+ ;
+ { Result = error(String) },
+ { error(String) }
+ ),
+ { decode_response(Method, XMLResponse, Responses) }.
+
+
+ % Translates XML response to Mercury types.
+:- pred decode_response(string::in, string::in, list(univ)::out) is det.
+
+decode_response(Method, XMLResponse, Responses) :-
+ (
+ Method = "GetStockPrice"
+ ->
+ decode_SP_response(XMLResponse, Responses)
+ ;
+ Method = "Hello"
+ ->
+ decode_Hello_response(XMLResponse, Responses)
+ ;
+ error("Method not supported")
+ ).
+
+%--------------------------------------------------------------------------%
+% GetStockPrice
+%--------------------------------------------------------------------------%
+
+ % Assume library file to be loaded in server is
+ % libsoap_test_methods.so
+ % client shouldn't need to know the library file name?
+
+ % Generates HTTP header information and SOAP message in the body.
+:- pred generate_SP_request(host, string, string, list(univ), string).
+:- mode generate_SP_request(in, in, in, in, out) is det.
+
+generate_SP_request(Host, Method, SOAPuri, Parameters, Request) :-
+ generate_SP_body(Method, Parameters, Body),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+ % Generates SOAP message.
+ % XXX assume no namespace and client has a copy of the schema
+ % used in the server side to encode mercury types.
+:- pred generate_SP_body(string, list(univ), string).
+:- mode generate_SP_body(in, in, out).
+
+ % schema for GetStockPrice:
+ % <element name="stocknum" type="xsd:int">
+
+generate_SP_body(MethodName, Parameters, Body) :-
+ % since client knows that this function takes in only
+ % one parameter, there is no need to call list_foldl to
+ % translate the parameters.
+ list__index1_det(Parameters, 1, Parameter),
+ generate_SP_param(Parameter, ParamAsString),
+ Body = "<Envelope><Body><" ++ MethodName ++ ">" ++
+ ParamAsString ++ "</" ++ MethodName ++
+ "></Body></Envelope>".
+
+:- pred generate_SP_param(univ, string).
+:- mode generate_SP_param(in, out) is det.
+
+generate_SP_param(ParamAsUniv, Tag) :-
+ det_univ_to_type(ParamAsUniv, ParamAsValue),
+ string__int_to_string(ParamAsValue, ParamAsString),
+ Tag = "<stocknum>" ++ ParamAsString ++ "</stocknum>".
+
+:- pred decode_SP_response(string::in, list(univ)::out) is det.
+
+decode_SP_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<price>", Start),
+ string__sub_string_search(XMLResponse, "</price>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 7, % <price>
+ string__right(Response0, End-Start-TagLength, Response1),
+ (
+ string__to_int(Response1, ResponseAsInt)
+ ->
+ Response = ResponseAsInt
+ ;
+ error("decode error")
+ ),
+ Responses = [univ(Response)]
+ ;
+ error("decode error")
+ ).
+
+%-------------------------------------------------------------------------%
+% Hello
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header information and SOAP message in the body.
+:- pred generate_Hello_request(host, string, string, list(univ), string).
+:- mode generate_Hello_request(in, in, in, in, out) is det.
+
+generate_Hello_request(Host, Method, SOAPuri, Parameters, Request) :-
+ generate_Hello_body(Method, Parameters, Body),
+ string__length(Body, Length),
+ generate_header(Host, Length, SOAPuri, Header),
+ Request = insert_cr(Header) ++ Body.
+
+ % Generates SOAP message.
+ % Hello pred has no input.
+:- pred generate_Hello_body(string, list(univ), string).
+:- mode generate_Hello_body(in, in, out).
+
+generate_Hello_body(MethodName, _Parameters, Body) :-
+ Body = "<Envelope><Body><" ++ MethodName ++ ">" ++
+ "</" ++ MethodName ++ "></Body></Envelope>".
+
+:- pred decode_Hello_response(string::in, list(univ)::out) is det.
+
+decode_Hello_response(XMLResponse, Responses) :-
+ (
+ string__sub_string_search(XMLResponse, "<output>", Start),
+ string__sub_string_search(XMLResponse, "</output>", End)
+ ->
+ string__left(XMLResponse, End, Response0),
+ TagLength = 8, % <output>
+ string__right(Response0, End-Start-TagLength, Response1),
+ Responses = [univ(Response1)]
+ ;
+ error("decode error")
+ ).
+
+%-------------------------------------------------------------------------%
+% Shared functions
+%-------------------------------------------------------------------------%
+
+ % Generates HTTP header.
+:- pred generate_header(string::in, int::in, string::in,
+ string::out) is det.
+
+generate_header(Host, Length, SOAPuri, Headers) :-
+ Header1 = "POST /libsoap_test_methods.so HTTP/1.1",
+ Header2 = "Host: " ++ Host,
+ Header3 = "Content-Type: text/xml",
+ string__int_to_string(Length, LengthAsString),
+ Header4 = "Content-Length: " ++ LengthAsString,
+ Header5 = "SOAPAction: \"" ++ SOAPuri,
+ Headers = insert_cr(Header1) ++ insert_cr(Header2) ++
+ insert_cr(Header3) ++ insert_cr(Header4) ++
+ insert_cr(Header5).
+
+ % Insert carriage return into the line.
+:- func insert_cr(string) = string.
+insert_cr(Line) = Line ++ "\r\n".
+
+%------------------------------------------------------------------------%
+
+ % Connects to the server using TCP/IP, sends request to server
+ % using HTTP, receives response from server and terminates
+ % the connection.
+:- pred service_connection(tcp::in, string::in, string::out,
+ % io__state::di, io__state::uo) is cc_multi.
+ io__state::di, io__state::uo) is det.
+
+service_connection(TCP, Request, Response) -->
+ send_request(TCP, Request),
+ read_response(TCP, Response),
+ tcp__shutdown(TCP).
+
+ % Sends the request to the server side.
+:- pred send_request(S, string, io__state, io__state) <= stream__output(S).
+:- mode send_request(in, in, di, uo) is det.
+
+send_request(S, Requests) -->
+ stream__write_string(S, Requests).
+
+ % Reads responses from server.
+:- pred read_response(S, string, io__state, io__state) <= stream__input(S).
+:- mode read_response(in, out, di, uo) is det.
+
+read_response(S, Response) -->
+ stream__read_line(S, LineResult),
+ (
+ { LineResult = ok(Line) },
+ { string__from_char_list(Line, String) },
+ { Response = String ++ Response0 },
+ read_response(S, Response0)
+ ;
+ { LineResult = eof },
+ { Response = "" }
+ ;
+ { LineResult = error(Error) },
+ { error(string__format("read_response: %s.", [s(Error)])) }
+ ).
+
+%-------------------------------------------------------------------------%
|
|
From: Ina C. <in...@st...> - 2001-02-08 04:30:03
|
Hi,
I've addressed Peter's comments and here is the new diff.
If everything looks ok, I would like to commit the changes.
Ina
<in...@st...>
========================================================================
Estimated hours taken: 5
Address Peter's comment for last diff ( the diff for adding example
to handle mercury structure).
/server/server.m
add predicates to check request header.
change the header to request a library filename to be loaded for dl.
/server/soap.m
clean up some code.
(Peter mentioned that I should do this in a separate change,
but I can't remember how to change it back to the original,
sorry, please bear with it now. I'll remember it next time.)
/server/soap_test_methods.m
/server/web_methods.m
add example to handle mercury structure
========================================================================
Index: server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.5
diff -u -r1.5 server.m
--- server.m 2001/01/25 06:54:42 1.5
+++ server.m 2001/02/08 04:19:06
@@ -1,5 +1,5 @@
%---------------------------------------------------------------------------%
-% Copyright (C) 2000 Peter Ross
+% Copyright (C) 2000, 2001 Peter Ross
% This file may only be copied under the terms of the GNU General Public
% License - see the file COPYING
%-----------------------------------------------------------------------------%
@@ -82,12 +82,29 @@
{ RequestOrResponse = left(Request) },
(
{ Request^cmd = post },
- get_soapmessage(TCP, Request, Request1)
+ { check_headers(Request^headers, MaybeError) },
+ (
+ { MaybeError = yes(ErrorResponse) }
+ ->
+ send_response(TCP, ErrorResponse),
+ tcp__shutdown(TCP),
+ { error("Invalid HTTP headers in request.\n") }
+ ;
+ get_soapmessage(TCP, Request, Request1),
+ (
+ { Request1 = right(ErrorResponse1) },
+ send_response(TCP, ErrorResponse1),
+ tcp__shutdown(TCP),
+ { error("Invalid SOAP body.\n") }
+ ;
+ { Request1 = left(Request2) }
+ )
+ )
;
{ Request^cmd = get },
- { Request1 = Request }
+ { Request2 = Request }
),
- generate_response(Request1, Response)
+ generate_response(Request2, Response)
;
{ RequestOrResponse = right(Response) }
),
@@ -225,25 +242,92 @@
%---------------------------------------------------------------------------%
+
+ % Section 6 Using SOAP in HTTP
+ % " HTTP applications MUST use the media type "text/xml"
+ % according to RFC 2376 when including SOAP entity bodies
+ % in HTTP messages.
+ %
+ % Section 6.1.1. The SOAPAction HTTP Header Field
+ % " An HTTP client MUST use this header field when issuing a
+ % SOAP HTTP Request. "
+
+
+:- pred check_headers(list(header)::in, maybe(response)::out) is det.
+
+check_headers(Headers, Response) :-
+ check_each_header(Headers, soapaction_header,
+ "SOAPAction header not found.\n", MayBeResponse0),
+ (
+ MayBeResponse0 = no
+ ->
+ check_each_header(Headers, content_type_header,
+ "Incorrect Content-Type value.\n", MayBeResponse1),
+ (
+ MayBeResponse1 = no
+ ->
+ Response = no
+ ;
+ Response = MayBeResponse1
+ )
+ ;
+ Response = MayBeResponse0
+ ).
+
+:- pred check_each_header(list(header), pred(header), string, maybe(response)).
+:- mode check_each_header(in, pred(in) is semidet, in, out) is det.
+
+check_each_header(Headers, Pred, ErrorMessage, Response) :-
+ list__filter(Pred, Headers, Result),
+ (
+ Result \= [],
+ list__length(Result, 1) % ensure header only occur once
+ ->
+ Response = no
+ ;
+ Response = yes(response(
+ 400,
+ [],
+ string_body(ErrorMessage),
+ yes )
+ )
+
+ ).
+
+:- pred soapaction_header(header::in) is semidet.
+soapaction_header(header("SOAPAction:", _, _)).
+
+:- pred content_type_header(header::in) is semidet.
+content_type_header(header("Content-Type:", "text/xml", _)).
+content_type_header(header("Content-type:", "text/xml", _)).
+content_type_header(header("Content-Type:", "text/xml;", _)).
+content_type_header(header("Content-type:", "text/xml;", _)).
+
+%---------------------------------------------------------------------------%
-:- pred get_soapmessage(S, request, request, io__state, io__state)
- <= stream__duplex(S).
+:- pred get_soapmessage(S, request, either(request, response),
+ io__state, io__state) <= stream__input(S).
:- mode get_soapmessage(in, in, out, di, uo) is det.
-get_soapmessage(S, Request, Request0) -->
+get_soapmessage(S, Request, RequestOrResponse) -->
(
{ get_content_length(Request^headers, Length) }
->
get_body(S, Length, SoapMessage),
- { Request0 = request(
- Request^cmd,
- Request^uri,
- Request^version,
- Request^headers,
- yes(string__from_char_list(SoapMessage))
- ) }
- ;
- { error("No content-length supplied. Program Terminated.") }
+ { RequestOrResponse = left(request(
+ Request^cmd,
+ Request^uri,
+ Request^version,
+ Request^headers,
+ yes(string__from_char_list(SoapMessage))))
+ }
+ ;
+ { RequestOrResponse = right(response(
+ 411,
+ [],
+ string_body("Content-Length not supplied.\n"),
+ yes))
+ }
).
:- pred get_content_length(list(header)::in, int::out) is semidet.
@@ -268,13 +352,12 @@
is_content_type("Content-type:").
:- pred get_body(S, int, list(char), io__state, io__state)
- <= stream__duplex(S).
+ <= stream__input(S).
:- mode get_body(in, in, out, di, uo) is det.
-
-% XXX if there are still characters when length = 0
-% the rest will not be obtained and consequently parsing
-% an incomplete message will throw an exception.
+ % If there are still characters when length = 0,
+ % the rest will not be obtained and consequently parsing
+ % an incomplete message will throw an exception.
get_body(S, Length, RequestLines) -->
stream__read_char(S, CharResult),
{ Length0 = Length - 1 },
@@ -337,7 +420,8 @@
(
{ Request^body = yes(Body) } ,
parse_soapmessage(Body, NsBody),
- write(NsBody), nl, nl,
+ % XXX parse_soapmessage calls error/1 when failed
+ % should change to response with http code = 415
{ get_procedure_call(NsBody, Proc) },
write(Proc), nl, nl,
@@ -345,15 +429,15 @@
{ make_web_request(NsBody, Proc, WebRequest) },
write(WebRequest), nl, nl,
- load_dynamic_library("./libsoap_test_methods.so",
- WebRequest, Result, HttpCode),
+ load_dynamic_library(uri_to_filename(Request^uri),
+ WebRequest, Result, HttpCode, ErrorFlag),
(
- { Result = yes(Output) },
+ { ErrorFlag = no },
{ generate_response_body(NsBody, Proc,
- Output, ResBody0) },
+ Result, ResBody0) },
{ ResBody = string_body(ResBody0) }
;
- { Result = no },
+ { ErrorFlag = yes },
{ ResBody = no_body }
)
;
@@ -361,9 +445,11 @@
% 400 = Bad Request
{ Request^body = no },
{ ResBody = no_body },
+ { Result = "Body not found" },
{ HttpCode = 400 }
),
- { list__filter(filter, Request^headers, Headers) },
+ { generate_headers(Request^headers, ResBody, Result,
+ Headers) },
{ Response = response(HttpCode, Headers,
ResBody, yes) }
).
@@ -379,10 +465,27 @@
:- func last_char(string) = char.
last_char(Str)
= string__unsafe_index(Str, string__length(Str) - 1).
+
+:- pred generate_headers(list(header)::in, response_body::in, string::in,
+ list(header)::out) is det.
+generate_headers(RequestHeaders, ResBody, ErrorMsg, Headers) :-
+ list__filter(is_content_type_header, RequestHeaders, Headers0),
+ (
+ ResBody = string_body(Body),
+ string__length(Body, BodyLength),
+ string__int_to_string(BodyLength, StringLength),
+ ConLen = [header("Content-Length:", StringLength, no)],
+ list__append(ConLen, Headers0, Headers)
+ ;
+ % includes error messages resulted from loading library
+ % in the header
+ ResBody = no_body,
+ Headers = [header(ErrorMsg, "", no)]
+ ).
-:- pred filter(header::in) is semidet.
-filter(header("Content-Length:", _, _)).
-filter(header("Content-Type:", _, _)).
+:- pred is_content_type_header(header::in) is semidet.
+is_content_type_header(header("Content-Type:", _, _)).
+is_content_type_header(header("Content-type:", _, _)).
%-----------------------------------------------------------------------------%
Index: soap.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
retrieving revision 1.1
diff -u -r1.1 soap.m
--- soap.m 2001/01/25 06:54:42 1.1
+++ soap.m 2001/02/08 04:19:06
@@ -78,6 +78,9 @@
{ Res = ok((_, Doc)) },
{ nsTranslate(Doc, NsDoc) }
;
+ % XXX instead of error, should change to response
+ % with http code 415 Unsupported Media Type
+
{ Res = error(Err) },
{ string__append("parse_soapmessage failed: ", Err, ErrMsg) },
{ error(ErrMsg) }
@@ -130,13 +133,8 @@
% Gets method name.
get_procedure_call(NsDoc, Procedure) :-
get_procedure(NsDoc, [], Procedurelist),
- get_first_element(Procedurelist, Procedure).
-
-:- pred get_first_element(list(T)::in, T::out) is det.
+ list__index1_det(Procedurelist, 1, Procedure).
-get_first_element([], _) :- error("Procedure not found.").
-get_first_element([H|_], H).
-
:- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
:- mode get_procedure(in, in, out) is det.
get_procedure(NsDoc, Acc0, Acc) :-
@@ -369,7 +367,7 @@
get_prefix(URIListRev, Method^eName^nsURI, Method^eName^localName,
ElementName),
string__append("<", ElementName, ResBody0),
- string__append(ResBody0, "Response ", ResBody1),
+ string__append(ResBody0, "Response", ResBody1),
format_attrs(Method^eAttrs, Method^eNamespaces, URIListRev, Attrs),
string__append_list(Attrs, AttrsString),
@@ -378,7 +376,7 @@
string__append(ResBody2, Result, ResBody3),
string__append(ResBody3, "\n", ResBody4),
- make_end_tag(ElementName, EndTag),
+ make_end_tag((ElementName ++ "Response"), EndTag),
string__append(ResBody4, EndTag, ResBody).
@@ -411,10 +409,6 @@
Acc0, Acc1),
call(Pred, ContentArray, Ref, Method, Result, URIs,
Acc1, Acc).
-
-% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
-% insert_last([], T, [T]).
-% insert_last([
:- pred my_delete(list(T)::in, list(T)::out) is det.
my_delete([], []).
Index: soap_test_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.1
diff -u -r1.1 soap_test_methods.m
--- soap_test_methods.m 2001/01/25 06:54:42 1.1
+++ soap_test_methods.m 2001/02/08 04:19:06
@@ -21,20 +21,34 @@
:- module soap_test_methods.
:- interface.
-:- import_module io, int, list, std_util.
+:- import_module list, std_util.
-:- pred hello(state::di, state::uo) is det.
+:- pred hello(univ::out) is det.
:- pred get_sp(list(univ)::in, univ::out) is det.
:- func get_stockprice(list(univ)) = univ.
+% :- pred get_bookprice(book::in, univ::out) is det.
:- pred get_bookprice(list(univ)::in, univ::out) is det.
+:- type book
+ ---> book(
+ title :: string,
+ author :: author,
+ intro :: string
+ ).
+
+:- type author
+ ---> author(
+ surname :: string,
+ firstname :: string
+ ).
+
%---------------------------------------------------------------------%
:- implementation.
-:- import_module require.
+:- import_module int, require.
% remove_first_element(List, Elem, Rest)
% takes out first element of the List and gives back
@@ -51,7 +65,8 @@
% Hello
%---------------------------------------------------------------------%
-hello --> print("Hello, world\n").
+hello(ResultAsUniv) :-
+ ResultAsUniv = univ("<output>Hello, world</output>").
%---------------------------------------------------------------------%
% GetStockPrice
@@ -87,8 +102,22 @@
%---------------------------------------------------------------------%
% GetBookPrice
%---------------------------------------------------------------------%
-
-get_bookprice(ParamList, ResultAsUniv) :-
- ResultAsUniv = univ(100).
+get_bookprice(ParamList, ResultAsUniv) :-
+ list__index1_det(ParamList, 1, ParamAsUniv),
+ Param0 = univ_value(ParamAsUniv),
+ Param = inst_cast_book(Param0),
+ (
+ Param = book("Hello world",
+ author("Foo", "Bar"),
+ "This is a book")
+ ->
+ ResultAsUniv = univ(100)
+ ;
+ ResultAsUniv = univ(50)
+ ).
+:- func inst_cast_book(T) = book.
+:- mode inst_cast_book(in) = out is det.
+:- pragma c_code(inst_cast_book(X::in) = (Y::out),
+ [will_not_call_mercury, thread_safe], "Y = X").
Index: web_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.1
diff -u -r1.1 web_methods.m
--- web_methods.m 2001/01/25 06:54:42 1.1
+++ web_methods.m 2001/02/08 04:19:06
@@ -21,7 +21,7 @@
:- module web_methods.
:- interface.
-:- import_module io, list, string, std_util.
+:- import_module bool, io, list, string, std_util.
:- import_module http.
:- import_module xml, xml:ns.
@@ -42,92 +42,25 @@
pFields :: maybe(list(parameter))
% Struct or Array
).
-/* Ignore this
- % Converts method name and parameters in xml.ns format to
- % a web request.
-:- pred make_web_request(nsElement, list(parameter), web_method_request).
-:- mode make_web_request(in, in, out) is det.
-*/
-
% Loads library, invokes method call and generates corresponding
% response.
:- pred load_dynamic_library(string::in, web_method_request::in,
- maybe(string)::out, http_code::out, io__state::di, io__state::uo)
- is det.
+ string::out, http_code::out, bool::out,
+ io__state::di, io__state::uo) is det.
:- pred search_attributes(list(nsAttribute)::in, string::out) is semidet.
%-----------------------------------------------------------------------%
:- implementation.
-:- import_module bool, int, require.
+:- import_module int, require.
:- import_module dl, name_mangle, soap_test_methods.
-
- % XXX change that to command line argument
-:- func soap_library_file = string.
-soap_library_file = "soap_test_methods".
-
-/* Ignore this. Not used anymore
-
- % Generates a web request using method and parameters
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- Request^params = Params.
-
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- form_pair(Params, ParamsPair),
- list__map(retrieve_params, ParamsPair, Request^params).
-
- % Transform parameter list from [parameter, data, parameter, data ..]
- % to [(parameter - data)] to distinguish elements
-:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
-:- mode form_pair(in, out) is det.
-
-form_pair(ParamList , PairList) :-
- (
- ParamList = []
- ->
- PairList = []
- ;
- ParamList = [Param, Data | Tail]
- % list__split_list(2, ParamList, Start, End),
- % Start = [Param, Data]
- ->
- PairList = [(Param - Data) | PairList0],
- form_pair(Tail, PairList0)
- ;
- error("Incorrect Data Format")
- ).
+% :- func soap_library_file = string.
+% soap_library_file = "soap_test_methods".
- % Retrieve parameter name, uri, type if defined and data value.
-:- pred retrieve_params(pair(nsContent, nsContent), parameter).
-:- mode retrieve_params(in, out) is det.
-retrieve_params((Param0 - Data), Parameter) :-
- (
- Param0 = nsElement(Param),
- Data = data(Value)
- ->
- Name = Param^eName^localName,
- URI = Param^eName^nsURI,
- (
- search_attributes(Param^eAttrs, Type0)
- ->
- Type = yes(Type0)
- ;
- Type = no
- ),
- Parameter = parameter(Name, Type, Value, URI)
- ;
- error("Incorrect Data Format")
- ).
-*/
-
% Types in XML can be defined either by using xsi:type attribute
% or by using schema. This predicate is used to search if
% any attribute contains `xsi:type'.
@@ -172,12 +105,17 @@
% Opens library file, invokes desire function, and gets back
% corresponding response and http code.
-load_dynamic_library(L, Request, Response, HttpCode) -->
- dl__open(L, lazy, local, MaybeHandle),
+ %
+ % LibFile format = "./libfilename.so"
+ %
+load_dynamic_library(LibFile, Request, Response, HttpCode, ErrorFlag) -->
+ dl__open(LibFile, lazy, local, MaybeHandle),
+ { get_filename(LibFile, Filename) },
(
{ MaybeHandle = error(OpenMsg) },
{ string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
- { Response = yes(OpenErrorMsg) },
+ { Response = OpenErrorMsg },
+ { ErrorFlag = yes },
{ HttpCode = 500 } % 500 Internal Server Error
;
{ MaybeHandle = ok(Handle) },
@@ -185,38 +123,46 @@
% Hello has no parameter
{ Request^name = "Hello" }
->
- call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ call_Hello_pred(Handle, Filename, Request,
+ Response0, HttpCode0, ErrorFlag0)
;
% GetStockPrice has 1 parameter
{ Request^name = "GetStockPrice" }
->
- call_SP_func(Handle, Request, Response0, HttpCode0)
+ call_SP_func(Handle, Filename, Request,
+ Response0, HttpCode0, ErrorFlag0)
;
% GetBookPrice takes in a struct
{ Request^name = "GetBookPrice" }
->
- call_BP_pred(Handle, Request, Response0, HttpCode0)
+ call_BP_pred(Handle, Filename, Request,
+ Response0, HttpCode0, ErrorFlag0)
;
- { Response0 = yes("Method requested not
- implemented.") },
+ { Response0 = "Method requested not implemented." },
+ { ErrorFlag0 = yes },
{ HttpCode0 = 501 } % 501 Not Implemented
),
+/* commented out dl__close/4 so that the .so can be referred to it
+ when generating responses. If the .so file is closed, any pointers
+ referencing the .so file will become unavailable, causing
+ runtime error: segmentation violation.
+
dl__close(Handle, Result),
(
{ Result = error(CloseMsg) },
{ string__append("dlclose failed: ", CloseMsg,
CloseErrorMsg) },
- { Response1 = yes(CloseErrorMsg) },
+ { Response1 = no },
{ HttpCode1 = 500 },
- { ChangeHttpCode = yes }
+ { ChangeHttpCode = yes },
+ { error(CloseErrorMsg) }
;
{ Result = ok },
{ Response1 = Response0 },
{ HttpCode1 = HttpCode0 },
{ ChangeHttpCode = no }
),
-
(
{ ChangeHttpCode = yes }
->
@@ -226,24 +172,29 @@
{ Response = Response0 },
{ HttpCode = HttpCode0 }
)
+*/
+ { Response = Response0 },
+ { ErrorFlag = ErrorFlag0 },
+ { HttpCode = HttpCode0 }
).
%-----------------------------------------------------------------------%
% Hello
%-----------------------------------------------------------------------%
-:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
-
-call_Hello_pred(Handle, _Request, Response, HttpCode) -->
- { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
- "hello", 2, 0) },
+:- pred call_Hello_pred(handle, string, web_method_request,
+ string, http_code, bool, io__state, io__state).
+:- mode call_Hello_pred(in, in, in, out, out, out, di, uo) is det.
+
+call_Hello_pred(Handle, Filename, _Request, Response, HttpCode, ErrorFlag) -->
+ { HelloProc = mercury_proc(predicate, unqualified(Filename),
+ "hello", 1, 0) },
dl__mercury_sym(Handle, HelloProc, MaybeHello),
(
{ MaybeHello = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
+ { Response = ErrorMsg },
+ { ErrorFlag = yes },
{ HttpCode = 500 }
;
{ MaybeHello = ok(HelloPred0) },
@@ -254,9 +205,11 @@
% Call the procedure whose address
% we just obtained.
- HelloPred,
+ { HelloPred(HelloUniv) },
+ { det_univ_to_type(HelloUniv, HelloString) },
- { Response = yes("<output>Hello World</output>") },
+ { Response = HelloString },
+ { ErrorFlag = no },
{ HttpCode = 200 }
).
@@ -265,74 +218,71 @@
% `hello' procedure is `pred(di, uo) is det', before we can actually
% call it. The function inst_cast_hello/1 defined below does that.
-:- type io_pred == pred(io__state, io__state).
-:- inst io_pred == (pred(di, uo) is det).
+:- type hello_pred == pred(univ).
+:- inst hello_pred == (pred(out) is det).
-:- func inst_cast_hello(io_pred) = io_pred.
-:- mode inst_cast_hello(in) = out(io_pred) is det.
-:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+:- func inst_cast_hello(hello_pred) = hello_pred.
+:- mode inst_cast_hello(in) = out(hello_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)),
[will_not_call_mercury, thread_safe], "Y = X").
%-----------------------------------------------------------------------%
% GetStockPrice
%-----------------------------------------------------------------------%
-:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_SP_func(in, in, out, out, di, uo) is det.
+:- pred call_SP_func(handle, string, web_method_request,
+ string, http_code, bool, io__state, io__state).
+:- mode call_SP_func(in, in, in, out, out, out, di, uo) is det.
-call_SP_func(Handle, Request, Response, HttpCode) -->
- { list__length(Request^params, Arity) },
-
+call_SP_func(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
% XXX test for function
- % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
- % "get_stockprice", Arity, 0) },
+ { list__length(Request^params, Arity) },
+ { GetSPProc = mercury_proc(function, unqualified(Filename),
+ "get_stockprice", Arity, 0) },
% XXX test for predicate
- { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_sp", 2, 0) },
+ % { GetSPProc = mercury_proc(predicate, unqualified(Filename),
+ % "get_sp", 2, 0) },
dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
(
{ MaybeGetStockPrice = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
- { HttpCode = 500 }
+ { Response = ErrorMsg },
+ { ErrorFlag = yes },
+ { HttpCode = 500 }
;
{ MaybeGetStockPrice = ok(SPProc0) },
% Cast the higher-order term that we obtained
% to the correct higher-order inst.
% XXX test for predicate
- { SPProc = inst_cast_sp(SPProc0) },
+ % { SPProc = inst_cast_sp(SPProc0) },
% XXX test for function
- % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
-
- % message is parsed bottom up, therefore parameter
- % list is in reverse order
- % { list__reverse(Request^params, ParameterList) },
+ { wrapper(SPFunc) = inst_cast_stockprice(wrapper(SPProc0)) },
% Convert parameters (string) to the corresponding types
{ list__map(lookup_SP_schema, Request^params, UnivList) },
% Call the procedure whose address we just obtained
% XXX test for predicate
- { call(SPProc, UnivList, SPUniv) },
+ % { call(SPProc, UnivList, SPUniv) },
% XXX test for function
- % { SPUniv = SPFunc(UnivList) },
+ { SPUniv = SPFunc(UnivList) },
{ det_univ_to_type(SPUniv, SPInt) },
{ string__int_to_string(SPInt, SPString) },
{ string__append("<price>", SPString, SPresult0) },
{ string__append(SPresult0, "</price>", SPresult) },
- { Response = yes(SPresult) },
+ { Response = SPresult },
+ { ErrorFlag = no },
{ HttpCode = 200 }
).
% schema for GetStockPrice:
- % <element name="stocknum" type="mercury:int"/>
+ % <element name="stocknum" type="xsd:int"/>
% </element>
% Lookup element name in schema, find the corresponding type
@@ -362,13 +312,13 @@
;
% assume Type must be simple type eg. int, float
% XXX type may contain prefix
- % Eg. mercury:int, mercury:float
+ % Eg. xsd:int, xsd:float
% XXX Do I have to make sure the prefix = mercury?
- % Case 3 <stocknum xsi:type="mercury:int">1</stocknum>
+ % Case 3 <stocknum xsi:type="xsd:int">1</stocknum>
% web_method_request("GetStockPrice",
- % [parameter("stocknum", yes("mercury:int"), "",
+ % [parameter("stocknum", yes("xsd:int"), "",
% yes("1"), no)], "some uri")
Param^pType = yes(Type),
@@ -424,19 +374,20 @@
% schema for GetBookPrice:
%
% <element name="book" type="tns:book"/>
+ % <element name="author" base="tns:author"/>
+ %
% <complexType name="book">
% <sequence>
- % <element name="title" type="mercury:string"/>
+ % <element name="title" type="xsd:string"/>
% <element name="author" type="tns:author"/>
- % <element name="intro" type="mercury:string"/>
+ % <element name="intro" type="xsd:string"/>
% </sequence>
% </complexType>
%
- % <element name="author" base="tns:author"/>
% <complexType name="author">
% <sequence>
- % <element name"surname" type="mercury:string"/>
- % <element name"firstname" type="mercury:string"/>
+ % <element name"surname" type="xsd:string"/>
+ % <element name"firstname" type="xsd:string"/>
% </sequence>
% </complexType>
%
@@ -448,28 +399,27 @@
% author :: author,
% intro :: string
% ).
- %
+ %
% :- type author
% ---> author(
% surname :: string,
% firstname :: string
% ).
-:- pred call_BP_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_BP_pred(in, in, out, out, di, uo) is det.
-
-call_BP_pred(Handle, Request, Response, HttpCode) -->
- { list__length(Request^params, Arity0) },
- { Arity = Arity0 + 1 }, % since it is a predicate
- { GetBPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_bookprice", Arity, 0) },
+:- pred call_BP_pred(handle, string, web_method_request,
+ string, http_code, bool, io__state, io__state).
+:- mode call_BP_pred(in, in, in, out, out, out, di, uo) is det.
+
+call_BP_pred(Handle, Filename, Request, Response, HttpCode, ErrorFlag) -->
+ { GetBPProc = mercury_proc(predicate, unqualified(Filename),
+ "get_bookprice", 2, 0) },
dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
(
{ MaybeGetBookPrice = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
- { HttpCode = 500 }
+ { Response = ErrorMsg },
+ { ErrorFlag = yes },
+ { HttpCode = 500 }
;
{ MaybeGetBookPrice = ok(BPProc0) },
@@ -478,79 +428,91 @@
{ BPProc = inst_cast_bp(BPProc0) },
% Convert parameters (string) to the corresponding types
- % { list__map(lookup_BP_schema, Request^params, UnivList) },
-
+ { list__map(lookup_BP_schema, Request^params, UnivList) },
+
% Call the procedure whose address we just obtained
- { UnivList = [univ(1)] },
{ call(BPProc, UnivList, BPUniv) },
+
{ det_univ_to_type(BPUniv, BPInt) },
{ string__int_to_string(BPInt, BPString) },
{ string__append("<price>", BPString, BPresult0) },
{ string__append(BPresult0, "</price>", BPresult) },
- { Response = yes(BPresult) },
+ { Response = BPresult },
+ { ErrorFlag = no },
{ HttpCode = 200 }
).
-/* still working
-
-:- pred searchBPList(list(parameter), string, maybe(list(parameter)),
- maybe(string)).
-:- mode searchBPList(in, in, out, out) is semidet.
-
-searchBPList(ParamList, ElemName, Struct, Value) :-
- Elem = parameter(ElemName, _, _, _, _),
- (
- list__nth_member_search(ParamList, Elem, Pos),
- list__index1(ParamList, Pos, Param)
- ->
- Struct = Param^pFields,
- Value = Param^pValue
- ;
- fail
- ).
-
:- pred lookup_BP_schema(parameter::in, univ::out) is det.
lookup_BP_schema(Param, ValueAsUniv) :-
(
Param^pName = "book",
- Param^pFields = yes(StructList),
- (
- searchBPList(StructList, "title", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- searchBPList(StructList, "author", Child, _),
- Child = yes(ChildStructList)
- ->
- (
- searchBPList(ChildStructList, "author", _, _ )
- ;
- require__error(
- "Element Structure not defined in schema.")
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "title", Title0),
+ lookup_BP_schema(Title0, TitleAsUniv),
+ det_univ_to_type(TitleAsUniv, Title),
+
+ get_BP_param(FieldList, "author", Author0),
+ lookup_BP_schema(Author0, AuthorAsUniv),
+ det_univ_to_type(AuthorAsUniv, Author),
+
+ get_BP_param(FieldList, "intro", Intro0),
+ lookup_BP_schema(Intro0, IntroAsUniv),
+ det_univ_to_type(IntroAsUniv, Intro),
- )
- ;
- searchBPList(StructList, "intro", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- require__error(
- "Element Structure not defined in schema.")
- )
+ ValueAsBook = book(Title, Author, Intro),
+ ValueAsUniv = univ(ValueAsBook)
+ ;
+ Param^pName = "title",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "author",
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "surname", Surname0),
+ lookup_BP_schema(Surname0, SurnameAsUniv),
+ det_univ_to_type(SurnameAsUniv, Surname),
+
+ get_BP_param(FieldList, "firstname", Firstname0),
+ lookup_BP_schema(Firstname0, FirstnameAsUniv),
+ det_univ_to_type(FirstnameAsUniv, Firstname),
+
+ ValueAsAuthor = author(Surname, Firstname),
+ ValueAsUniv = univ(ValueAsAuthor)
+ ;
+ Param^pName = "surname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "firstname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
;
+ Param^pName = "intro",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
require__error("Element Structure not defined in schema.")
).
-*/
+:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is det.
+
+get_BP_param(ParamList, SearchString, Parameter) :-
+ list__filter((pred(X::in) is semidet :-
+ X = parameter(SearchString,_,_,_,_)), ParamList, Result),
+ list__index1_det(Result, 1, Parameter).
+
% inst cast for get_bookprice
:- type bp_pred == pred(list(univ), univ).
+% :- type bp_pred == pred(book, univ).
:- inst bp_pred == (pred(in, out) is det).
:- func inst_cast_bp(bp_pred) = bp_pred.
@@ -561,6 +523,14 @@
%-----------------------------------------------------------------------%
% Shared functions
%-----------------------------------------------------------------------%
+
+ % Returns filename from ./libfilename.so
+:- pred get_filename(string::in, string::out) is det.
+
+get_filename(LibFile, Filename) :-
+ string__split(LibFile, 5, _Left, Filename0),
+ string__length(Filename0, Length),
+ string__left(Filename0, Length-3, Filename).
% Separates prefix and suffix.
:- pred split_on_colon(string::in, string::out, string::out) is det.
|
|
From: Fergus H. <fj...@cs...> - 2001-02-06 04:21:07
|
On 06-Feb-2001, Ina Cheng <in...@st...> wrote:
> Here is a modified version of the design.
That design looks good.
Just a couple of small points:
> :- module client_interface.
>
> This function takes in an uri (which specifies the host and port number
> that the client is connected to), method name (which specifies which
> RPC to call), and a list of univ (which are the parameters to the RPC).
>
> soap_call_mercury_type(uri, method_name, list_of_univ) :-
> generate SOAP message in XML format and SOAP protocol,
> tcp__connect to the server,
> send the request to the server using HTTP,
> wait for the response,
> read response in XML format,
> decode the response to mercury types.
You need to return another list_of_univ containing the result.
These three lines
send the request to the server using HTTP,
wait for the response,
read response in XML format,
should be abstracted out into a separate procedure,
or can just be replaced by a call to soal_call_xml_type.
> Assumptions:
> When generating SOAP messages for the parameters (list_of_univ),
> we assume the client will have a copy of the schema that is used
> in the server side for encoding and decoding types in XML.
>
>
> soap_call_xml_type(uri, method_name, xml_document) :-
> tcp__connect to the server,
> send the xml_document to the server using HTTP
> wait for response,
> display response.
This should just return the xml response, rather than displaying it.
--
Fergus Henderson <fj...@cs...> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
|
|
From: Ina C. <in...@st...> - 2001-02-06 01:05:46
|
Here is a modified version of the design.
Ina
====================================================================
Interface between the client and server side:
One of the modules will provide an interface for programmers to
send messages to the SOAP server. It will provide as basic
functionality the ability to do RPC over SOAP. The hard-coded
XML encoding for Mercury datatypes (the same encoding as the
SOAP server currently expects) will be used to encode the RPC
calls.
In addition, an interface will be provided that allows an
arbitrary XML message to be passed using SOAP (and the response
will be returned as XML too). This will allow programmers to
use their own encodings and communicate with any SOAP based
service.
Eg:
:- module client_interface.
This function takes in an uri (which specifies the host and port number
that the client is connected to), method name (which specifies which
RPC to call), and a list of univ (which are the parameters to the RPC).
soap_call_mercury_type(uri, method_name, list_of_univ) :-
generate SOAP message in XML format and SOAP protocol,
tcp__connect to the server,
send the request to the server using HTTP,
wait for the response,
read response in XML format,
decode the response to mercury types.
Assumptions:
When generating SOAP messages for the parameters (list_of_univ),
we assume the client will have a copy of the schema that is used
in the server side for encoding and decoding types in XML.
soap_call_xml_type(uri, method_name, xml_document) :-
tcp__connect to the server,
send the xml_document to the server using HTTP
wait for response,
display response.
Another module will be a sample consisting the main function, demonstrating
how to call the interface to send messages to the SOAP server. It will
handle any command line arguments, then call the interface and
display the response.
Eg.
:- module client_demo
:- import client_interface.
main -->
handle command line arguments
(
command line arguments = mercury_types
->
translate list_of_arguments to list_of_univ,
Result = soap_call_mercury_type(uri, method_name,
list_of_univ)
;
command line arguments = xml_document
->
Result = soap_call_xml_type(uri, method_name,
xml_document)
;
error("input arguments not supported")
),
write(Result).
|
|
From: Ina C. <in...@st...> - 2001-02-04 23:49:37
|
Hi, Here is what I understand regarding the client side: One of the modules will be an interface to the SOAP server. It will require an uri, method name and arguments, then embed the above information using XML format. Consequently send them to the server using SOAP protocol and wait for the response. Once the response is obtained, translate that to mercury type. Eg: :- module client_interface. soap_call(uri, method_name, list_of_arguments) :- translate the arguments to univ type, embed the information in XML format and SOAP protocol, tcp__connect to the server, send the request, wait for the response, translate the response back to mercury types. Another module will be a demo consisting the main function handling command line arguments, calling the interface and displaying the response. Eg. :- module client_demo :- import client_interface. main --> handle command line arguments Result = soap_call(uri, method_name, list_of_arguments), write(Result). Ina <in...@st...> |
|
From: Peter R. <pet...@mi...> - 2001-02-01 10:33:50
|
On Thu, Feb 01, 2001 at 12:32:46PM +1100, Ina Cheng wrote:
>
> Hi,
>
> I've added an example to handle the soap message if the body is a
> structure. I want to commit the example so that I can concentrate on working
> on the client side afterwards.
>
> Ina
> <in...@st...>
>
> ========================================================================
>
> Estimated hours taken: 20
>
> Add example to handle mercury structure. Also fixup some error handling.
>
> /server/server.m
> change the header to request a library filename to be loaded for dl
> add predicates to check request header
>
> /server/soap.m
> tidy up the code
>
> /server/soap_test_methods.m
> /server/web_methods.m
> add example to handle mercury structure
>
> ========================================================================
>
> Index: server.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
> retrieving revision 1.5
> diff -u -r1.5 server.m
> --- server.m 2001/01/25 06:54:42 1.5
> +++ server.m 2001/02/01 01:30:22
> @@ -1,5 +1,5 @@
> %---------------------------------------------------------------------------%
> -% Copyright (C) 2000 Peter Ross
> +% Copyright (C) 2000, 2001 Peter Ross
> % This file may only be copied under the terms of the GNU General Public
> % License - see the file COPYING
> %-----------------------------------------------------------------------------%
> @@ -82,7 +82,16 @@
> { RequestOrResponse = left(Request) },
> (
> { Request^cmd = post },
> - get_soapmessage(TCP, Request, Request1)
> + { check_headers(Request^headers, MayBeError) },
> + (
> + { MayBeError = yes(ErrorResponse) }
> + ->
> + send_response(TCP, ErrorResponse),
> + tcp__shutdown(TCP),
> + { error("Invalid HTTP headers in request.\n") }
> + ;
> + get_soapmessage(TCP, Request, Request1)
> + )
s/MayBe/Maybe/g
> ;
> { Request^cmd = get },
> { Request1 = Request }
> @@ -226,6 +235,67 @@
>
> %---------------------------------------------------------------------------%
>
> + % Section 6 Using SOAP in HTTP
> + % " HTTP applications MUST use the media type "text/xml"
> + % according to RFC 2376 when including SOAP entity bodies
> + % in HTTP messages.
> + %
> + % Section 6.1.1. The SOAPAction HTTP Header Field
> + % " An HTTP client MUST use this header field when issuing a
> + % SOAP HTTP Request. "
> +
> +
> +:- pred check_headers(list(header)::in, maybe(response)::out) is det.
> +
> +check_headers(Headers, Response) :-
> + check_each_header(Headers, soapaction_header,
> + "SOAPAction header not found.\n", MayBeResponse0),
> + (
> + MayBeResponse0 = no
> + ->
> + check_each_header(Headers, content_type_header,
> + "Incorrect Content-Type value.\n", MayBeResponse1),
> + (
> + MayBeResponse1 = no
> + ->
> + Response = no
> + ;
> + Response = MayBeResponse1
> + )
> + ;
> + Response = MayBeResponse0
> + ).
> +
> +:- pred check_each_header(list(header), pred(header), string, maybe(response)).
> +:- mode check_each_header(in, pred(in) is semidet, in, out) is det.
> +
> +check_each_header(Headers, Pred, ErrorMessage, Response) :-
> + list__filter(Pred, Headers, Result),
> + (
> + Result \= []
> + ->
> + Response = no
> + ;
> + Response = yes(response(
> + 400,
> + [],
> + string_body(ErrorMessage),
> + yes )
> + )
> +
> + ).
What about if a header occurs twice? Shouldn't happen, but you never know.
> +
> +:- pred soapaction_header(header::in) is semidet.
> +soapaction_header(header("SOAPAction:", _, _)).
> +
> +:- pred content_type_header(header::in) is semidet.
> +content_type_header(header("Content-Type:", "text/xml", _)).
> +content_type_header(header("Content-type:", "text/xml", _)).
> +content_type_header(header("Content-Type:", "text/xml;", _)).
> +content_type_header(header("Content-type:", "text/xml;", _)).
> +
> +%---------------------------------------------------------------------------%
> +
> :- pred get_soapmessage(S, request, request, io__state, io__state)
> <= stream__duplex(S).
> :- mode get_soapmessage(in, in, out, di, uo) is det.
> @@ -243,7 +313,17 @@
> yes(string__from_char_list(SoapMessage))
> ) }
> ;
> - { error("No content-length supplied. Program Terminated.") }
> + { ErrorResponse = response(
> + 411,
> + [],
> + string_body("Content-Length not supplied.\n"),
> + yes) },
> + send_response(S, ErrorResponse),
> +
> + % XXX how to convert S back to tcp such that
> + % tcp__shutdown(S) can be called ?
> +
> + { error("Content-Length not supplied in request.") }
> ).
>
Don't send the response here, but use the either type to return the
request or respone.
(
...
Result = left(Request)
;
...
Result = right(ErrorResponse)
)
This also avoids needing to pass the stream in, or worry about closing
the socket after use.
> :- pred get_content_length(list(header)::in, int::out) is semidet.
> @@ -268,13 +348,12 @@
> is_content_type("Content-type:").
>
> :- pred get_body(S, int, list(char), io__state, io__state)
> - <= stream__duplex(S).
> + <= stream__input(S).
> :- mode get_body(in, in, out, di, uo) is det.
>
> -% XXX if there are still characters when length = 0
> -% the rest will not be obtained and consequently parsing
> -% an incomplete message will throw an exception.
> -
> + % If there are still characters when length = 0,
> + % the rest will not be obtained and consequently parsing
> + % an incomplete message will throw an exception.
> get_body(S, Length, RequestLines) -->
> stream__read_char(S, CharResult),
> { Length0 = Length - 1 },
> @@ -334,9 +413,14 @@
> )
> ;
> { Request^cmd = post },
> + write(uri_to_filename(Request^uri)), nl,
> (
> { Request^body = yes(Body) } ,
> parse_soapmessage(Body, NsBody),
> +
> + % parse_soapmessage calls error/1 when failed
> + % should change to response with http code = 415
> +
This should be an XXX.
> write(NsBody), nl, nl,
>
> { get_procedure_call(NsBody, Proc) },
> @@ -345,12 +429,12 @@
> { make_web_request(NsBody, Proc, WebRequest) },
> write(WebRequest), nl, nl,
>
> - load_dynamic_library("./libsoap_test_methods.so",
> + load_dynamic_library(uri_to_filename(Request^uri),
> WebRequest, Result, HttpCode),
> (
> - { Result = yes(Output) },
> + { Result = yes(OutputString) },
> { generate_response_body(NsBody, Proc,
> - Output, ResBody0) },
> + OutputString, ResBody0) },
> { ResBody = string_body(ResBody0) }
> ;
> { Result = no },
> @@ -363,7 +447,7 @@
> { ResBody = no_body },
> { HttpCode = 400 }
> ),
> - { list__filter(filter, Request^headers, Headers) },
> + { generate_headers(Request^headers, ResBody, Headers) },
> { Response = response(HttpCode, Headers,
> ResBody, yes) }
> ).
> @@ -380,9 +464,24 @@
> last_char(Str)
> = string__unsafe_index(Str, string__length(Str) - 1).
>
> +:- pred generate_headers(list(header)::in, response_body::in,
> + list(header)::out) is det.
> +generate_headers(RequestHeaders, ResBody, Headers) :-
> + list__filter(filter, RequestHeaders, Headers0),
> + (
> + ResBody = string_body(Body),
> + string__length(Body, BodyLength),
> + string__int_to_string(BodyLength, StringLength),
> + ConLen = [header("Content-Length:", StringLength, no)],
> + list__append(ConLen, Headers0, Headers)
> + ;
> + ResBody = no_body,
> + Headers = []
> + ).
> +
> :- pred filter(header::in) is semidet.
> -filter(header("Content-Length:", _, _)).
> filter(header("Content-Type:", _, _)).
> +filter(header("Content-type:", _, _)).
>
I don't think filter is a very good name. is_content_type_header would
be better.
> %-----------------------------------------------------------------------------%
>
> Index: soap.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
> retrieving revision 1.1
> diff -u -r1.1 soap.m
> --- soap.m 2001/01/25 06:54:42 1.1
> +++ soap.m 2001/02/01 01:30:22
> @@ -78,6 +78,9 @@
> { Res = ok((_, Doc)) },
> { nsTranslate(Doc, NsDoc) }
> ;
> + % instead of error, should change to response
> + % with http code 415 Unsupported Media Type
> +
Make this an XXX.
> { Res = error(Err) },
> { string__append("parse_soapmessage failed: ", Err, ErrMsg) },
> { error(ErrMsg) }
> @@ -130,13 +133,8 @@
> % Gets method name.
> get_procedure_call(NsDoc, Procedure) :-
> get_procedure(NsDoc, [], Procedurelist),
> - get_first_element(Procedurelist, Procedure).
> -
> -:- pred get_first_element(list(T)::in, T::out) is det.
> + list__index1_det(Procedurelist, 1, Procedure).
>
> -get_first_element([], _) :- error("Procedure not found.").
> -get_first_element([H|_], H).
> -
> :- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
> :- mode get_procedure(in, in, out) is det.
> get_procedure(NsDoc, Acc0, Acc) :-
> @@ -411,10 +409,6 @@
> Acc0, Acc1),
> call(Pred, ContentArray, Ref, Method, Result, URIs,
> Acc1, Acc).
> -
> -% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
> -% insert_last([], T, [T]).
> -% insert_last([
>
> :- pred my_delete(list(T)::in, list(T)::out) is det.
> my_delete([], []).
Generally speaking it is much better to do these sort of clean up
changes as a seperate change.
The reason is: if we need to back your changes out we don't want to lose
any unrelated changes at the same time because then we have to reproduce
them.
> Index: soap_test_methods.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
> retrieving revision 1.1
> diff -u -r1.1 soap_test_methods.m
> --- soap_test_methods.m 2001/01/25 06:54:42 1.1
> +++ soap_test_methods.m 2001/02/01 01:30:22
> @@ -21,20 +21,34 @@
>
> :- module soap_test_methods.
> :- interface.
> -:- import_module io, int, list, std_util.
> +:- import_module list, std_util.
>
> -:- pred hello(state::di, state::uo) is det.
> +:- pred hello(univ::out) is det.
>
> :- pred get_sp(list(univ)::in, univ::out) is det.
>
> :- func get_stockprice(list(univ)) = univ.
>
> +% :- pred get_bookprice(book::in, univ::out) is det.
> :- pred get_bookprice(list(univ)::in, univ::out) is det.
>
> +:- type book
> + ---> book(
> + title :: string,
> + author :: author,
> + intro :: string
> + ).
> +
I am not sure if this is an artifact of my mailer or not but line up
the closing bracket of book with the first letter of the functor. ie.
:- type book
---> book(
...
). % XXX this bracket should line up.
> +:- type author
> + ---> author(
> + surname :: string,
> + firstname :: string
> + ).
> +
> %---------------------------------------------------------------------%
>
> :- implementation.
> -:- import_module require.
> +:- import_module int, require.
>
> % remove_first_element(List, Elem, Rest)
> % takes out first element of the List and gives back
> @@ -51,7 +65,8 @@
> % Hello
> %---------------------------------------------------------------------%
>
> -hello --> print("Hello, world\n").
> +hello(ResultAsUniv) :-
> + ResultAsUniv = univ("<output>Hello, world</output>").
>
> %---------------------------------------------------------------------%
> % GetStockPrice
> @@ -78,7 +93,7 @@
> remove_first_element(ParamList, ParamAsUniv, _)
> ->
> det_univ_to_type(ParamAsUniv, ParamAsInt),
> - ResultAsInt = ParamAsInt + 1,
> + ResultAsInt = ParamAsInt + 0,
> ResultAsUniv = univ(ResultAsInt)
> ;
> require__error("Error in get_stockprice")
> @@ -87,8 +102,22 @@
> %---------------------------------------------------------------------%
> % GetBookPrice
> %---------------------------------------------------------------------%
> -
> -get_bookprice(ParamList, ResultAsUniv) :-
> - ResultAsUniv = univ(100).
>
> +get_bookprice(ParamList, ResultAsUniv) :-
> + list__index1_det(ParamList, 1, ParamAsUniv),
> + Param0 = univ_value(ParamAsUniv),
> + Param = inst_cast_book(Param0),
> + (
> + Param = book("Hello world",
> + author("Foo", "Bar"),
> + "This is a book")
> + ->
> + ResultAsUniv = univ(100)
> + ;
> + ResultAsUniv = univ(50)
> + ).
>
> +:- func inst_cast_book(T) = book.
> +:- mode inst_cast_book(in) = out is det.
> +:- pragma c_code(inst_cast_book(X::in) = (Y::out),
> + [will_not_call_mercury, thread_safe], "Y = X").
> Index: web_methods.m
> ===================================================================
> RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
> retrieving revision 1.1
> diff -u -r1.1 web_methods.m
> --- web_methods.m 2001/01/25 06:54:42 1.1
> +++ web_methods.m 2001/02/01 01:30:22
> @@ -42,14 +42,7 @@
> pFields :: maybe(list(parameter))
> % Struct or Array
> ).
> -/* Ignore this
>
> - % Converts method name and parameters in xml.ns format to
> - % a web request.
> -:- pred make_web_request(nsElement, list(parameter), web_method_request).
> -:- mode make_web_request(in, in, out) is det.
> -*/
> -
> % Loads library, invokes method call and generates corresponding
> % response.
> :- pred load_dynamic_library(string::in, web_method_request::in,
> @@ -63,71 +56,11 @@
> :- implementation.
> :- import_module bool, int, require.
> :- import_module dl, name_mangle, soap_test_methods.
> -
> - % XXX change that to command line argument
> -:- func soap_library_file = string.
> -soap_library_file = "soap_test_methods".
> -
> -/* Ignore this. Not used anymore
> -
> - % Generates a web request using method and parameters
> -make_web_request(Proc, Params, Request) :-
> - Request^name = Proc^eName^localName,
> - Request^uri = Proc^eName^nsURI,
> - Request^params = Params.
> -
> -make_web_request(Proc, Params, Request) :-
> - Request^name = Proc^eName^localName,
> - Request^uri = Proc^eName^nsURI,
> - form_pair(Params, ParamsPair),
> - list__map(retrieve_params, ParamsPair, Request^params).
> -
> - % Transform parameter list from [parameter, data, parameter, data ..]
> - % to [(parameter - data)] to distinguish elements
> -:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
> -:- mode form_pair(in, out) is det.
> -
> -form_pair(ParamList , PairList) :-
> - (
> - ParamList = []
> - ->
> - PairList = []
> - ;
> - ParamList = [Param, Data | Tail]
> - % list__split_list(2, ParamList, Start, End),
> - % Start = [Param, Data]
> - ->
> - PairList = [(Param - Data) | PairList0],
> - form_pair(Tail, PairList0)
> - ;
> - error("Incorrect Data Format")
> - ).
>
> +% :- func soap_library_file = string.
> +% soap_library_file = "soap_test_methods".
>
> - % Retrieve parameter name, uri, type if defined and data value.
> -:- pred retrieve_params(pair(nsContent, nsContent), parameter).
> -:- mode retrieve_params(in, out) is det.
>
> -retrieve_params((Param0 - Data), Parameter) :-
> - (
> - Param0 = nsElement(Param),
> - Data = data(Value)
> - ->
> - Name = Param^eName^localName,
> - URI = Param^eName^nsURI,
> - (
> - search_attributes(Param^eAttrs, Type0)
> - ->
> - Type = yes(Type0)
> - ;
> - Type = no
> - ),
> - Parameter = parameter(Name, Type, Value, URI)
> - ;
> - error("Incorrect Data Format")
> - ).
> -*/
> -
> % Types in XML can be defined either by using xsi:type attribute
> % or by using schema. This predicate is used to search if
> % any attribute contains `xsi:type'.
> @@ -172,51 +105,64 @@
>
> % Opens library file, invokes desire function, and gets back
> % corresponding response and http code.
> -load_dynamic_library(L, Request, Response, HttpCode) -->
> - dl__open(L, lazy, local, MaybeHandle),
> + %
> + % LibFile format = "./libfilename.so"
> + %
> +load_dynamic_library(LibFile, Request, Response, HttpCode) -->
> + dl__open(LibFile, lazy, local, MaybeHandle),
> + { get_filename(LibFile, Filename) },
> (
> { MaybeHandle = error(OpenMsg) },
> { string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
> - { Response = yes(OpenErrorMsg) },
> - { HttpCode = 500 } % 500 Internal Server Error
> + { Response = no },
> + { HttpCode = 500 }, % 500 Internal Server Error
> + { error(OpenErrorMsg) }
Why do you call error now, instead of passing the error message back?
> ;
> { MaybeHandle = ok(Handle) },
> (
> % Hello has no parameter
> { Request^name = "Hello" }
> ->
> - call_Hello_pred(Handle, Request, Response0, HttpCode0)
> + call_Hello_pred(Handle, Filename, Request,
> + Response0, HttpCode0)
> ;
> % GetStockPrice has 1 parameter
> { Request^name = "GetStockPrice" }
> ->
> - call_SP_func(Handle, Request, Response0, HttpCode0)
> + call_SP_func(Handle, Filename, Request,
> + Response0, HttpCode0)
> ;
> % GetBookPrice takes in a struct
> { Request^name = "GetBookPrice" }
> ->
> - call_BP_pred(Handle, Request, Response0, HttpCode0)
> + call_BP_pred(Handle, Filename, Request,
> + Response0, HttpCode0)
> ;
> { Response0 = yes("Method requested not
> implemented.") },
> { HttpCode0 = 501 } % 501 Not Implemented
> ),
>
> +/* commented out dl__close/4 so that the .so can be referred to it
> + when generating responses. If the .so file is closed, any pointers
> + referencing the .so file will become unavailable, causing
> + runtime error: segmentation violation.
> +
> dl__close(Handle, Result),
> (
> { Result = error(CloseMsg) },
> { string__append("dlclose failed: ", CloseMsg,
> CloseErrorMsg) },
> - { Response1 = yes(CloseErrorMsg) },
> + { Response1 = no },
> { HttpCode1 = 500 },
> - { ChangeHttpCode = yes }
> + { ChangeHttpCode = yes },
> + { error(CloseErrorMsg) }
> ;
> { Result = ok },
> { Response1 = Response0 },
> { HttpCode1 = HttpCode0 },
> { ChangeHttpCode = no }
> ),
> -
> (
> { ChangeHttpCode = yes }
> ->
> @@ -226,25 +172,29 @@
> { Response = Response0 },
> { HttpCode = HttpCode0 }
> )
> +*/
> + { Response = Response0 },
> + { HttpCode = HttpCode0 }
> ).
>
> %-----------------------------------------------------------------------%
> % Hello
> %-----------------------------------------------------------------------%
>
> -:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
> - io__state, io__state).
> -:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
> -
> -call_Hello_pred(Handle, _Request, Response, HttpCode) -->
> - { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
> - "hello", 2, 0) },
> +:- pred call_Hello_pred(handle, string, web_method_request, maybe(string),
> + http_code, io__state, io__state).
> +:- mode call_Hello_pred(in, in, in, out, out, di, uo) is det.
> +
> +call_Hello_pred(Handle, Filename, _Request, Response, HttpCode) -->
> + { HelloProc = mercury_proc(predicate, unqualified(Filename),
> + "hello", 1, 0) },
> dl__mercury_sym(Handle, HelloProc, MaybeHello),
> (
> { MaybeHello = error(Msg) },
> { string__append("dlsym failed: ", Msg, ErrorMsg) },
> - { Response = yes(ErrorMsg) },
> - { HttpCode = 500 }
> + { Response = no },
> + { HttpCode = 500 },
> + { error(ErrorMsg) }
> ;
> { MaybeHello = ok(HelloPred0) },
>
> @@ -254,9 +204,10 @@
>
> % Call the procedure whose address
> % we just obtained.
> - HelloPred,
> + { HelloPred(HelloUniv) },
> + { det_univ_to_type(HelloUniv, HelloString) },
>
> - { Response = yes("<output>Hello World</output>") },
> + { Response = yes(HelloString) },
> { HttpCode = 200 }
> ).
>
> @@ -265,39 +216,44 @@
> % `hello' procedure is `pred(di, uo) is det', before we can actually
> % call it. The function inst_cast_hello/1 defined below does that.
>
> -:- type io_pred == pred(io__state, io__state).
> -:- inst io_pred == (pred(di, uo) is det).
> +:- type hello_pred == pred(univ).
> +:- inst hello_pred == (pred(out) is det).
>
> -:- func inst_cast_hello(io_pred) = io_pred.
> -:- mode inst_cast_hello(in) = out(io_pred) is det.
> -:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
> +:- func inst_cast_hello(hello_pred) = hello_pred.
> +:- mode inst_cast_hello(in) = out(hello_pred) is det.
> +:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)),
> [will_not_call_mercury, thread_safe], "Y = X").
>
> %-----------------------------------------------------------------------%
> % GetStockPrice
> %-----------------------------------------------------------------------%
>
> -:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
> - io__state, io__state).
> -:- mode call_SP_func(in, in, out, out, di, uo) is det.
> +:- pred call_SP_func(handle, string, web_method_request, maybe(string),
> + http_code, io__state, io__state).
> +:- mode call_SP_func(in, in, in, out, out, di, uo) is det.
> +
> + % XXX error occurs for function but not for predicate
> + % Uncaught exception:
> + % Software Error: dl__mercury_sym:
> + % result type is not a higher-order type
>
> -call_SP_func(Handle, Request, Response, HttpCode) -->
> - { list__length(Request^params, Arity) },
> -
> +call_SP_func(Handle, Filename, Request, Response, HttpCode) -->
> % XXX test for function
> - % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
> + % { list__length(Request^params, Arity) },
> + % { GetSPProc = mercury_proc(function, unqualified(Filename),
> % "get_stockprice", Arity, 0) },
>
> % XXX test for predicate
> - { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
> + { GetSPProc = mercury_proc(predicate, unqualified(Filename),
> "get_sp", 2, 0) },
>
> dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
> (
> { MaybeGetStockPrice = error(Msg) },
> { string__append("dlsym failed: ", Msg, ErrorMsg) },
> - { Response = yes(ErrorMsg) },
> - { HttpCode = 500 }
> + { Response = no },
> + { HttpCode = 500 },
> + { error(ErrorMsg) }
ditto.
> ;
> { MaybeGetStockPrice = ok(SPProc0) },
>
> @@ -308,10 +264,6 @@
> % XXX test for function
> % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
>
> - % message is parsed bottom up, therefore parameter
> - % list is in reverse order
> - % { list__reverse(Request^params, ParameterList) },
> -
> % Convert parameters (string) to the corresponding types
> { list__map(lookup_SP_schema, Request^params, UnivList) },
>
> @@ -424,19 +376,20 @@
> % schema for GetBookPrice:
> %
> % <element name="book" type="tns:book"/>
> + % <element name="author" base="tns:author"/>
> + %
> % <complexType name="book">
> % <sequence>
> - % <element name="title" type="mercury:string"/>
> + % <element name="title" type="xsd:string"/>
> % <element name="author" type="tns:author"/>
> - % <element name="intro" type="mercury:string"/>
> + % <element name="intro" type="xsd:string"/>
> % </sequence>
> % </complexType>
> %
> - % <element name="author" base="tns:author"/>
> % <complexType name="author">
> % <sequence>
> - % <element name"surname" type="mercury:string"/>
> - % <element name"firstname" type="mercury:string"/>
> + % <element name"surname" type="xsd:string"/>
> + % <element name"firstname" type="xsd:string"/>
> % </sequence>
> % </complexType>
> %
> @@ -448,28 +401,27 @@
> % author :: author,
> % intro :: string
> % ).
> - %
> + %
> % :- type author
> % ---> author(
> % surname :: string,
> % firstname :: string
> % ).
>
> -:- pred call_BP_pred(handle, web_method_request, maybe(string), http_code,
> - io__state, io__state).
> -:- mode call_BP_pred(in, in, out, out, di, uo) is det.
> -
> -call_BP_pred(Handle, Request, Response, HttpCode) -->
> - { list__length(Request^params, Arity0) },
> - { Arity = Arity0 + 1 }, % since it is a predicate
> - { GetBPProc = mercury_proc(predicate, unqualified(soap_library_file),
> - "get_bookprice", Arity, 0) },
> +:- pred call_BP_pred(handle, string, web_method_request, maybe(string),
> + http_code, io__state, io__state).
> +:- mode call_BP_pred(in, in, in, out, out, di, uo) is det.
> +
> +call_BP_pred(Handle, Filename, Request, Response, HttpCode) -->
> + { GetBPProc = mercury_proc(predicate, unqualified(Filename),
> + "get_bookprice", 2, 0) },
> dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
> (
> { MaybeGetBookPrice = error(Msg) },
> { string__append("dlsym failed: ", Msg, ErrorMsg) },
> - { Response = yes(ErrorMsg) },
> - { HttpCode = 500 }
> + { Response = no },
> + { HttpCode = 500 },
> + { error(ErrorMsg) }
> ;
> { MaybeGetBookPrice = ok(BPProc0) },
>
> @@ -478,11 +430,11 @@
> { BPProc = inst_cast_bp(BPProc0) },
>
> % Convert parameters (string) to the corresponding types
> - % { list__map(lookup_BP_schema, Request^params, UnivList) },
> -
> + { list__map(lookup_BP_schema, Request^params, UnivList) },
> +
> % Call the procedure whose address we just obtained
> - { UnivList = [univ(1)] },
> { call(BPProc, UnivList, BPUniv) },
> +
> { det_univ_to_type(BPUniv, BPInt) },
> { string__int_to_string(BPInt, BPString) },
>
> @@ -493,64 +445,75 @@
> ).
>
>
> -/* still working
> -
> -:- pred searchBPList(list(parameter), string, maybe(list(parameter)),
> - maybe(string)).
> -:- mode searchBPList(in, in, out, out) is semidet.
> -
> -searchBPList(ParamList, ElemName, Struct, Value) :-
> - Elem = parameter(ElemName, _, _, _, _),
> - (
> - list__nth_member_search(ParamList, Elem, Pos),
> - list__index1(ParamList, Pos, Param)
> - ->
> - Struct = Param^pFields,
> - Value = Param^pValue
> - ;
> - fail
> - ).
> -
> :- pred lookup_BP_schema(parameter::in, univ::out) is det.
>
> lookup_BP_schema(Param, ValueAsUniv) :-
> (
> Param^pName = "book",
> - Param^pFields = yes(StructList),
> - (
> - searchBPList(StructList, "title", Child, Value0),
> - Child = no,
> - Value0 = yes(Value)
> - ->
> - type_cast_parameter("string", Value, ValueAsUniv)
> - ;
> - searchBPList(StructList, "author", Child, _),
> - Child = yes(ChildStructList)
> - ->
> - (
> - searchBPList(ChildStructList, "author", _, _ )
> - ;
> - require__error(
> - "Element Structure not defined in schema.")
> + Param^pFields = yes(FieldList)
> + ->
> + get_BP_param(FieldList, "title", Title0),
> + lookup_BP_schema(Title0, TitleAsUniv),
> + det_univ_to_type(TitleAsUniv, Title),
> +
> + get_BP_param(FieldList, "author", Author0),
> + lookup_BP_schema(Author0, AuthorAsUniv),
> + det_univ_to_type(AuthorAsUniv, Author),
> +
> + get_BP_param(FieldList, "intro", Intro0),
> + lookup_BP_schema(Intro0, IntroAsUniv),
> + det_univ_to_type(IntroAsUniv, Intro),
>
> - )
> - ;
> - searchBPList(StructList, "intro", Child, Value0),
> - Child = no,
> - Value0 = yes(Value)
> - ->
> - type_cast_parameter("string", Value, ValueAsUniv)
> - ;
> - require__error(
> - "Element Structure not defined in schema.")
> - )
> + ValueAsBook = book(Title, Author, Intro),
> + ValueAsUniv = univ(ValueAsBook)
> + ;
> + Param^pName = "title",
> + Param^pValue = yes(Value)
> + ->
> + type_cast_parameter("string", Value, ValueAsUniv)
> ;
> + Param^pName = "author",
> + Param^pFields = yes(FieldList)
> + ->
> + get_BP_param(FieldList, "surname", Surname0),
> + lookup_BP_schema(Surname0, SurnameAsUniv),
> + det_univ_to_type(SurnameAsUniv, Surname),
> +
> + get_BP_param(FieldList, "firstname", Firstname0),
> + lookup_BP_schema(Firstname0, FirstnameAsUniv),
> + det_univ_to_type(FirstnameAsUniv, Firstname),
> +
> + ValueAsAuthor = author(Surname, Firstname),
> + ValueAsUniv = univ(ValueAsAuthor)
> + ;
> + Param^pName = "surname",
> + Param^pValue = yes(Value)
> + ->
> + type_cast_parameter("string", Value, ValueAsUniv)
> + ;
> + Param^pName = "firstname",
> + Param^pValue = yes(Value)
> + ->
> + type_cast_parameter("string", Value, ValueAsUniv)
> + ;
> + Param^pName = "intro",
> + Param^pValue = yes(Value)
> + ->
> + type_cast_parameter("string", Value, ValueAsUniv)
> + ;
> require__error("Element Structure not defined in schema.")
> ).
> -*/
>
> +:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is det.
> +
> +get_BP_param(ParamList, SearchString, Parameter) :-
> + list__filter((pred(X::in) is semidet :-
> + X = parameter(SearchString,_,_,_,_)), ParamList, Result),
> + list__index1_det(Result, 1, Parameter).
> +
> % inst cast for get_bookprice
> :- type bp_pred == pred(list(univ), univ).
> +% :- type bp_pred == pred(book, univ).
> :- inst bp_pred == (pred(in, out) is det).
>
> :- func inst_cast_bp(bp_pred) = bp_pred.
> @@ -561,6 +524,14 @@
> %-----------------------------------------------------------------------%
> % Shared functions
> %-----------------------------------------------------------------------%
> +
> + % Returns filename from ./libfilename.so
> +:- pred get_filename(string::in, string::out) is det.
> +
> +get_filename(LibFile, Filename) :-
> + string__split(LibFile, 5, _Left, Filename0),
> + string__length(Filename0, Length),
> + string__left(Filename0, Length-3, Filename).
>
> % Separates prefix and suffix.
> :- pred split_on_colon(string::in, string::out, string::out) is det.
>
>
> _______________________________________________
> Quicksilver-developers mailing list
> Qui...@li...
> http://lists.sourceforge.net/lists/listinfo/quicksilver-developers
|
|
From: Ina C. <in...@st...> - 2001-02-01 01:32:56
|
Hi,
I've added an example to handle the soap message if the body is a
structure. I want to commit the example so that I can concentrate on working
on the client side afterwards.
Ina
<in...@st...>
========================================================================
Estimated hours taken: 20
Add example to handle mercury structure. Also fixup some error handling.
/server/server.m
change the header to request a library filename to be loaded for dl
add predicates to check request header
/server/soap.m
tidy up the code
/server/soap_test_methods.m
/server/web_methods.m
add example to handle mercury structure
========================================================================
Index: server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.5
diff -u -r1.5 server.m
--- server.m 2001/01/25 06:54:42 1.5
+++ server.m 2001/02/01 01:30:22
@@ -1,5 +1,5 @@
%---------------------------------------------------------------------------%
-% Copyright (C) 2000 Peter Ross
+% Copyright (C) 2000, 2001 Peter Ross
% This file may only be copied under the terms of the GNU General Public
% License - see the file COPYING
%-----------------------------------------------------------------------------%
@@ -82,7 +82,16 @@
{ RequestOrResponse = left(Request) },
(
{ Request^cmd = post },
- get_soapmessage(TCP, Request, Request1)
+ { check_headers(Request^headers, MayBeError) },
+ (
+ { MayBeError = yes(ErrorResponse) }
+ ->
+ send_response(TCP, ErrorResponse),
+ tcp__shutdown(TCP),
+ { error("Invalid HTTP headers in request.\n") }
+ ;
+ get_soapmessage(TCP, Request, Request1)
+ )
;
{ Request^cmd = get },
{ Request1 = Request }
@@ -226,6 +235,67 @@
%---------------------------------------------------------------------------%
+ % Section 6 Using SOAP in HTTP
+ % " HTTP applications MUST use the media type "text/xml"
+ % according to RFC 2376 when including SOAP entity bodies
+ % in HTTP messages.
+ %
+ % Section 6.1.1. The SOAPAction HTTP Header Field
+ % " An HTTP client MUST use this header field when issuing a
+ % SOAP HTTP Request. "
+
+
+:- pred check_headers(list(header)::in, maybe(response)::out) is det.
+
+check_headers(Headers, Response) :-
+ check_each_header(Headers, soapaction_header,
+ "SOAPAction header not found.\n", MayBeResponse0),
+ (
+ MayBeResponse0 = no
+ ->
+ check_each_header(Headers, content_type_header,
+ "Incorrect Content-Type value.\n", MayBeResponse1),
+ (
+ MayBeResponse1 = no
+ ->
+ Response = no
+ ;
+ Response = MayBeResponse1
+ )
+ ;
+ Response = MayBeResponse0
+ ).
+
+:- pred check_each_header(list(header), pred(header), string, maybe(response)).
+:- mode check_each_header(in, pred(in) is semidet, in, out) is det.
+
+check_each_header(Headers, Pred, ErrorMessage, Response) :-
+ list__filter(Pred, Headers, Result),
+ (
+ Result \= []
+ ->
+ Response = no
+ ;
+ Response = yes(response(
+ 400,
+ [],
+ string_body(ErrorMessage),
+ yes )
+ )
+
+ ).
+
+:- pred soapaction_header(header::in) is semidet.
+soapaction_header(header("SOAPAction:", _, _)).
+
+:- pred content_type_header(header::in) is semidet.
+content_type_header(header("Content-Type:", "text/xml", _)).
+content_type_header(header("Content-type:", "text/xml", _)).
+content_type_header(header("Content-Type:", "text/xml;", _)).
+content_type_header(header("Content-type:", "text/xml;", _)).
+
+%---------------------------------------------------------------------------%
+
:- pred get_soapmessage(S, request, request, io__state, io__state)
<= stream__duplex(S).
:- mode get_soapmessage(in, in, out, di, uo) is det.
@@ -243,7 +313,17 @@
yes(string__from_char_list(SoapMessage))
) }
;
- { error("No content-length supplied. Program Terminated.") }
+ { ErrorResponse = response(
+ 411,
+ [],
+ string_body("Content-Length not supplied.\n"),
+ yes) },
+ send_response(S, ErrorResponse),
+
+ % XXX how to convert S back to tcp such that
+ % tcp__shutdown(S) can be called ?
+
+ { error("Content-Length not supplied in request.") }
).
:- pred get_content_length(list(header)::in, int::out) is semidet.
@@ -268,13 +348,12 @@
is_content_type("Content-type:").
:- pred get_body(S, int, list(char), io__state, io__state)
- <= stream__duplex(S).
+ <= stream__input(S).
:- mode get_body(in, in, out, di, uo) is det.
-% XXX if there are still characters when length = 0
-% the rest will not be obtained and consequently parsing
-% an incomplete message will throw an exception.
-
+ % If there are still characters when length = 0,
+ % the rest will not be obtained and consequently parsing
+ % an incomplete message will throw an exception.
get_body(S, Length, RequestLines) -->
stream__read_char(S, CharResult),
{ Length0 = Length - 1 },
@@ -334,9 +413,14 @@
)
;
{ Request^cmd = post },
+ write(uri_to_filename(Request^uri)), nl,
(
{ Request^body = yes(Body) } ,
parse_soapmessage(Body, NsBody),
+
+ % parse_soapmessage calls error/1 when failed
+ % should change to response with http code = 415
+
write(NsBody), nl, nl,
{ get_procedure_call(NsBody, Proc) },
@@ -345,12 +429,12 @@
{ make_web_request(NsBody, Proc, WebRequest) },
write(WebRequest), nl, nl,
- load_dynamic_library("./libsoap_test_methods.so",
+ load_dynamic_library(uri_to_filename(Request^uri),
WebRequest, Result, HttpCode),
(
- { Result = yes(Output) },
+ { Result = yes(OutputString) },
{ generate_response_body(NsBody, Proc,
- Output, ResBody0) },
+ OutputString, ResBody0) },
{ ResBody = string_body(ResBody0) }
;
{ Result = no },
@@ -363,7 +447,7 @@
{ ResBody = no_body },
{ HttpCode = 400 }
),
- { list__filter(filter, Request^headers, Headers) },
+ { generate_headers(Request^headers, ResBody, Headers) },
{ Response = response(HttpCode, Headers,
ResBody, yes) }
).
@@ -380,9 +464,24 @@
last_char(Str)
= string__unsafe_index(Str, string__length(Str) - 1).
+:- pred generate_headers(list(header)::in, response_body::in,
+ list(header)::out) is det.
+generate_headers(RequestHeaders, ResBody, Headers) :-
+ list__filter(filter, RequestHeaders, Headers0),
+ (
+ ResBody = string_body(Body),
+ string__length(Body, BodyLength),
+ string__int_to_string(BodyLength, StringLength),
+ ConLen = [header("Content-Length:", StringLength, no)],
+ list__append(ConLen, Headers0, Headers)
+ ;
+ ResBody = no_body,
+ Headers = []
+ ).
+
:- pred filter(header::in) is semidet.
-filter(header("Content-Length:", _, _)).
filter(header("Content-Type:", _, _)).
+filter(header("Content-type:", _, _)).
%-----------------------------------------------------------------------------%
Index: soap.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
retrieving revision 1.1
diff -u -r1.1 soap.m
--- soap.m 2001/01/25 06:54:42 1.1
+++ soap.m 2001/02/01 01:30:22
@@ -78,6 +78,9 @@
{ Res = ok((_, Doc)) },
{ nsTranslate(Doc, NsDoc) }
;
+ % instead of error, should change to response
+ % with http code 415 Unsupported Media Type
+
{ Res = error(Err) },
{ string__append("parse_soapmessage failed: ", Err, ErrMsg) },
{ error(ErrMsg) }
@@ -130,13 +133,8 @@
% Gets method name.
get_procedure_call(NsDoc, Procedure) :-
get_procedure(NsDoc, [], Procedurelist),
- get_first_element(Procedurelist, Procedure).
-
-:- pred get_first_element(list(T)::in, T::out) is det.
+ list__index1_det(Procedurelist, 1, Procedure).
-get_first_element([], _) :- error("Procedure not found.").
-get_first_element([H|_], H).
-
:- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
:- mode get_procedure(in, in, out) is det.
get_procedure(NsDoc, Acc0, Acc) :-
@@ -411,10 +409,6 @@
Acc0, Acc1),
call(Pred, ContentArray, Ref, Method, Result, URIs,
Acc1, Acc).
-
-% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
-% insert_last([], T, [T]).
-% insert_last([
:- pred my_delete(list(T)::in, list(T)::out) is det.
my_delete([], []).
Index: soap_test_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.1
diff -u -r1.1 soap_test_methods.m
--- soap_test_methods.m 2001/01/25 06:54:42 1.1
+++ soap_test_methods.m 2001/02/01 01:30:22
@@ -21,20 +21,34 @@
:- module soap_test_methods.
:- interface.
-:- import_module io, int, list, std_util.
+:- import_module list, std_util.
-:- pred hello(state::di, state::uo) is det.
+:- pred hello(univ::out) is det.
:- pred get_sp(list(univ)::in, univ::out) is det.
:- func get_stockprice(list(univ)) = univ.
+% :- pred get_bookprice(book::in, univ::out) is det.
:- pred get_bookprice(list(univ)::in, univ::out) is det.
+:- type book
+ ---> book(
+ title :: string,
+ author :: author,
+ intro :: string
+ ).
+
+:- type author
+ ---> author(
+ surname :: string,
+ firstname :: string
+ ).
+
%---------------------------------------------------------------------%
:- implementation.
-:- import_module require.
+:- import_module int, require.
% remove_first_element(List, Elem, Rest)
% takes out first element of the List and gives back
@@ -51,7 +65,8 @@
% Hello
%---------------------------------------------------------------------%
-hello --> print("Hello, world\n").
+hello(ResultAsUniv) :-
+ ResultAsUniv = univ("<output>Hello, world</output>").
%---------------------------------------------------------------------%
% GetStockPrice
@@ -78,7 +93,7 @@
remove_first_element(ParamList, ParamAsUniv, _)
->
det_univ_to_type(ParamAsUniv, ParamAsInt),
- ResultAsInt = ParamAsInt + 1,
+ ResultAsInt = ParamAsInt + 0,
ResultAsUniv = univ(ResultAsInt)
;
require__error("Error in get_stockprice")
@@ -87,8 +102,22 @@
%---------------------------------------------------------------------%
% GetBookPrice
%---------------------------------------------------------------------%
-
-get_bookprice(ParamList, ResultAsUniv) :-
- ResultAsUniv = univ(100).
+get_bookprice(ParamList, ResultAsUniv) :-
+ list__index1_det(ParamList, 1, ParamAsUniv),
+ Param0 = univ_value(ParamAsUniv),
+ Param = inst_cast_book(Param0),
+ (
+ Param = book("Hello world",
+ author("Foo", "Bar"),
+ "This is a book")
+ ->
+ ResultAsUniv = univ(100)
+ ;
+ ResultAsUniv = univ(50)
+ ).
+:- func inst_cast_book(T) = book.
+:- mode inst_cast_book(in) = out is det.
+:- pragma c_code(inst_cast_book(X::in) = (Y::out),
+ [will_not_call_mercury, thread_safe], "Y = X").
Index: web_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.1
diff -u -r1.1 web_methods.m
--- web_methods.m 2001/01/25 06:54:42 1.1
+++ web_methods.m 2001/02/01 01:30:22
@@ -42,14 +42,7 @@
pFields :: maybe(list(parameter))
% Struct or Array
).
-/* Ignore this
- % Converts method name and parameters in xml.ns format to
- % a web request.
-:- pred make_web_request(nsElement, list(parameter), web_method_request).
-:- mode make_web_request(in, in, out) is det.
-*/
-
% Loads library, invokes method call and generates corresponding
% response.
:- pred load_dynamic_library(string::in, web_method_request::in,
@@ -63,71 +56,11 @@
:- implementation.
:- import_module bool, int, require.
:- import_module dl, name_mangle, soap_test_methods.
-
- % XXX change that to command line argument
-:- func soap_library_file = string.
-soap_library_file = "soap_test_methods".
-
-/* Ignore this. Not used anymore
-
- % Generates a web request using method and parameters
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- Request^params = Params.
-
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- form_pair(Params, ParamsPair),
- list__map(retrieve_params, ParamsPair, Request^params).
-
- % Transform parameter list from [parameter, data, parameter, data ..]
- % to [(parameter - data)] to distinguish elements
-:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
-:- mode form_pair(in, out) is det.
-
-form_pair(ParamList , PairList) :-
- (
- ParamList = []
- ->
- PairList = []
- ;
- ParamList = [Param, Data | Tail]
- % list__split_list(2, ParamList, Start, End),
- % Start = [Param, Data]
- ->
- PairList = [(Param - Data) | PairList0],
- form_pair(Tail, PairList0)
- ;
- error("Incorrect Data Format")
- ).
+% :- func soap_library_file = string.
+% soap_library_file = "soap_test_methods".
- % Retrieve parameter name, uri, type if defined and data value.
-:- pred retrieve_params(pair(nsContent, nsContent), parameter).
-:- mode retrieve_params(in, out) is det.
-retrieve_params((Param0 - Data), Parameter) :-
- (
- Param0 = nsElement(Param),
- Data = data(Value)
- ->
- Name = Param^eName^localName,
- URI = Param^eName^nsURI,
- (
- search_attributes(Param^eAttrs, Type0)
- ->
- Type = yes(Type0)
- ;
- Type = no
- ),
- Parameter = parameter(Name, Type, Value, URI)
- ;
- error("Incorrect Data Format")
- ).
-*/
-
% Types in XML can be defined either by using xsi:type attribute
% or by using schema. This predicate is used to search if
% any attribute contains `xsi:type'.
@@ -172,51 +105,64 @@
% Opens library file, invokes desire function, and gets back
% corresponding response and http code.
-load_dynamic_library(L, Request, Response, HttpCode) -->
- dl__open(L, lazy, local, MaybeHandle),
+ %
+ % LibFile format = "./libfilename.so"
+ %
+load_dynamic_library(LibFile, Request, Response, HttpCode) -->
+ dl__open(LibFile, lazy, local, MaybeHandle),
+ { get_filename(LibFile, Filename) },
(
{ MaybeHandle = error(OpenMsg) },
{ string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
- { Response = yes(OpenErrorMsg) },
- { HttpCode = 500 } % 500 Internal Server Error
+ { Response = no },
+ { HttpCode = 500 }, % 500 Internal Server Error
+ { error(OpenErrorMsg) }
;
{ MaybeHandle = ok(Handle) },
(
% Hello has no parameter
{ Request^name = "Hello" }
->
- call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ call_Hello_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetStockPrice has 1 parameter
{ Request^name = "GetStockPrice" }
->
- call_SP_func(Handle, Request, Response0, HttpCode0)
+ call_SP_func(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetBookPrice takes in a struct
{ Request^name = "GetBookPrice" }
->
- call_BP_pred(Handle, Request, Response0, HttpCode0)
+ call_BP_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
{ Response0 = yes("Method requested not
implemented.") },
{ HttpCode0 = 501 } % 501 Not Implemented
),
+/* commented out dl__close/4 so that the .so can be referred to it
+ when generating responses. If the .so file is closed, any pointers
+ referencing the .so file will become unavailable, causing
+ runtime error: segmentation violation.
+
dl__close(Handle, Result),
(
{ Result = error(CloseMsg) },
{ string__append("dlclose failed: ", CloseMsg,
CloseErrorMsg) },
- { Response1 = yes(CloseErrorMsg) },
+ { Response1 = no },
{ HttpCode1 = 500 },
- { ChangeHttpCode = yes }
+ { ChangeHttpCode = yes },
+ { error(CloseErrorMsg) }
;
{ Result = ok },
{ Response1 = Response0 },
{ HttpCode1 = HttpCode0 },
{ ChangeHttpCode = no }
),
-
(
{ ChangeHttpCode = yes }
->
@@ -226,25 +172,29 @@
{ Response = Response0 },
{ HttpCode = HttpCode0 }
)
+*/
+ { Response = Response0 },
+ { HttpCode = HttpCode0 }
).
%-----------------------------------------------------------------------%
% Hello
%-----------------------------------------------------------------------%
-:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
-
-call_Hello_pred(Handle, _Request, Response, HttpCode) -->
- { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
- "hello", 2, 0) },
+:- pred call_Hello_pred(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_Hello_pred(in, in, in, out, out, di, uo) is det.
+
+call_Hello_pred(Handle, Filename, _Request, Response, HttpCode) -->
+ { HelloProc = mercury_proc(predicate, unqualified(Filename),
+ "hello", 1, 0) },
dl__mercury_sym(Handle, HelloProc, MaybeHello),
(
{ MaybeHello = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
- { HttpCode = 500 }
+ { Response = no },
+ { HttpCode = 500 },
+ { error(ErrorMsg) }
;
{ MaybeHello = ok(HelloPred0) },
@@ -254,9 +204,10 @@
% Call the procedure whose address
% we just obtained.
- HelloPred,
+ { HelloPred(HelloUniv) },
+ { det_univ_to_type(HelloUniv, HelloString) },
- { Response = yes("<output>Hello World</output>") },
+ { Response = yes(HelloString) },
{ HttpCode = 200 }
).
@@ -265,39 +216,44 @@
% `hello' procedure is `pred(di, uo) is det', before we can actually
% call it. The function inst_cast_hello/1 defined below does that.
-:- type io_pred == pred(io__state, io__state).
-:- inst io_pred == (pred(di, uo) is det).
+:- type hello_pred == pred(univ).
+:- inst hello_pred == (pred(out) is det).
-:- func inst_cast_hello(io_pred) = io_pred.
-:- mode inst_cast_hello(in) = out(io_pred) is det.
-:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+:- func inst_cast_hello(hello_pred) = hello_pred.
+:- mode inst_cast_hello(in) = out(hello_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)),
[will_not_call_mercury, thread_safe], "Y = X").
%-----------------------------------------------------------------------%
% GetStockPrice
%-----------------------------------------------------------------------%
-:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_SP_func(in, in, out, out, di, uo) is det.
+:- pred call_SP_func(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_SP_func(in, in, in, out, out, di, uo) is det.
+
+ % XXX error occurs for function but not for predicate
+ % Uncaught exception:
+ % Software Error: dl__mercury_sym:
+ % result type is not a higher-order type
-call_SP_func(Handle, Request, Response, HttpCode) -->
- { list__length(Request^params, Arity) },
-
+call_SP_func(Handle, Filename, Request, Response, HttpCode) -->
% XXX test for function
- % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
+ % { list__length(Request^params, Arity) },
+ % { GetSPProc = mercury_proc(function, unqualified(Filename),
% "get_stockprice", Arity, 0) },
% XXX test for predicate
- { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
+ { GetSPProc = mercury_proc(predicate, unqualified(Filename),
"get_sp", 2, 0) },
dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
(
{ MaybeGetStockPrice = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
- { HttpCode = 500 }
+ { Response = no },
+ { HttpCode = 500 },
+ { error(ErrorMsg) }
;
{ MaybeGetStockPrice = ok(SPProc0) },
@@ -308,10 +264,6 @@
% XXX test for function
% { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
- % message is parsed bottom up, therefore parameter
- % list is in reverse order
- % { list__reverse(Request^params, ParameterList) },
-
% Convert parameters (string) to the corresponding types
{ list__map(lookup_SP_schema, Request^params, UnivList) },
@@ -424,19 +376,20 @@
% schema for GetBookPrice:
%
% <element name="book" type="tns:book"/>
+ % <element name="author" base="tns:author"/>
+ %
% <complexType name="book">
% <sequence>
- % <element name="title" type="mercury:string"/>
+ % <element name="title" type="xsd:string"/>
% <element name="author" type="tns:author"/>
- % <element name="intro" type="mercury:string"/>
+ % <element name="intro" type="xsd:string"/>
% </sequence>
% </complexType>
%
- % <element name="author" base="tns:author"/>
% <complexType name="author">
% <sequence>
- % <element name"surname" type="mercury:string"/>
- % <element name"firstname" type="mercury:string"/>
+ % <element name"surname" type="xsd:string"/>
+ % <element name"firstname" type="xsd:string"/>
% </sequence>
% </complexType>
%
@@ -448,28 +401,27 @@
% author :: author,
% intro :: string
% ).
- %
+ %
% :- type author
% ---> author(
% surname :: string,
% firstname :: string
% ).
-:- pred call_BP_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_BP_pred(in, in, out, out, di, uo) is det.
-
-call_BP_pred(Handle, Request, Response, HttpCode) -->
- { list__length(Request^params, Arity0) },
- { Arity = Arity0 + 1 }, % since it is a predicate
- { GetBPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_bookprice", Arity, 0) },
+:- pred call_BP_pred(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_BP_pred(in, in, in, out, out, di, uo) is det.
+
+call_BP_pred(Handle, Filename, Request, Response, HttpCode) -->
+ { GetBPProc = mercury_proc(predicate, unqualified(Filename),
+ "get_bookprice", 2, 0) },
dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
(
{ MaybeGetBookPrice = error(Msg) },
{ string__append("dlsym failed: ", Msg, ErrorMsg) },
- { Response = yes(ErrorMsg) },
- { HttpCode = 500 }
+ { Response = no },
+ { HttpCode = 500 },
+ { error(ErrorMsg) }
;
{ MaybeGetBookPrice = ok(BPProc0) },
@@ -478,11 +430,11 @@
{ BPProc = inst_cast_bp(BPProc0) },
% Convert parameters (string) to the corresponding types
- % { list__map(lookup_BP_schema, Request^params, UnivList) },
-
+ { list__map(lookup_BP_schema, Request^params, UnivList) },
+
% Call the procedure whose address we just obtained
- { UnivList = [univ(1)] },
{ call(BPProc, UnivList, BPUniv) },
+
{ det_univ_to_type(BPUniv, BPInt) },
{ string__int_to_string(BPInt, BPString) },
@@ -493,64 +445,75 @@
).
-/* still working
-
-:- pred searchBPList(list(parameter), string, maybe(list(parameter)),
- maybe(string)).
-:- mode searchBPList(in, in, out, out) is semidet.
-
-searchBPList(ParamList, ElemName, Struct, Value) :-
- Elem = parameter(ElemName, _, _, _, _),
- (
- list__nth_member_search(ParamList, Elem, Pos),
- list__index1(ParamList, Pos, Param)
- ->
- Struct = Param^pFields,
- Value = Param^pValue
- ;
- fail
- ).
-
:- pred lookup_BP_schema(parameter::in, univ::out) is det.
lookup_BP_schema(Param, ValueAsUniv) :-
(
Param^pName = "book",
- Param^pFields = yes(StructList),
- (
- searchBPList(StructList, "title", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- searchBPList(StructList, "author", Child, _),
- Child = yes(ChildStructList)
- ->
- (
- searchBPList(ChildStructList, "author", _, _ )
- ;
- require__error(
- "Element Structure not defined in schema.")
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "title", Title0),
+ lookup_BP_schema(Title0, TitleAsUniv),
+ det_univ_to_type(TitleAsUniv, Title),
+
+ get_BP_param(FieldList, "author", Author0),
+ lookup_BP_schema(Author0, AuthorAsUniv),
+ det_univ_to_type(AuthorAsUniv, Author),
+
+ get_BP_param(FieldList, "intro", Intro0),
+ lookup_BP_schema(Intro0, IntroAsUniv),
+ det_univ_to_type(IntroAsUniv, Intro),
- )
- ;
- searchBPList(StructList, "intro", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- require__error(
- "Element Structure not defined in schema.")
- )
+ ValueAsBook = book(Title, Author, Intro),
+ ValueAsUniv = univ(ValueAsBook)
+ ;
+ Param^pName = "title",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
;
+ Param^pName = "author",
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "surname", Surname0),
+ lookup_BP_schema(Surname0, SurnameAsUniv),
+ det_univ_to_type(SurnameAsUniv, Surname),
+
+ get_BP_param(FieldList, "firstname", Firstname0),
+ lookup_BP_schema(Firstname0, FirstnameAsUniv),
+ det_univ_to_type(FirstnameAsUniv, Firstname),
+
+ ValueAsAuthor = author(Surname, Firstname),
+ ValueAsUniv = univ(ValueAsAuthor)
+ ;
+ Param^pName = "surname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "firstname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "intro",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
require__error("Element Structure not defined in schema.")
).
-*/
+:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is det.
+
+get_BP_param(ParamList, SearchString, Parameter) :-
+ list__filter((pred(X::in) is semidet :-
+ X = parameter(SearchString,_,_,_,_)), ParamList, Result),
+ list__index1_det(Result, 1, Parameter).
+
% inst cast for get_bookprice
:- type bp_pred == pred(list(univ), univ).
+% :- type bp_pred == pred(book, univ).
:- inst bp_pred == (pred(in, out) is det).
:- func inst_cast_bp(bp_pred) = bp_pred.
@@ -561,6 +524,14 @@
%-----------------------------------------------------------------------%
% Shared functions
%-----------------------------------------------------------------------%
+
+ % Returns filename from ./libfilename.so
+:- pred get_filename(string::in, string::out) is det.
+
+get_filename(LibFile, Filename) :-
+ string__split(LibFile, 5, _Left, Filename0),
+ string__length(Filename0, Length),
+ string__left(Filename0, Length-3, Filename).
% Separates prefix and suffix.
:- pred split_on_colon(string::in, string::out, string::out) is det.
|
|
From: Ina C. <in...@st...> - 2001-01-31 01:22:06
|
Here is the minimal diff again.
? temp
? server
? soap_test_methods.init
Index: soap_test_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.1
diff -u -r1.1 soap_test_methods.m
--- soap_test_methods.m 2001/01/25 06:54:42 1.1
+++ soap_test_methods.m 2001/01/31 01:19:15
@@ -23,7 +23,8 @@
:- interface.
:- import_module io, int, list, std_util.
-:- pred hello(state::di, state::uo) is det.
+% :- pred hello(state::di, state::uo) is det.
+:- pred hello(univ::out) is det.
:- pred get_sp(list(univ)::in, univ::out) is det.
@@ -51,7 +52,9 @@
% Hello
%---------------------------------------------------------------------%
-hello --> print("Hello, world\n").
+% hello --> print("Hello, world\n").
+hello(OutputAsUniv) :-
+ OutputAsUniv = univ("Hello, world").
%---------------------------------------------------------------------%
% GetStockPrice
Index: web_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.1
diff -u -r1.1 web_methods.m
--- web_methods.m 2001/01/25 06:54:42 1.1
+++ web_methods.m 2001/01/31 01:19:15
@@ -238,7 +238,7 @@
call_Hello_pred(Handle, _Request, Response, HttpCode) -->
{ HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
- "hello", 2, 0) },
+ "hello", 1, 0) },
dl__mercury_sym(Handle, HelloProc, MaybeHello),
(
{ MaybeHello = error(Msg) },
@@ -254,9 +254,13 @@
% Call the procedure whose address
% we just obtained.
- HelloPred,
+ % HelloPred,
+ % { Response = yes("<output>Hello World</output>") },
- { Response = yes("<output>Hello World</output>") },
+ { HelloPred(OutputAsUniv) },
+ { det_univ_to_type(OutputAsUniv, OutputAsString) },
+ { Response = yes(OutputAsString) },
+
{ HttpCode = 200 }
).
@@ -264,9 +268,12 @@
% We need to cast it to the right higher-order inst, which for the
% `hello' procedure is `pred(di, uo) is det', before we can actually
% call it. The function inst_cast_hello/1 defined below does that.
+
+:- type io_pred == pred(univ).
+:- inst io_pred == (pred(out) is det).
-:- type io_pred == pred(io__state, io__state).
-:- inst io_pred == (pred(di, uo) is det).
+% :- type io_pred == pred(io__state, io__state).
+% :- inst io_pred == (pred(di, uo) is det).
:- func inst_cast_hello(io_pred) = io_pred.
:- mode inst_cast_hello(in) = out(io_pred) is det.
@@ -285,12 +292,12 @@
{ list__length(Request^params, Arity) },
% XXX test for function
- % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
- % "get_stockprice", Arity, 0) },
+ { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
+ "get_stockprice", Arity, 0) },
% XXX test for predicate
- { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_sp", 2, 0) },
+ % { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
+ % "get_sp", 2, 0) },
dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
(
@@ -304,9 +311,9 @@
% Cast the higher-order term that we obtained
% to the correct higher-order inst.
% XXX test for predicate
- { SPProc = inst_cast_sp(SPProc0) },
+ % { SPProc = inst_cast_sp(SPProc0) },
% XXX test for function
- % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
+ { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
% message is parsed bottom up, therefore parameter
% list is in reverse order
@@ -317,9 +324,9 @@
% Call the procedure whose address we just obtained
% XXX test for predicate
- { call(SPProc, UnivList, SPUniv) },
+ % { call(SPProc, UnivList, SPUniv) },
% XXX test for function
- % { SPUniv = SPFunc(UnivList) },
+ { SPUniv = SPFunc(UnivList) },
{ det_univ_to_type(SPUniv, SPInt) },
{ string__int_to_string(SPInt, SPString) },
|
|
From: Ina C. <in...@st...> - 2001-01-31 00:46:50
|
Here is the diff that doesn't work:
Index: soap_test_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.1
diff -u -r1.1 soap_test_methods.m
--- soap_test_methods.m 2001/01/25 06:54:42 1.1
+++ soap_test_methods.m 2001/01/31 00:40:03
@@ -23,14 +23,30 @@
:- interface.
:- import_module io, int, list, std_util.
-:- pred hello(state::di, state::uo) is det.
+:- pred hello(univ::out) is det.
+% :- pred hello(io__state::di, io__state::uo) is det.
+% :- pred hello(list(univ)::in, univ::out) is det.
:- pred get_sp(list(univ)::in, univ::out) is det.
:- func get_stockprice(list(univ)) = univ.
%---------------------------------------------------------------------%
:- implementation.
@@ -50,8 +66,14 @@
%---------------------------------------------------------------------%
% Hello
%---------------------------------------------------------------------%
+
+% hello --> print("Hello, world").
+
+hello(ResultAsUniv) :-
+ ResultAsUniv = univ("<output>Hello, world</output>").
-hello --> print("Hello, world\n").
+% hello(_List, ResultAsUniv) :-
+% ResultAsUniv = univ("<output>Hello, world</output>").
%---------------------------------------------------------------------%
% GetStockPrice
Index: web_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.1
diff -u -r1.1 web_methods.m
--- web_methods.m 2001/01/25 06:54:42 1.1
+++ web_methods.m 2001/01/31 00:40:03
@@ -172,8 +105,12 @@
% Opens library file, invokes desire function, and gets back
% corresponding response and http code.
-load_dynamic_library(L, Request, Response, HttpCode) -->
- dl__open(L, lazy, local, MaybeHandle),
+ %
+ % LibFile format = "./libfilename.so"
+ %
+load_dynamic_library(LibFile, Request, Response, HttpCode) -->
+ dl__open(LibFile, lazy, local, MaybeHandle),
+ { get_filename(LibFile, Filename) },
(
{ MaybeHandle = error(OpenMsg) },
{ string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
@@ -185,17 +122,20 @@
% Hello has no parameter
{ Request^name = "Hello" }
->
- call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ call_Hello_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetStockPrice has 1 parameter
{ Request^name = "GetStockPrice" }
->
- call_SP_func(Handle, Request, Response0, HttpCode0)
+ call_SP_func(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetBookPrice takes in a struct
{ Request^name = "GetBookPrice" }
->
- call_BP_pred(Handle, Request, Response0, HttpCode0)
+ call_BP_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
{ Response0 = yes("Method requested not
implemented.") },
@@ -232,13 +172,13 @@
% Hello
%-----------------------------------------------------------------------%
-:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
-
-call_Hello_pred(Handle, _Request, Response, HttpCode) -->
- { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
- "hello", 2, 0) },
+:- pred call_Hello_pred(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_Hello_pred(in, in, in, out, out, di, uo) is det.
+
+call_Hello_pred(Handle, Filename, _Request, Response, HttpCode) -->
+ { HelloProc = mercury_proc(predicate, unqualified(Filename),
+ "hello", 1, 0) },
dl__mercury_sym(Handle, HelloProc, MaybeHello),
(
{ MaybeHello = error(Msg) },
@@ -254,9 +194,27 @@
% Call the procedure whose address
% we just obtained.
- HelloPred,
+ % HelloPred,
+
+ % XXX error occurs
+ % if change hello(io__state::di, io__state::uo) is det
+ % to hello(univ::out) is det or
+ % hello(list(univ)::in, univ::out) is det ????
+
+/*
+This is the same error that I have for the MLDS closure problem
+
+*** Mercury runtime: caught segmentation violation ***
+PC at signal: 1074572806 (400cae06)
+address involved: 0x40017de8
+This may have been caused by a stack overflow, due to unbounded recursion.
+exiting from signal handler
+*/
+ { HelloPred(HelloUniv) },
+ { det_univ_to_type(HelloUniv, HelloString) },
- { Response = yes("<output>Hello World</output>") },
+ % { HelloString = "<output>Hello, world</output>" },
+ { Response = yes(HelloString) },
{ HttpCode = 200 }
).
@@ -265,32 +223,43 @@
% `hello' procedure is `pred(di, uo) is det', before we can actually
% call it. The function inst_cast_hello/1 defined below does that.
-:- type io_pred == pred(io__state, io__state).
-:- inst io_pred == (pred(di, uo) is det).
+:- type hello_pred == pred(univ).
+:- inst hello_pred == (pred(out) is det).
-:- func inst_cast_hello(io_pred) = io_pred.
-:- mode inst_cast_hello(in) = out(io_pred) is det.
-:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+% :- type hello_pred == pred(io__state, io__state).
+% :- inst hello_pred == (pred(di, uo) is det).
+
+:- func inst_cast_hello(hello_pred) = hello_pred.
+:- mode inst_cast_hello(in) = out(hello_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)),
[will_not_call_mercury, thread_safe], "Y = X").
%-----------------------------------------------------------------------%
% GetStockPrice
%-----------------------------------------------------------------------%
+
+:- pred call_SP_func(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_SP_func(in, in, in, out, out, di, uo) is det.
+
+ % XXX error occurs for function but not for predicate
+/*
+
+Uncaught exception:
+Software Error: dl__mercury_sym: result type is not a higher-order type
-:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_SP_func(in, in, out, out, di, uo) is det.
+*/
-call_SP_func(Handle, Request, Response, HttpCode) -->
+call_SP_func(Handle, Filename, Request, Response, HttpCode) -->
{ list__length(Request^params, Arity) },
% XXX test for function
- % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
- % "get_stockprice", Arity, 0) },
+ { GetSPProc = mercury_proc(function, unqualified(Filename),
+ "get_stockprice", Arity, 0) },
% XXX test for predicate
- { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_sp", 2, 0) },
+ % { GetSPProc = mercury_proc(predicate, unqualified(Filename),
+ % "get_sp", 2, 0) },
dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
(
@@ -304,22 +273,18 @@
% Cast the higher-order term that we obtained
% to the correct higher-order inst.
% XXX test for predicate
- { SPProc = inst_cast_sp(SPProc0) },
+ % { SPProc = inst_cast_sp(SPProc0) },
% XXX test for function
- % { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
+ { wrapper(SPFunc) = inst_cast_stockprice(SPProc0) },
% Convert parameters (string) to the corresponding types
{ list__map(lookup_SP_schema, Request^params, UnivList) },
% Call the procedure whose address we just obtained
% XXX test for predicate
- { call(SPProc, UnivList, SPUniv) },
+ % { call(SPProc, UnivList, SPUniv) },
% XXX test for function
- % { SPUniv = SPFunc(UnivList) },
+ { SPUniv = SPFunc(UnivList) },
{ det_univ_to_type(SPUniv, SPInt) },
{ string__int_to_string(SPInt, SPString) },
@@ -384,13 +349,13 @@
% inst cast for get_sp (predicate)
-:- type sp_pred == pred(list(univ), univ).
-:- inst sp_pred == (pred(in, out) is det).
+% :- type sp_pred == pred(list(univ), univ).
+% :- inst sp_pred == (pred(in, out) is det).
-:- func inst_cast_sp(sp_pred) = sp_pred.
-:- mode inst_cast_sp(in) = out(sp_pred) is det.
-:- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)),
- [will_not_call_mercury, thread_safe], "Y=X").
+% :- func inst_cast_sp(sp_pred) = sp_pred.
+% :- mode inst_cast_sp(in) = out(sp_pred) is det.
+% :- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)),
+% [will_not_call_mercury, thread_safe], "Y=X").
% inst cast for get_stockprice (function)
:- type stockprice == (func(list(univ)) = univ ).
@@ -561,6 +550,14 @@
%-----------------------------------------------------------------------%
% Shared functions
%-----------------------------------------------------------------------%
+
+ % Returns filename from ./libfilename.so
+:- pred get_filename(string::in, string::out) is det.
+
+get_filename(LibFile, Filename) :-
+ string__split(LibFile, 5, _Left, Filename0),
+ string__length(Filename0, Length),
+ string__left(Filename0, Length-3, Filename).
% Separates prefix and suffix.
:- pred split_on_colon(string::in, string::out, string::out) is det.
|
|
From: Ina C. <in...@st...> - 2001-01-30 23:53:52
|
Hi Tyson,
As I've mentioned there are 2 bugs in the program. The first one is
with dynamic linking, all the procedure calls have to be predicates
but not functions (see GetStockPrice for example in the code).
The error is:
Uncaught exception:
Software Error: dl__mercury_sym: result type is not a higher-order type
The second one is I can't change HelloPred to accept any arguments.
The error is:
*** Mercury runtime: caught segmentation violation ***
PC at signal: 1074572806 (400cae06)
address involved: 0x40017de8
This may have been caused by a stack overflow, due to unbounded recursion.
exiting from signal handler
Can you please take a look at it? To reproduce the error, please check
out the modules from quicksilver, and combine with the following diff.
Then under the /webserver directory, run
mmake GRADE=hlc.par.gc depend
mmake GRADE=hlc.par.gc
I've attached 2 files to test the program. The first one is for
testing hello pred and the other one is for testing GetStockPrice.
Thanks in advance.
Ina
<in...@st...>
====================================================================
? data
? temp
? server
? data3
? test
? data1
? data2
? schema
? soap_test_methods.init
? Jan30-web_methods.m
Index: server.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/server.m,v
retrieving revision 1.5
diff -u -r1.5 server.m
--- server.m 2001/01/25 06:54:42 1.5
+++ server.m 2001/01/30 23:36:12
@@ -1,5 +1,5 @@
%---------------------------------------------------------------------------%
-% Copyright (C) 2000 Peter Ross
+% Copyright (C) 2000, 2001 Peter Ross
% This file may only be copied under the terms of the GNU General Public
% License - see the file COPYING
%-----------------------------------------------------------------------------%
@@ -82,7 +82,16 @@
{ RequestOrResponse = left(Request) },
(
{ Request^cmd = post },
- get_soapmessage(TCP, Request, Request1)
+ { check_headers(Request^headers, MayBeError) },
+ (
+ { MayBeError = yes(ErrorResponse) }
+ ->
+ send_response(TCP, ErrorResponse),
+ tcp__shutdown(TCP),
+ { error("Invalid HTTP headers in request.\n") }
+ ;
+ get_soapmessage(TCP, Request, Request1)
+ )
;
{ Request^cmd = get },
{ Request1 = Request }
@@ -226,6 +235,67 @@
%---------------------------------------------------------------------------%
+ % Section 6 Using SOAP in HTTP
+ % " HTTP applications MUST use the media type "text/xml"
+ % according to RFC 2376 when including SOAP entity bodies
+ % in HTTP messages.
+ %
+ % Section 6.1.1. The SOAPAction HTTP Header Field
+ % " An HTTP client MUST use this header field when issuing a
+ % SOAP HTTP Request. "
+
+
+:- pred check_headers(list(header)::in, maybe(response)::out) is det.
+
+check_headers(Headers, Response) :-
+ check_each_header(Headers, soapaction_header,
+ "SOAPAction header not found.\n", MayBeResponse0),
+ (
+ MayBeResponse0 = no
+ ->
+ check_each_header(Headers, content_type_header,
+ "Incorrect Content-Type value.\n", MayBeResponse1),
+ (
+ MayBeResponse1 = no
+ ->
+ Response = no
+ ;
+ Response = MayBeResponse1
+ )
+ ;
+ Response = MayBeResponse0
+ ).
+
+:- pred check_each_header(list(header), pred(header), string, maybe(response)).
+:- mode check_each_header(in, pred(in) is semidet, in, out) is det.
+
+check_each_header(Headers, Pred, ErrorMessage, Response) :-
+ list__filter(Pred, Headers, Result),
+ (
+ Result \= []
+ ->
+ Response = no
+ ;
+ Response = yes(response(
+ 400,
+ [],
+ string_body(ErrorMessage),
+ yes )
+ )
+
+ ).
+
+:- pred soapaction_header(header::in) is semidet.
+soapaction_header(header("SOAPAction:", _, _)).
+
+:- pred content_type_header(header::in) is semidet.
+content_type_header(header("Content-Type:", "text/xml", _)).
+content_type_header(header("Content-type:", "text/xml", _)).
+content_type_header(header("Content-Type:", "text/xml;", _)).
+content_type_header(header("Content-type:", "text/xml;", _)).
+
+%---------------------------------------------------------------------------%
+
:- pred get_soapmessage(S, request, request, io__state, io__state)
<= stream__duplex(S).
:- mode get_soapmessage(in, in, out, di, uo) is det.
@@ -243,7 +313,17 @@
yes(string__from_char_list(SoapMessage))
) }
;
- { error("No content-length supplied. Program Terminated.") }
+ { ErrorResponse = response(
+ 411,
+ [],
+ string_body("Content-Length not supplied.\n"),
+ yes) },
+ send_response(S, ErrorResponse),
+
+ % XXX how to convert S back to tcp such that
+ % tcp__shutdown(S) can be called ?
+
+ { error("Content-Length not supplied in request.") }
).
:- pred get_content_length(list(header)::in, int::out) is semidet.
@@ -268,13 +348,12 @@
is_content_type("Content-type:").
:- pred get_body(S, int, list(char), io__state, io__state)
- <= stream__duplex(S).
+ <= stream__input(S).
:- mode get_body(in, in, out, di, uo) is det.
-% XXX if there are still characters when length = 0
-% the rest will not be obtained and consequently parsing
-% an incomplete message will throw an exception.
-
+ % If there are still characters when length = 0,
+ % the rest will not be obtained and consequently parsing
+ % an incomplete message will throw an exception.
get_body(S, Length, RequestLines) -->
stream__read_char(S, CharResult),
{ Length0 = Length - 1 },
@@ -334,9 +413,14 @@
)
;
{ Request^cmd = post },
+ write(uri_to_filename(Request^uri)), nl,
(
{ Request^body = yes(Body) } ,
parse_soapmessage(Body, NsBody),
+
+ % parse_soapmessage calls error/1 when failed
+ % should change to response with http code = 415
+
write(NsBody), nl, nl,
{ get_procedure_call(NsBody, Proc) },
@@ -345,12 +429,12 @@
{ make_web_request(NsBody, Proc, WebRequest) },
write(WebRequest), nl, nl,
- load_dynamic_library("./libsoap_test_methods.so",
+ load_dynamic_library(uri_to_filename(Request^uri),
WebRequest, Result, HttpCode),
(
- { Result = yes(Output) },
+ { Result = yes(OutputString) },
{ generate_response_body(NsBody, Proc,
- Output, ResBody0) },
+ OutputString, ResBody0) },
{ ResBody = string_body(ResBody0) }
;
{ Result = no },
@@ -363,7 +447,7 @@
{ ResBody = no_body },
{ HttpCode = 400 }
),
- { list__filter(filter, Request^headers, Headers) },
+ { generate_headers(Request^headers, ResBody, Headers) },
{ Response = response(HttpCode, Headers,
ResBody, yes) }
).
@@ -380,9 +464,24 @@
last_char(Str)
= string__unsafe_index(Str, string__length(Str) - 1).
+:- pred generate_headers(list(header)::in, response_body::in,
+ list(header)::out) is det.
+generate_headers(RequestHeaders, ResBody, Headers) :-
+ list__filter(filter, RequestHeaders, Headers0),
+ (
+ ResBody = string_body(Body),
+ string__length(Body, BodyLength),
+ string__int_to_string(BodyLength, StringLength),
+ ConLen = [header("Content-Length:", StringLength, no)],
+ list__append(ConLen, Headers0, Headers)
+ ;
+ ResBody = no_body,
+ Headers = Headers0
+ ).
+
:- pred filter(header::in) is semidet.
-filter(header("Content-Length:", _, _)).
filter(header("Content-Type:", _, _)).
+filter(header("Content-type:", _, _)).
%-----------------------------------------------------------------------------%
Index: soap.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v
retrieving revision 1.1
diff -u -r1.1 soap.m
--- soap.m 2001/01/25 06:54:42 1.1
+++ soap.m 2001/01/30 23:36:12
@@ -78,6 +78,9 @@
{ Res = ok((_, Doc)) },
{ nsTranslate(Doc, NsDoc) }
;
+ % instead of error, should change to response
+ % with http code 415 Unsupported Media Type
+
{ Res = error(Err) },
{ string__append("parse_soapmessage failed: ", Err, ErrMsg) },
{ error(ErrMsg) }
@@ -130,12 +133,13 @@
% Gets method name.
get_procedure_call(NsDoc, Procedure) :-
get_procedure(NsDoc, [], Procedurelist),
- get_first_element(Procedurelist, Procedure).
-
-:- pred get_first_element(list(T)::in, T::out) is det.
+ list__index1_det(Procedurelist, 1, Procedure).
+ % get_first_element(Procedurelist, Procedure).
-get_first_element([], _) :- error("Procedure not found.").
-get_first_element([H|_], H).
+% :- pred get_first_element(list(T)::in, T::out) is det.
+%
+% get_first_element([], _) :- error("Procedure not found.").
+% get_first_element([H|_], H).
:- pred get_procedure(nsDocument, list(nsElement), list(nsElement)).
:- mode get_procedure(in, in, out) is det.
@@ -411,10 +415,6 @@
Acc0, Acc1),
call(Pred, ContentArray, Ref, Method, Result, URIs,
Acc1, Acc).
-
-% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det.
-% insert_last([], T, [T]).
-% insert_last([
:- pred my_delete(list(T)::in, list(T)::out) is det.
my_delete([], []).
Index: soap_test_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v
retrieving revision 1.1
diff -u -r1.1 soap_test_methods.m
--- soap_test_methods.m 2001/01/25 06:54:42 1.1
+++ soap_test_methods.m 2001/01/30 23:36:12
@@ -23,14 +23,30 @@
:- interface.
:- import_module io, int, list, std_util.
-:- pred hello(state::di, state::uo) is det.
+%:- pred hello(list(univ)::in, univ::out) is det.
+%:- pred hello(univ::out) is det.
+:- pred hello(io__state::di, io__state::uo) is det.
:- pred get_sp(list(univ)::in, univ::out) is det.
:- func get_stockprice(list(univ)) = univ.
-:- pred get_bookprice(list(univ)::in, univ::out) is det.
+:- pred get_bookprice(list(univ)::in, univ::out, io__state::di,
+ io__state::uo) is det.
+:- type book
+ ---> book(
+ title :: string,
+ author :: author,
+ intro :: string
+ ).
+
+:- type author
+ ---> author(
+ surname :: string,
+ firstname :: string
+ ).
+
%---------------------------------------------------------------------%
:- implementation.
@@ -50,8 +66,11 @@
%---------------------------------------------------------------------%
% Hello
%---------------------------------------------------------------------%
+
+hello --> print("Hello, world").
-hello --> print("Hello, world\n").
+% hello(_List, ResultAsUniv) :-
+% ResultAsUniv = univ("<output>Hello, world</output>").
%---------------------------------------------------------------------%
% GetStockPrice
@@ -88,7 +107,9 @@
% GetBookPrice
%---------------------------------------------------------------------%
-get_bookprice(ParamList, ResultAsUniv) :-
- ResultAsUniv = univ(100).
+get_bookprice(ParamList, ResultAsUniv) -->
+ { list__index1_det(ParamList, 1, Param) },
+ write(Param),
+ { ResultAsUniv = univ(100) }.
Index: web_methods.m
===================================================================
RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v
retrieving revision 1.1
diff -u -r1.1 web_methods.m
--- web_methods.m 2001/01/25 06:54:42 1.1
+++ web_methods.m 2001/01/30 23:36:12
@@ -42,14 +42,7 @@
pFields :: maybe(list(parameter))
% Struct or Array
).
-/* Ignore this
- % Converts method name and parameters in xml.ns format to
- % a web request.
-:- pred make_web_request(nsElement, list(parameter), web_method_request).
-:- mode make_web_request(in, in, out) is det.
-*/
-
% Loads library, invokes method call and generates corresponding
% response.
:- pred load_dynamic_library(string::in, web_method_request::in,
@@ -63,71 +56,11 @@
:- implementation.
:- import_module bool, int, require.
:- import_module dl, name_mangle, soap_test_methods.
-
- % XXX change that to command line argument
-:- func soap_library_file = string.
-soap_library_file = "soap_test_methods".
-
-/* Ignore this. Not used anymore
-
- % Generates a web request using method and parameters
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- Request^params = Params.
-
-make_web_request(Proc, Params, Request) :-
- Request^name = Proc^eName^localName,
- Request^uri = Proc^eName^nsURI,
- form_pair(Params, ParamsPair),
- list__map(retrieve_params, ParamsPair, Request^params).
-
- % Transform parameter list from [parameter, data, parameter, data ..]
- % to [(parameter - data)] to distinguish elements
-:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))).
-:- mode form_pair(in, out) is det.
-form_pair(ParamList , PairList) :-
- (
- ParamList = []
- ->
- PairList = []
- ;
- ParamList = [Param, Data | Tail]
- % list__split_list(2, ParamList, Start, End),
- % Start = [Param, Data]
- ->
- PairList = [(Param - Data) | PairList0],
- form_pair(Tail, PairList0)
- ;
- error("Incorrect Data Format")
- ).
+% :- func soap_library_file = string.
+% soap_library_file = "soap_test_methods".
- % Retrieve parameter name, uri, type if defined and data value.
-:- pred retrieve_params(pair(nsContent, nsContent), parameter).
-:- mode retrieve_params(in, out) is det.
-
-retrieve_params((Param0 - Data), Parameter) :-
- (
- Param0 = nsElement(Param),
- Data = data(Value)
- ->
- Name = Param^eName^localName,
- URI = Param^eName^nsURI,
- (
- search_attributes(Param^eAttrs, Type0)
- ->
- Type = yes(Type0)
- ;
- Type = no
- ),
- Parameter = parameter(Name, Type, Value, URI)
- ;
- error("Incorrect Data Format")
- ).
-*/
-
% Types in XML can be defined either by using xsi:type attribute
% or by using schema. This predicate is used to search if
% any attribute contains `xsi:type'.
@@ -172,8 +105,12 @@
% Opens library file, invokes desire function, and gets back
% corresponding response and http code.
-load_dynamic_library(L, Request, Response, HttpCode) -->
- dl__open(L, lazy, local, MaybeHandle),
+ %
+ % LibFile format = "./libfilename.so"
+ %
+load_dynamic_library(LibFile, Request, Response, HttpCode) -->
+ dl__open(LibFile, lazy, local, MaybeHandle),
+ { get_filename(LibFile, Filename) },
(
{ MaybeHandle = error(OpenMsg) },
{ string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) },
@@ -185,17 +122,20 @@
% Hello has no parameter
{ Request^name = "Hello" }
->
- call_Hello_pred(Handle, Request, Response0, HttpCode0)
+ call_Hello_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetStockPrice has 1 parameter
{ Request^name = "GetStockPrice" }
->
- call_SP_func(Handle, Request, Response0, HttpCode0)
+ call_SP_func(Handle, Filename, Request,
+ Response0, HttpCode0)
;
% GetBookPrice takes in a struct
{ Request^name = "GetBookPrice" }
->
- call_BP_pred(Handle, Request, Response0, HttpCode0)
+ call_BP_pred(Handle, Filename, Request,
+ Response0, HttpCode0)
;
{ Response0 = yes("Method requested not
implemented.") },
@@ -232,12 +172,12 @@
% Hello
%-----------------------------------------------------------------------%
-:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_Hello_pred(in, in, out, out, di, uo) is det.
+:- pred call_Hello_pred(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_Hello_pred(in, in, in, out, out, di, uo) is det.
-call_Hello_pred(Handle, _Request, Response, HttpCode) -->
- { HelloProc = mercury_proc(predicate, unqualified(soap_library_file),
+call_Hello_pred(Handle, Filename, _Request, Response, HttpCode) -->
+ { HelloProc = mercury_proc(predicate, unqualified(Filename),
"hello", 2, 0) },
dl__mercury_sym(Handle, HelloProc, MaybeHello),
(
@@ -256,7 +196,25 @@
% we just obtained.
HelloPred,
- { Response = yes("<output>Hello World</output>") },
+ % XXX error occurs
+ % if change hello(io__state::di, io__state::uo) is det
+ % to hello(univ::out) is det or
+ % hello(list(univ)::in, univ::out) is det ????
+
+/*
+This is the same error that I have for the MLDS closure problem
+
+*** Mercury runtime: caught segmentation violation ***
+PC at signal: 1074572806 (400cae06)
+address involved: 0x40017de8
+This may have been caused by a stack overflow, due to unbounded recursion.
+exiting from signal handler
+*/
+ % { HelloPred([], HelloUniv) },
+ % { det_univ_to_type(HelloUniv, HelloString) },
+
+ { HelloString = "<output>Hello, world</output>" },
+ { Response = yes(HelloString) },
{ HttpCode = 200 }
).
@@ -264,32 +222,43 @@
% We need to cast it to the right higher-order inst, which for the
% `hello' procedure is `pred(di, uo) is det', before we can actually
% call it. The function inst_cast_hello/1 defined below does that.
+
+% :- type hello_pred == pred(univ).
+% :- inst hello_pred == (pred(out) is det).
-:- type io_pred == pred(io__state, io__state).
-:- inst io_pred == (pred(di, uo) is det).
+:- type hello_pred == pred(io__state, io__state).
+:- inst hello_pred == (pred(di, uo) is det).
-:- func inst_cast_hello(io_pred) = io_pred.
-:- mode inst_cast_hello(in) = out(io_pred) is det.
-:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)),
+:- func inst_cast_hello(hello_pred) = hello_pred.
+:- mode inst_cast_hello(in) = out(hello_pred) is det.
+:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)),
[will_not_call_mercury, thread_safe], "Y = X").
%-----------------------------------------------------------------------%
% GetStockPrice
%-----------------------------------------------------------------------%
+
+:- pred call_SP_func(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_SP_func(in, in, in, out, out, di, uo) is det.
+
+ % XXX error occurs for function but not for predicate
+/*
-:- pred call_SP_func(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_SP_func(in, in, out, out, di, uo) is det.
+Uncaught exception:
+Software Error: dl__mercury_sym: result type is not a higher-order type
-call_SP_func(Handle, Request, Response, HttpCode) -->
+*/
+
+call_SP_func(Handle, Filename, Request, Response, HttpCode) -->
{ list__length(Request^params, Arity) },
% XXX test for function
- % { GetSPProc = mercury_proc(function, unqualified(soap_library_file),
+ % { GetSPProc = mercury_proc(function, unqualified(Filename),
% "get_stockprice", Arity, 0) },
% XXX test for predicate
- { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file),
+ { GetSPProc = mercury_proc(predicate, unqualified(Filename),
"get_sp", 2, 0) },
dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice),
@@ -424,19 +393,20 @@
% schema for GetBookPrice:
%
% <element name="book" type="tns:book"/>
+ % <element name="author" base="tns:author"/>
+ %
% <complexType name="book">
% <sequence>
- % <element name="title" type="mercury:string"/>
+ % <element name="title" type="xsd:string"/>
% <element name="author" type="tns:author"/>
- % <element name="intro" type="mercury:string"/>
+ % <element name="intro" type="xsd:string"/>
% </sequence>
% </complexType>
%
- % <element name="author" base="tns:author"/>
% <complexType name="author">
% <sequence>
- % <element name"surname" type="mercury:string"/>
- % <element name"firstname" type="mercury:string"/>
+ % <element name"surname" type="xsd:string"/>
+ % <element name"firstname" type="xsd:string"/>
% </sequence>
% </complexType>
%
@@ -455,15 +425,15 @@
% firstname :: string
% ).
-:- pred call_BP_pred(handle, web_method_request, maybe(string), http_code,
- io__state, io__state).
-:- mode call_BP_pred(in, in, out, out, di, uo) is det.
-
-call_BP_pred(Handle, Request, Response, HttpCode) -->
- { list__length(Request^params, Arity0) },
- { Arity = Arity0 + 1 }, % since it is a predicate
- { GetBPProc = mercury_proc(predicate, unqualified(soap_library_file),
- "get_bookprice", Arity, 0) },
+:- pred call_BP_pred(handle, string, web_method_request, maybe(string),
+ http_code, io__state, io__state).
+:- mode call_BP_pred(in, in, in, out, out, di, uo) is det.
+
+call_BP_pred(Handle, Filename, Request, Response, HttpCode) -->
+ % { list__length(Request^params, Arity0) },
+ % { Arity = Arity0 + 1 }, % since it is a predicate
+ { GetBPProc = mercury_proc(predicate, unqualified(Filename),
+ "get_bookprice", 4, 0) },
dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice),
(
{ MaybeGetBookPrice = error(Msg) },
@@ -478,11 +448,14 @@
{ BPProc = inst_cast_bp(BPProc0) },
% Convert parameters (string) to the corresponding types
- % { list__map(lookup_BP_schema, Request^params, UnivList) },
+ % XXX cannot call list__map
+ % need to use foldl ??
+ { list__map(lookup_BP_schema, Request^params, UnivList) },
+ % { UnivList = [univ(1)] },
+
% Call the procedure whose address we just obtained
- { UnivList = [univ(1)] },
- { call(BPProc, UnivList, BPUniv) },
+ call(BPProc, UnivList, BPUniv),
{ det_univ_to_type(BPUniv, BPInt) },
{ string__int_to_string(BPInt, BPString) },
@@ -493,65 +466,85 @@
).
-/* still working
-
-:- pred searchBPList(list(parameter), string, maybe(list(parameter)),
- maybe(string)).
-:- mode searchBPList(in, in, out, out) is semidet.
-
-searchBPList(ParamList, ElemName, Struct, Value) :-
- Elem = parameter(ElemName, _, _, _, _),
- (
- list__nth_member_search(ParamList, Elem, Pos),
- list__index1(ParamList, Pos, Param)
- ->
- Struct = Param^pFields,
- Value = Param^pValue
- ;
- fail
- ).
-
:- pred lookup_BP_schema(parameter::in, univ::out) is det.
lookup_BP_schema(Param, ValueAsUniv) :-
(
Param^pName = "book",
- Param^pFields = yes(StructList),
- (
- searchBPList(StructList, "title", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- searchBPList(StructList, "author", Child, _),
- Child = yes(ChildStructList)
- ->
- (
- searchBPList(ChildStructList, "author", _, _ )
- ;
- require__error(
- "Element Structure not defined in schema.")
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "title", Title0),
+ lookup_BP_schema(Title0, TitleAsUniv),
+
+ det_univ_to_type(TitleAsUniv, Title),
+
+ get_BP_param(FieldList, "author", Author0),
+ lookup_BP_schema(Author0, AuthorAsUniv),
+ det_univ_to_type(AuthorAsUniv, Author),
+
+ get_BP_param(FieldList, "intro", Intro0),
+ lookup_BP_schema(Intro0, IntroAsUniv),
+ det_univ_to_type(IntroAsUniv, Intro),
- )
- ;
- searchBPList(StructList, "intro", Child, Value0),
- Child = no,
- Value0 = yes(Value)
- ->
- type_cast_parameter("string", Value, ValueAsUniv)
- ;
- require__error(
- "Element Structure not defined in schema.")
- )
+ ValueAsBook = book(Title, Author, Intro),
+ ValueAsUniv = univ(ValueAsBook)
+ ;
+ Param^pName = "title",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
;
+ Param^pName = "author",
+ Param^pFields = yes(FieldList)
+ ->
+ get_BP_param(FieldList, "surname", Surname0),
+ lookup_BP_schema(Surname0, SurnameAsUniv),
+ det_univ_to_type(SurnameAsUniv, Surname),
+
+ get_BP_param(FieldList, "firstname", Firstname0),
+ lookup_BP_schema(Firstname0, FirstnameAsUniv),
+ det_univ_to_type(FirstnameAsUniv, Firstname),
+
+ ValueAsAuthor = author(Surname, Firstname),
+ ValueAsUniv = univ(ValueAsAuthor)
+ ;
+ Param^pName = "surname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "firstname",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
+ Param^pName = "intro",
+ Param^pValue = yes(Value)
+ ->
+ type_cast_parameter("string", Value, ValueAsUniv)
+ ;
require__error("Element Structure not defined in schema.")
).
+
+/*
+[parameter("book", no, "", no, yes(
+ [parameter("title", no, "", yes("Hello World"), no),
+ parameter("author", no, "", no, yes(
+ [parameter("surname", no, "", yes("Foo"), no),
+ parameter("firstname", no, "", yes("Bar"), no)])),
+ parameter("intro", no, "", yes("Introduction"), no)]))], "some uri")
*/
+:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is det.
+
+get_BP_param(ParamList, SearchString, Parameter) :-
+ list__filter((pred(X::in) is semidet :-
+ X = parameter(SearchString,_,_,_,_)), ParamList, Result),
+ list__index1_det(ParamList, 1, Parameter).
+
% inst cast for get_bookprice
-:- type bp_pred == pred(list(univ), univ).
-:- inst bp_pred == (pred(in, out) is det).
+:- type bp_pred == pred(list(univ), univ, io__state, io__state).
+:- inst bp_pred == (pred(in, out, di, uo) is det).
:- func inst_cast_bp(bp_pred) = bp_pred.
:- mode inst_cast_bp(in) = out(bp_pred) is det.
@@ -561,6 +554,14 @@
%-----------------------------------------------------------------------%
% Shared functions
%-----------------------------------------------------------------------%
+
+ % Returns filename from ./libfilename.so
+:- pred get_filename(string::in, string::out) is det.
+
+get_filename(LibFile, Filename) :-
+ string__split(LibFile, 5, _Left, Filename0),
+ string__length(Filename0, Length),
+ string__left(Filename0, Length-3, Filename).
% Separates prefix and suffix.
:- pred split_on_colon(string::in, string::out, string::out) is det.
|
