Anubis / Xlib | GitLab

Commit 7264ac9e72d08e1d90a17e5fd4e773673de4a4f5

Authored by Totoro 2013-07-07 02:49:21 +0200

add the missing files CXM_http_get.anubis and CXM_https_get.anubis since a long time.

add XML RPC client

Showing 5 changed files with 1580 additions and 0 deletions Show diff stats

Inline Side-by-side

web/CXM_http_get.anubis 0 → 100644

Wrap text Show/Hide comments View file @7264ac9

	1	+ Project The Anubis Project
	2	+
	3	+ Title Getting a document from the Web.
	4	+
	5	+ Copyright Copyright (c) Alain Prouté 2001.
	6	+
	7	+
	8	+ Author Alain Prouté
	9	+
	10	+
	11	+
	12	+ Overview
	13	+ This file defines the function 'http_get' which retrieves a document from the world
	14	+ wide web (a similar function 'https_get' for secured documents is defined in
	15	+ 'https_get.anubis'). The function simulates the behavior of a browser, at least just
	16	+ what is needed to retrieve the document. It does not display the document, but returns
	17	+ it (if found) in the form of a string. It also returns the response line from the
	18	+ server, and the list af all HTTP headers.
	19	+
	20	+ The function 'http_get' takes the following arguments:
	21	+
	22	+ - the name of the server to which the request is to be sent,
	23	+ - the name (including the path) of the document on this server,
	24	+ - a list of headers to be added to mandatory standard headers,
	25	+ - a list of 'arguments' in the form of pairs of strings '(name,value)' to be sent as
	26	+ the body of the request.
	27	+
	28	+
	29	+ The result returned by 'http_get' has the following type, which defines the problems
	30	+ which may happen:
	31	+
	32	+
	33	+read tools/basis.anubis
	34	+read system/string.anubis
	35	+read web/CXM_common.anubis
	36	+read web/CXM_http_get_common.anubis
	37	+
	38	+
	39	+public type HTTP_GET_Result:
	40	+ cannot_resolve_server_name(DNS_Result),
	41	+ cannot_connect_to_server(NetworkConnectError),
	42	+ transmission_problem,
	43	+ request_refused_by_server,
	44	+ ok(String response, // HTTP response line from the server
	45	+ List(HTTP_header) headers, // HTTP headers received from the server
	46	+ String document). // The HTML document itself
	47	+
	48	+
	49	+public define HTTP_GET_Result
	50	+ http_get
	51	+ ( //-------- example: -----------------------
	52	+ String server_name, // "www.machin.com"
	53	+ String document_name, // "/truc/bidule.html"
	54	+ List(HTTP_header) headers, // [http_header("Cookie","..."),...]
	55	+ List(HTTP_argument) arguments // [http_argument("ga","bu"),...]
	56	+ ).
	57	+
	58	+ The same one without the 'headers' argument:
	59	+
	60	+public define HTTP_GET_Result
	61	+ http_get
	62	+ ( //-------- example: -----------------------
	63	+ String server_name, // "www.machin.com"
	64	+ String document_name, // "/truc/bidule.html"
	65	+ List(HTTP_argument) arguments // [http_argument("ga","bu"),...]
	66	+ ) = http_get(server_name,document_name,[],arguments).
	67	+
	68	+
	69	+
	70	+ This file also defines the command 'http_get' to be used directly from the system
	71	+ prompt. To learn about the syntax, just type 'http_get' at the system prompt, or have
	72	+ a look at the end of this file
	73	+
	74	+ --- That's all for public definitions. ------------------------------------------------
	75	+
	76	+
	77	+
	78	+ We need two functions for sending and receiving bytes.
	79	+
	80	+define Maybe(One)
	81	+ send
	82	+ (
	83	+ RWStream conn, // where to send the text
	84	+ String text, // the text to be sent
	85	+ Word32 n // start sending at character number 'n' in 'text'
	86	+ ) =
	87	+ if nth(to_Int(n),text) is
	88	+ {
	89	+ failure then success(unique),
	90	+ success(c) then
	91	+ if conn <- c is
	92	+ {
	93	+ failure then failure,
	94	+ success(_) then send(conn,text,n+1)
	95	+ }
	96	+ }.
	97	+
	98	+define Maybe(String)
	99	+ receive_text_chunk
	100	+ (
	101	+ RWStream conn,
	102	+ List(Word8) so_far,
	103	+ Word32 count
	104	+ ) =
	105	+ if count = 100
	106	+ then success(implode(reverse(so_far)))
	107	+ else if conn is // conn waits for data to be readable from connection
	108	+ {
	109	+ failure then success(implode(reverse(so_far))), // means 'connection closed by peer'
	110	+ success(c) then receive_text_chunk(conn,[c . so_far],count+1)
	111	+ }.
	112	+
	113	+
	114	+define HTTP_GET_Result
	115	+ receive
	116	+ (
	117	+ RWStream conn,
	118	+ String headers,
	119	+ String text_so_far,
	120	+ Bool double_crlf_seen
	121	+ ) =
	122	+ if receive_text_chunk(conn,[],0) is
	123	+ {
	124	+ failure then if separate_headers(headers) is
	125	+ {
	126	+ [ ] then ok("",[],text_so_far),
	127	+ [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far)
	128	+ },
	129	+
	130	+ success(s) then
	131	+ if s = ""
	132	+ then if separate_headers(headers) is
	133	+ {
	134	+ [ ] then ok("",[],text_so_far),
	135	+ [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far)
	136	+ }
	137	+ else with new_s = text_so_far+s,
	138	+ if double_crlf_seen
	139	+ then receive(conn,headers,new_s,true)
	140	+ else if has_double_crlf(new_s) is
	141	+ {
	142	+ failure then receive(conn,headers,new_s,false),
	143	+ success(n) then
	144	+ if sub_string(new_s,n+4,length(new_s)-n-4) is
	145	+ {
	146	+ failure then alert,
	147	+ success(s1) then
	148	+ if sub_string(new_s,0,n) is
	149	+ {
	150	+ failure then alert,
	151	+ success(h) then receive(conn,h,s1,true)
	152	+ }
	153	+ }
	154	+ }
	155	+ }.
	156	+
	157	+
	158	+
	159	+ The next function has a valid TCP/IP connection to the server, and tries to retrieve
	160	+ the document.
	161	+
	162	+
	163	+define HTTP_GET_Result
	164	+ http_get
	165	+ (
	166	+ Bool print_all,
	167	+ RWStream conn,
	168	+ String server_name,
	169	+ String document_name,
	170	+ List(HTTP_header) headers,
	171	+ List(HTTP_argument) arguments,
	172	+ ) =
	173	+ //
	174	+ // Send the HTTP request, and receive the answer:
	175	+ //
	176	+ with body = format_http_args(arguments),
	177	+ with request = (if arguments = [] then "GET " else "POST ")
	178	+ + document_name + " HTTP/1.0" + crlf +
	179	+ "Host: " + server_name + crlf +
	180	+ "Accept-Charset: iso-8859-1,*,utf-8" + crlf +
	181	+ (if arguments = [] then ""
	182	+ else "Content-type: application/x-www-form-urlencoded" + crlf +
	183	+ "Content-length: " + to_decimal(length(body))+ crlf) +
	184	+ format_headers(headers) +
	185	+ crlf +
	186	+ body,
	187	+ (if print_all then
	188	+ (
	189	+ print("----- request ----\n");
	190	+ print(request);
	191	+ print("\n")
	192	+ ) else unique);
	193	+ if send(conn,request,0) is
	194	+ {
	195	+ failure then transmission_problem,
	196	+ success(_) then receive(conn,"","",false)
	197	+ }.
	198	+
	199	+
	200	+ The next function retrieves the document using the numerical (resolved) server address.
	201	+
	202	+define HTTP_GET_Result
	203	+ http_get
	204	+ (
	205	+ Bool print_all,
	206	+ Word32 server_addr,
	207	+ Word32 server_port,
	208	+ String server_name,
	209	+ String document_name,
	210	+ List(HTTP_header) headers,
	211	+ List(HTTP_argument) arguments,
	212	+ ) =
	213	+ //
	214	+ // try to connect to the server before sending the request
	215	+ //
	216	+ if (Result(NetworkConnectError,RWStream))connect(server_addr,server_port) is
	217	+ {
	218	+ error(e) then cannot_connect_to_server(e),
	219	+ ok(conn) then http_get(print_all,conn,server_name,document_name,headers,arguments)
	220	+ }.
	221	+
	222	+
	223	+define HTTP_GET_Result
	224	+ http_get
	225	+ (
	226	+ Bool print_all,
	227	+ String server_name,
	228	+ String document_name,
	229	+ List(HTTP_header) headers,
	230	+ List(HTTP_argument) arguments,
	231	+ ) =
	232	+ if separate_name_port(server_name,80) is (name,port) then
	233	+ //
	234	+ // resolve server name and call 'http_get' with numeric server address:
	235	+ //
	236	+ with a = dns(name),
	237	+ if a is ok(addr)
	238	+ then http_get(print_all,addr,port,name,document_name,headers,arguments)
	239	+ else cannot_resolve_server_name(a).
	240	+
	241	+
	242	+ Now, here is our public tool:
	243	+
	244	+define HTTP_GET_Result
	245	+ http_get
	246	+ (
	247	+ String server_name,
	248	+ String document_name,
	249	+ List(HTTP_header) headers,
	250	+ List(HTTP_argument) arguments,
	251	+ ) = http_get(false,server_name,document_name,headers,arguments).
	252	+
	253	+
	254	+
	255	+ Finally, we construct the executable module 'http_get':
	256	+
	257	+define One
	258	+ recall_syntax =
	259	+ print("\nUsage: http_get <server> <document> [options] =<header> <value> ... -<arg> <value> ...\n");
	260	+ print(" Options are:\n");
	261	+ print(" -print_all print request, response line, headers and document\n");
	262	+ print(" (default is to print only the document)\n").
	263	+
	264	+
	265	+
	266	+
	267	+global define One
	268	+ http_get
	269	+ (
	270	+ List(String) args
	271	+ ) =
	272	+ if args is
	273	+ {
	274	+ [ ] then recall_syntax,
	275	+ [server . t] then if t is
	276	+ {
	277	+ [ ] then recall_syntax,
	278	+ [document . rest] then
	279	+ with print_all = member(rest,"-print_all"),
	280	+ headers = get_headers(rest),
	281	+ arguments = get_arguments(rest),
	282	+ if http_get(print_all,server,document,headers,arguments) is
	283	+ {
	284	+ cannot_resolve_server_name(dns_error) then
	285	+ print("Cannot resolve server name: " + format(dns_error) + ".\n"),
	286	+
	287	+ cannot_connect_to_server(connect_error) then
	288	+ print("Cannot connect to server: " + format(connect_error) + ".\n"),
	289	+
	290	+ transmission_problem then
	291	+ print("Transmission problem.\n"),
	292	+
	293	+ request_refused_by_server then
	294	+ print("The request has been refused by server: " + server + ".\n"),
	295	+
	296	+ ok(response,headers1,document1) then
	297	+ (
	298	+ if print_all
	299	+ then (
	300	+ print("\n----- response ----\n");
	301	+ print(response);
	302	+ print("\n----- headers -----\n");
	303	+ print_headers(headers1);
	304	+ print("----- document ----\n")
	305	+ ) else unique
	306	+ );
	307	+ print(document1) // on the screen (use a redirection to get it in a file)
	308	+ }
	309	+ }
	310	+ }.
	311	+
...	...

web/CXM_https_get.anubis 0 → 100644

Wrap text Show/Hide comments View file @7264ac9

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Getting a document from the secured Web.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2001.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+
	12	+ Overview
	13	+ This file defines the function 'https_get' which retrieve a document from the world
	14	+ wide web in secured mode (HTTPS). The function is analogous to 'http_get', to be found
	15	+ in 'web/http_get.anubis'.
	16	+
	17	+ The function simulates the behavior of a browser, at least just what is needed to
	18	+ retrieve the document. It does not display the document, but returns it (if found) in
	19	+ the form of a string.
	20	+
	21	+ The function 'https_get' takes the following operands:
	22	+
	23	+ - the name of the server to which the request is to be sent,
	24	+ - the name (including the path) of the document on this server,
	25	+ - a list of headers to be added to mandatory standard headers,
	26	+ - a list of 'arguments' to be sent as the body of the request (web arguments).
	27	+ - an accept policy function (see below), for accepting X.509 certificates in case of
	28	+ a problem.
	29	+
	30	+ The result returned by 'https_get' has the following type, which defines the problems
	31	+ which may happen:
	32	+
	33	+
	34	+read tools/basis.anubis
	35	+read system/string.anubis
	36	+read html.anubis
	37	+read http_get_common.anubis
	38	+read http_server.anubis
	39	+read common.anubis
	40	+
	41	+
	42	+public type HTTPS_GET_Result:
	43	+ cannot_resolve_server_name(DNS_Result),
	44	+ ssl_connect_error(SSLConnectError),
	45	+ transmission_problem,
	46	+ request_refused_by_server,
	47	+ ok(String response,
	48	+ List(HTTP_header) headers,
	49	+ String document).
	50	+
	51	+ Cookies are among headers. See 'web/cookies.anubis' for cookies handling.
	52	+
	53	+
	54	+ Note: The types 'DNS_Result' and 'SSLConnectError' are defined in 'predefined.anubis'.
	55	+
	56	+public define HTTPS_GET_Result
	57	+ https_get
	58	+ (
	59	+ String server_name,
	60	+ String document_name,
	61	+ List(HTTP_header) headers,
	62	+ List(HTTP_argument) arguments,
	63	+ (Maybe(X509)) -> Bool accept_policy
	64	+ ).
	65	+
	66	+ The same one without the 'headers' argument:
	67	+
	68	+public define HTTPS_GET_Result
	69	+ https_get
	70	+ (
	71	+ String server_name,
	72	+ String document_name,
	73	+ List(HTTP_argument) arguments,
	74	+ (Maybe(X509)) -> Bool accept_policy
	75	+ ) = https_get(server_name,document_name,[],arguments,accept_policy).
	76	+
	77	+ The main difference with 'http_get' is the presence of the 'accept_policy'
	78	+ argument. 'accept_policy' is the function which determines your personal policy for
	79	+ accepting a server certificate, if it is the case that either this certificate is
	80	+ invalid (or missing), or if its common name does not match the server name, that is to
	81	+ say if 'open_SSL_connection' (defined in 'predefined.anubis') did not already accept
	82	+ it.
	83	+
	84	+ 'X509' is an 'opaque' type defined in 'predefined.anubis'. It is 'opaque' in the sens
	85	+ that no alternative of this type is directly accessible to you (despite the fact that
	86	+ the type is public).
	87	+
	88	+ An accept policy function takes (maybe) an X.509 certificate as its unique argument, so
	89	+ that the decision may be taken with the suspect certificate at hand. It must return
	90	+ 'true' for accepting, and 'false' for refusing.
	91	+
	92	+ You may use the following default accept policy function:
	93	+
	94	+public define Bool
	95	+ default_accept_policy
	96	+ (
	97	+ Maybe(X509) suspect_certificate
	98	+ ) = false.
	99	+
	100	+ That is, never accept a certificate which cannot be successfully verified by
	101	+ 'open_SSL_connection'. Notice that this is not a paranoid behavior, but a normal
	102	+ behavior. Nevertheless, you still have the possibility to weaken this behavior by
	103	+ using another accept policy function. Be very careful when writing this function,
	104	+ because this may weaken your security. This function may for example show the
	105	+ certificate and ask for user input for accepting it. It may also check the certificate
	106	+ fingerprint against a data base, etc...
	107	+
	108	+ Another accept policy function is defined in this file:
	109	+
	110	+public define Bool
	111	+ command_line_accept_policy
	112	+ (
	113	+ Maybe(X509) suspect_certificate
	114	+ ).
	115	+
	116	+ It is used by the command line module 'https_get.adm'. If the certificate is not
	117	+ accepted by 'open_SSL_connection', this function prints the certificate on the screen,
	118	+ and ask the user for acceptation. It also asks the user for accepting the certificate
	119	+ for ever.
	120	+
	121	+ It is likely that you will need an accept policy function of your own. See the
	122	+ definition of 'command_line_accept_policy' below for information and
	123	+ 'predefined.anubis' for the tools enabling the manipulation of X.509 certificates.
	124	+ Certificates that you trust are stored into the directory declared under the symbol
	125	+ 'ca' (for 'Certificate Authorities') in your configuration file. Any certificate
	126	+ present in this directory is trusted without any condition.
	127	+
	128	+ This file defines the module 'https_get' to be used directly from the command line. To
	129	+ learn about the syntax, just type 'https_get' at the system prompt, or have a look at
	130	+ the end of this file.
	131	+
	132	+
	133	+
	134	+
	135	+ --- That's all for public definitions. ------------------------------------------------
	136	+
	137	+
	138	+
	139	+
	140	+
	141	+
	142	+
	143	+
	144	+define Maybe(String)
	145	+ receive_text_chunk
	146	+ (
	147	+ SSL_Connection conn
	148	+ ) =
	149	+ read(conn,100,1000).
	150	+
	151	+
	152	+
	153	+
	154	+define HTTPS_GET_Result
	155	+ receive
	156	+ (
	157	+ SSL_Connection conn,
	158	+ String headers,
	159	+ String text_so_far,
	160	+ Bool double_crlf_seen
	161	+ ) =
	162	+ if receive_text_chunk(conn) is
	163	+ {
	164	+ failure then if separate_headers(headers) is
	165	+ {
	166	+ [ ] then ok("",[],text_so_far),
	167	+ [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far)
	168	+ },
	169	+
	170	+ success(s) then
	171	+ if s = ""
	172	+ then if separate_headers(headers) is
	173	+ {
	174	+ [ ] then ok("",[],text_so_far),
	175	+ [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far)
	176	+ }
	177	+ else with new_s = text_so_far+s,
	178	+ if double_crlf_seen
	179	+ then receive(conn,headers,new_s,true)
	180	+ else if has_double_crlf(new_s) is
	181	+ {
	182	+ failure then receive(conn,headers,new_s,false),
	183	+ success(n) then
	184	+ if sub_string(new_s,n+4,length(new_s)-n-4) is
	185	+ {
	186	+ failure then alert,
	187	+ success(s1) then
	188	+ if sub_string(new_s,0,n) is
	189	+ {
	190	+ failure then alert,
	191	+ success(h) then receive(conn,h,s1,true)
	192	+ }
	193	+ }
	194	+ }
	195	+ }.
	196	+
	197	+
	198	+
	199	+ The next function has a valid SSL connection to the server, and tries to retrieve the
	200	+ document.
	201	+
	202	+define HTTPS_GET_Result
	203	+ https_get
	204	+ (
	205	+ Bool print_all,
	206	+ SSL_Connection conn,
	207	+ String server_name,
	208	+ String document_name,
	209	+ List(HTTP_header) headers,
	210	+ List(HTTP_argument) arguments
	211	+ ) =
	212	+ //
	213	+ // Send the HTTP request, and receive the answer:
	214	+ //
	215	+ with body = format_http_args(arguments),
	216	+ with request = (if arguments = [] then "GET " else "POST ")
	217	+ + document_name + " HTTP/1.0" + crlf +
	218	+ "Host: " + server_name + crlf +
	219	+ "Accept-Charset: iso-8859-1,*,utf-8" + crlf +
	220	+ (if arguments = [] then ""
	221	+ else "Content-type: application/x-www-form-urlencoded" + crlf +
	222	+ "Content-length: " + to_decimal(length(body))+ crlf) +
	223	+ format_headers(headers) +
	224	+ crlf +
	225	+ body,
	226	+ (if print_all then
	227	+ (
	228	+ print("Sending request:\n");
	229	+ print(request);
	230	+ print("\n")
	231	+ ) else unique);
	232	+ if write(conn,request) is
	233	+ {
	234	+ failure then transmission_problem,
	235	+ success(_) then receive(conn,"","",false)
	236	+ }.
	237	+
	238	+
	239	+ The next function retrieves the document using the numerical (resolved) server address.
	240	+
	241	+define HTTPS_GET_Result
	242	+ https_get
	243	+ (
	244	+ Bool print_all,
	245	+ Word32 server_addr,
	246	+ Word32 server_port,
	247	+ String server_name,
	248	+ String document_name,
	249	+ List(HTTP_header) headers,
	250	+ List(HTTP_argument) arguments,
	251	+ (Maybe(X509)) -> Bool accept_policy
	252	+ ) =
	253	+ if open_SSL_connection(server_name,server_addr,server_port,accept_policy) is
	254	+ {
	255	+ error(msg) then ssl_connect_error(msg),
	256	+ ok(conn) then https_get(print_all,conn,server_name,document_name,headers,arguments)
	257	+ }.
	258	+
	259	+
	260	+
	261	+define HTTPS_GET_Result
	262	+ https_get
	263	+ (
	264	+ Bool print_all,
	265	+ String server_name,
	266	+ String document_name,
	267	+ List(HTTP_header) headers,
	268	+ List(HTTP_argument) arguments,
	269	+ (Maybe(X509)) -> Bool accept_policy
	270	+ ) =
	271	+ if separate_name_port(server_name,443) is (name,port) then
	272	+ //
	273	+ // resolve server name and call 'https_get' with numeric server address:
	274	+ //
	275	+ with a = dns(name),
	276	+ if a is ok(addr)
	277	+ then https_get(print_all,addr,port,name,document_name,headers,arguments,accept_policy)
	278	+ else cannot_resolve_server_name(a).
	279	+
	280	+
	281	+
	282	+ Now, here is our public tool:
	283	+
	284	+public define HTTPS_GET_Result
	285	+ https_get
	286	+ (
	287	+ String server_name,
	288	+ String document_name,
	289	+ List(HTTP_header) headers,
	290	+ List(HTTP_argument) arguments,
	291	+ (Maybe(X509)) -> Bool accept_policy
	292	+ ) = https_get(false,server_name,document_name,headers,arguments,accept_policy).
	293	+
	294	+
	295	+
	296	+
	297	+
	298	+ Finally, we construct the command line executable module 'https_get.adm':
	299	+
	300	+define One
	301	+ syntax_https_get =
	302	+ print("\nUsage: https_get <server> <document> [options] =<header> <value> ... <arg> <value> ...\n");
	303	+ print(" Options are:\n");
	304	+ print(" -print_all print request, response line, headers and document\n");
	305	+ print(" (default is to print only the document)\n").
	306	+
	307	+
	308	+
	309	+
	310	+ Below is our accept policy function for the command line module. This function may
	311	+ serve as a model for your own accept policy function.
	312	+
	313	+public define Bool
	314	+ command_line_accept_policy
	315	+ (
	316	+ Maybe(X509) mbcert
	317	+ ) =
	318	+ if mbcert is
	319	+ {
	320	+ failure then
	321	+ print("No server certificate or invalid server certificate.\n");
	322	+ print("Do you want to trust this site anyway ? [Y/N]\n");
	323	+ yes, // this is the same as 'if yes then true else false'
	324	+
	325	+ success(cert) then
	326	+ print(to_string(cert));
	327	+ print("\nDo you want to accept the above certificate ? [Y/N]\n");
	328	+ if yes
	329	+ then (
	330	+ print("Do you want to accept this certificate for ever ? [Y/N]\n");
	331	+ if yes
	332	+ then (if trust_for_ever(cert) is
	333	+ {
	334	+ ca_directory_not_found then print("'ca' directory not found.\n"),
	335	+ cannot_create_file then print("cannot create file.\n"),
	336	+ cannot_create_symbolic_link then print("cannot create symbolic link.\n"),
	337	+ write_error then print("write error.\n"),
	338	+ ok then unique
	339	+ }; true)
	340	+ else true
	341	+ )
	342	+ else false
	343	+ }.
	344	+
	345	+
	346	+global define One
	347	+ https_get
	348	+ (
	349	+ List(String) args
	350	+ ) =
	351	+ if args is
	352	+ {
	353	+ [ ] then syntax_https_get,
	354	+ [server . t] then if t is
	355	+ {
	356	+ [ ] then syntax_https_get,
	357	+ [document . rest] then
	358	+ with print_all = member(rest,"-print_all"),
	359	+ headers = get_headers(rest),
	360	+ arguments = get_arguments(rest),
	361	+ if https_get(print_all,server,document,headers,arguments,command_line_accept_policy) is
	362	+ {
	363	+ cannot_resolve_server_name(dns_error) then
	364	+ print("Cannot resolve server name: " + format(dns_error) + ".\n"),
	365	+
	366	+ ssl_connect_error(connect_error) then
	367	+ print("SSL connect error: " + format(connect_error) + ".\n"),
	368	+
	369	+ transmission_problem then
	370	+ print("Transmission problem.\n"),
	371	+
	372	+ request_refused_by_server then
	373	+ print("The request has been refused by server: " + server + ".\n"),
	374	+
	375	+ ok(response,headers1,document1) then
	376	+ (
	377	+ if print_all
	378	+ then (
	379	+ print("\n----- response ----\n");
	380	+ print(response);
	381	+ print("\n----- headers -----\n");
	382	+ print_headers(headers1);
	383	+ print("----- document ----\n")
	384	+ ) else unique
	385	+ );
	386	+ print(document1) // on the screen (use a redirection to get it in a file)
	387	+ }
	388	+ }
	389	+ }.
	390	+
...	...

web/CXM_xml_rpc.anubis 0 → 100644

Wrap text Show/Hide comments View file @7264ac9

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: Totoro
	4	+ * Date: 29/06/2013
	5	+ * Time: 00:47
	6	+ *
	7	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	8	+ */
	9	+
	10	+read tools/base64.anubis
	11	+read tools/basis.anubis
	12	+read tools/connections.anubis
	13	+read system/convert.anubis
	14	+read system/string.anubis
	15	+read web/CXM_common.anubis
	16	+read web/CXM_http_get_common.anubis
	17	+read web/CXM_xml_rpc_parser.anubis
	18	+read web/CXM_xml_rpc_types.anubis
	19	+
	20	+
	21	+define XML_RPC_parameters sysinfo_params =
	22	+ parameters
	23	+ [
	24	+ parameter[int(1)],
	25	+ parameter[bool(true)],
	26	+ parameter[string("This is a string")],
	27	+ parameter[double(1.45)],
	28	+ parameter[datetime("date to do")],
	29	+ parameter[base64("Base 64 content")],
	30	+ parameter[struct(members([
	31	+ member("1st member", int(2)),
	32	+ member("2nd member", string("this is the 2nd string"))
	33	+ ]))],
	34	+ parameter[array(array([
	35	+ int(3),
	36	+ string("3rd string")
	37	+ ]))]
	38	+ ].
	39	+
	40	+define XML_RPC_parameters empty_param = parameters [].
	41	+
	42	+public type XML_RPC_Result:
	43	+ cannot_resolve_server_name(DNS_Result),
	44	+ cannot_connect_to_server(NetworkConnectError),
	45	+ transmission_problem,
	46	+ request_refused_by_server,
	47	+ ok(String response, // HTTP response line from the server
	48	+ List(HTTP_header) headers, // HTTP headers received from the server
	49	+ String document). // The HTML document itself
	50	+
	51	+public type XML_RPC_Auth:
	52	+ none,
	53	+ basic(String login, String password).
	54	+
	55	+public type XML_RPC_client:
	56	+ xml_rpc_client(
	57	+ Connection conn,
	58	+ XML_RPC_Auth auth,
	59	+ String url,
	60	+ String user_agent,
	61	+ String host).
	62	+
	63	+define String
	64	+ tab
	65	+ (
	66	+ Int position
	67	+ )=
	68	+ to_string(constant_byte_array(position * 2, ' ')).
	69	+
	70	+define String format_struct(XML_RPC_struct structure, Int position).
	71	+define String format_array(XML_RPC_array array, Int position).
	72	+
	73	+define String format_int_value ( Word32 value) = "<value><i4>"+to_String(value)+"</i4></value>" + crlf.
	74	+define String format_boolean_value ( Bool value) = "<value><boolean>"+to_String_value(value)+"</boolean></value>" + crlf.
	75	+define String format_string_value ( String value) = "<value><string>"+value+"</string></value>" + crlf.
	76	+define String format_double_value ( Float value) = "<value><double>"+float_to_string(value, 10)+"</double></value>" + crlf.
	77	+define String format_datetime_value ( String value) = "<value><dateTime.iso8601>"+value+"</dateTime.iso8601></value>" + crlf.
	78	+define String format_base64_value ( String value) = "<value><base64>"+value+"</base64></value>" + crlf.
	79	+
	80	+define String
	81	+ format_value
	82	+ (
	83	+ XML_RPC_value rpc_value,
	84	+ Int position
	85	+ )=
	86	+ with return = if rpc_value is
	87	+ {
	88	+ int(value) then format_int_value(value),
	89	+ bool(value) then format_boolean_value(value),
	90	+ string(value) then format_string_value(value),
	91	+ double(value) then format_double_value(value),
	92	+ datetime(value) then format_datetime_value(value),
	93	+ base64(value) then format_base64_value(value),
	94	+ struct(value) then format_struct(value, position + 1),
	95	+ array(value) then format_array(value, position + 1)
	96	+ },
	97	+ tab(position) + return.
	98	+
	99	+
	100	+define String
	101	+ _format_struct
	102	+ (
	103	+ String so_far,
	104	+ List(XML_RPC_struct_member) members,
	105	+ Int position
	106	+ )=
	107	+ if members is
	108	+ {
	109	+ [] then so_far,
	110	+ [h . t] then
	111	+ if h is member(name, val) then
	112	+ _format_struct( so_far + tab(position) + "<member>" + crlf +
	113	+ tab(position + 1)+"<name>"+name+"</name>" + crlf +
	114	+ format_value(val, position + 1) +
	115	+ tab(position + 1) + "</member>" + crlf,
	116	+ t,
	117	+ position)
	118	+ }.
	119	+
	120	+define String
	121	+ format_struct
	122	+ (
	123	+ XML_RPC_struct struct,
	124	+ Int position
	125	+ ) =
	126	+ if struct is members(structure_members) then
	127	+ /tab(position) +/ "<struct>" + crlf +
	128	+ _format_struct("", structure_members, position+1)+
	129	+ tab(position + 1) + "</struct>" + crlf.
	130	+
	131	+define String
	132	+ _format_array
	133	+ (
	134	+ String so_far,
	135	+ List(XML_RPC_value) values,
	136	+ Int position
	137	+ )=
	138	+ if values is
	139	+ {
	140	+ [] then so_far,
	141	+ [h . t] then _format_array( so_far + format_value(h, position), t, position)
	142	+ }.
	143	+
	144	+define String
	145	+ format_array
	146	+ (
	147	+ XML_RPC_array arr,
	148	+ Int position
	149	+ )
	150	+ =
	151	+ if arr is array(values) then
	152	+ /tab(position) +/ "<array>" + crlf +
	153	+ tab(position + 1) + "<data>" + crlf+
	154	+ _format_array("", values, position + 2)+
	155	+ tab(position+2)+"</data>" + crlf +
	156	+ tab(position + 1) + "</array>" + crlf.
	157	+
	158	+public define String
	159	+ format_xml_rpc_values
	160	+ (
	161	+ List(XML_RPC_value) values,
	162	+ Int position,
	163	+ String so_far
	164	+ )=
	165	+ if values is
	166	+ {
	167	+ [] then so_far,
	168	+ [ h . t ] then
	169	+ format_xml_rpc_values(t, position, so_far + format_value(h, position))
	170	+ }.
	171	+
	172	+public define String
	173	+ format_xml_rpc_parameter
	174	+ (
	175	+ XML_RPC_parameter param,
	176	+ Int position
	177	+ )=
	178	+ if param is parameter(values) then
	179	+ format_xml_rpc_values(values, position, "")
	180	+ .
	181	+
	182	+
	183	+define String
	184	+ _format_xml_rpc_parameters
	185	+ (
	186	+ String so_far,
	187	+ List(XML_RPC_parameter) params,
	188	+ Int position
	189	+ )=
	190	+ if params is
	191	+ {
	192	+ [] then so_far,
	193	+ [ h . t ] then
	194	+ _format_xml_rpc_parameters( so_far + tab(position) + "<param>" + crlf +
	195	+ format_xml_rpc_parameter(h, position + 1) +
	196	+ tab(position+1) + "</param>" + crlf,
	197	+ t,
	198	+ position)
	199	+ }.
	200	+
	201	+public define String
	202	+ format_xml_rpc_parameters
	203	+ (
	204	+ XML_RPC_parameters params,
	205	+ Int position
	206	+ )=
	207	+ if params is parameters(list_param) then
	208	+ tab(position)+"<params>" + crlf +
	209	+ _format_xml_rpc_parameters("", list_param, position+1) +
	210	+ tab(position+1)+"</params>".
	211	+
	212	+public define String
	213	+ format_xml_rpc_fault
	214	+ (
	215	+ XML_RPC_value value,
	216	+ Int position
	217	+ )=
	218	+ tab(position)+"<fault>" + crlf +
	219	+ format_value(value, position+1) +
	220	+ tab(position+1)+"</fault>".
	221	+
	222	+public define Bool
	223	+ accept_policy
	224	+ (
	225	+ Maybe(X509) suspect_certificate
	226	+ ) = true.
	227	+
	228	+public define Maybe(XML_RPC_client)
	229	+ xml_rpc_new_client
	230	+ (
	231	+ String server_name,
	232	+ Bool use_ssl,
	233	+ XML_RPC_Auth auth,
	234	+ String user_agent,
	235	+ String host
	236	+ )=
	237	+ if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then
	238	+ //
	239	+ // resolve server name and call 'https_get' with numeric server address:
	240	+ //
	241	+ with a = dns(name),
	242	+ if a is ok(server_addr) then
	243	+ //connect to server with right protocol
	244	+ if use_ssl then
	245	+ println("SSL "+server_port+ " "+server_name);
	246	+ if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is
	247	+ {
	248	+ error(msg) then failure,
	249	+ ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host))
	250	+ }
	251	+ else
	252	+ println("TCP "+server_port+ " "+server_name);
	253	+ if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is
	254	+ {
	255	+ error(e) then failure,
	256	+ ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host))
	257	+ }
	258	+ else
	259	+ failure.
	260	+
	261	+define Maybe(XML_RPC_response)
	262	+ receive
	263	+ (
	264	+ Bool print_dump,
	265	+ Connection conn
	266	+ )=
	267	+ //TODO find the header and content-lenght to get full length of answer
	268	+
	269	+ if read(conn, 16384, 5) is
	270	+ {
	271	+ error then println("Read error");failure,
	272	+ timeout then println("Read timeout");failure,
	273	+ ok(ba) then
	274	+ with xml_response = to_string(ba),
	275	+ typed_response = xml_rpc_get_response(xml_response),
	276	+ (if print_dump then
	277	+
	278	+ println("=== Server answer ==="+crlf + xml_response );
	279	+ println("=== XML_RPC Anubis interpretation ===");
	280	+
	281	+ if typed_response is
	282	+ {
	283	+ failure then println("Interpretation error"),
	284	+ success(result) then
	285	+ if result is
	286	+ {
	287	+ ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)),
	288	+ fault(fault) then println(format_xml_rpc_fault(fault,1))
	289	+ }
	290	+
	291	+ }
	292	+ else unique);
	293	+ typed_response
	294	+ }
	295	+ .
	296	+
	297	+public define Maybe(XML_RPC_response)
	298	+ xml_rpc_client_execute
	299	+ (
	300	+ Bool print_dump,
	301	+ XML_RPC_client client,
	302	+ String url,
	303	+ String method_name,
	304	+ XML_RPC_parameters params
	305	+ //(XML-string)->$T answer_handler //convert the xml answer to anubis type
	306	+ )=
	307	+ if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then
	308	+ //execute the method on remote server
	309	+ // - 1 - Format the xml body to comply with XML RPC
	310	+ with body = "<?xml version=\"1.0\"?>" + crlf +
	311	+ tab(1)+"<methodCall>" + crlf +
	312	+ tab(2)+"<methodName>" + method_name +"</methodName>" + crlf +
	313	+ format_xml_rpc_parameters(params, 2) +
	314	+ tab(1)+"</methodCall>",
	315	+
	316	+ // - 2 - Format the POST HTTP request
	317	+ with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute
	318	+ "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1)
	319	+ "Host: " + server_name + crlf +
	320	+ "Content-type: text/xml" + crlf +
	321	+ if auth is
	322	+ {
	323	+ none then "",
	324	+ basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf
	325	+ }+
	326	+ "Content-length: " + length(body)+ crlf +
	327	+
	328	+ //format_headers(headers) +
	329	+ crlf +
	330	+ body,
	331	+
	332	+ // - 3 - send it to remote
	333	+
	334	+ //
	335	+ // Send the HTTP request, and receive the answer:
	336	+ //
	337	+ (if print_dump then
	338	+ (
	339	+ print("----- request ----\n");
	340	+ print(request);
	341	+ print("\n")
	342	+ ) else unique);
	343	+
	344	+ if write(conn, to_byte_array(request)) is
	345	+ {
	346	+ failure then failure,
	347	+ success(_) then receive(print_dump, conn)
	348	+ }.
	349	+
	350	+ //wait the answer
	351	+
	352	+
	353	+global define One
	354	+ xml_rpc_test
	355	+ (
	356	+ List(String) args
	357	+ )=
	358	+ if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is
	359	+ {
	360	+ failure then println(" xml_rpc_test new client failure"),
	361	+ success(rpc_client) then
	362	+ forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "list_domains", empty_param))
	363	+ //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]])))
	364	+ //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param))
	365	+ }.
	366	+
...	...

web/CXM_xml_rpc_parser.anubis 0 → 100644

Wrap text Show/Hide comments View file @7264ac9

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: Totoro
	4	+ * Date: 06/07/2013
	5	+ * Time: 01:13
	6	+ *
	7	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	8	+ */
	9	+
	10	+read web/CXM_xml_rpc_types.anubis
	11	+read tools/streams.anubis
	12	+read tools/basis.anubis
	13	+read system/string.anubis
	14	+read system/convert.anubis
	15	+
	16	+type XML_RPC_Token:
	17	+ none,
	18	+ token(String token).
	19	+
	20	+define Maybe(XML_RPC_value) read_value(Stream stream).
	21	+
	22	+define XML_RPC_Token
	23	+ _next_xml_token
	24	+ (
	25	+ Stream stream,
	26	+ List(Word8) so_far,
	27	+ Bool in_token
	28	+ )=
	29	+ if read_byte(stream) is
	30	+ {
	31	+ failure then none, //can't read on stream !!
	32	+ success(b) then
	33	+ //println("["+implode([b])+"]");
	34	+ if in_token then
	35	+ if b = '>' then //just found the end of bracket, so we return the token in LOWER case
	36	+ with tok = to_lower(implode(reverse(so_far))),
	37	+ //println("found tag "+tok);
	38	+ token(tok)
	39	+ else
	40	+ _next_xml_token(stream, [b . so_far], in_token)
	41	+ else
	42	+ if b = '<' then //just found the begin of token
	43	+ _next_xml_token(stream, [], true)
	44	+ else
	45	+ _next_xml_token(stream, so_far, in_token)
	46	+ }
	47	+ .
	48	+
	49	+
	50	+
	51	+define XML_RPC_Token
	52	+ next_xml_token
	53	+ (
	54	+ Stream stream
	55	+ )= _next_xml_token(stream, [], false).
	56	+
	57	+define Maybe(String)
	58	+ _xml_tag_content
	59	+ (
	60	+ Stream stream,
	61	+ String tag, //tag to match
	62	+ List(Word8) so_far,
	63	+ List(Word8) content,
	64	+ Bool in_first_token,
	65	+ Bool in_content,
	66	+ Bool in_last_token
	67	+
	68	+ )=
	69	+ if read_byte(stream) is
	70	+ {
	71	+ failure then failure, //can't read on stream !!
	72	+ success(b) then
	73	+ if in_first_token then
	74	+ if b = '>' then //just found the end of bracket, so we return the token in LOWER case
	75	+ if to_lower(implode(reverse(so_far))) = tag then
	76	+ _xml_tag_content(stream, tag, [], [], false, true, false)
	77	+ else
	78	+ failure
	79	+ else
	80	+ _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token)
	81	+ else if in_content then
	82	+ if b = '<' then //just found the begin bracket,
	83	+ if read_byte(stream) is
	84	+ {
	85	+ failure then failure, //can't read on stream !!
	86	+ success(b) then
	87	+ if b = '/' then //can't find / => syntax error
	88	+ _xml_tag_content(stream, tag, [], content, false, false, true)
	89	+ else
	90	+ failure
	91	+ }
	92	+ else
	93	+ _xml_tag_content(stream, tag, [], [b . content], false, true, false)
	94	+ else if in_last_token then
	95	+ if b = '>' then //just found the end of bracket, so we return the token in LOWER case
	96	+ if to_lower(implode(reverse(so_far))) = tag then
	97	+ with content = implode(reverse(content)),
	98	+ println("Tag ["+tag+"] content found ["+content+"]");
	99	+ success(content)
	100	+ else
	101	+ failure
	102	+ else
	103	+ _xml_tag_content(stream, tag, [b . so_far], content, false, false, true)
	104	+
	105	+ else
	106	+ if b = '<' then //just found the begin of token
	107	+ _xml_tag_content(stream, tag, [], [], true, false, false)
	108	+ else
	109	+ _xml_tag_content(stream, tag, [], [], false, false, false)
	110	+ }
	111	+ .
	112	+define Maybe(String)
	113	+ xml_pair_tag_content
	114	+ (
	115	+ Stream stream,
	116	+ String tag
	117	+ )= _xml_tag_content( stream, tag, [], [], false, false, false).
	118	+
	119	+define Maybe(String)
	120	+ xml_tag_content
	121	+ (
	122	+ Stream stream,
	123	+ String tag
	124	+ )= _xml_tag_content( stream, tag, [], [], false, true, false).
	125	+
	126	+ /*** ARRAY functions ****/
	127	+
	128	+define Maybe(List(XML_RPC_value))
	129	+ read_values
	130	+ (
	131	+ Stream stream,
	132	+ List(XML_RPC_value) so_far
	133	+ )=
	134	+ if read_value(stream) is
	135	+ {
	136	+ failure then failure,
	137	+ success(value) then
	138	+ if next_xml_token(stream) is
	139	+ {
	140	+ none then failure,
	141	+ token(token) then
	142	+
	143	+ if token = "value" then //there is another value we read it
	144	+ read_values(stream, [value . so_far])
	145	+ else
	146	+ unput_string("<"+token+">", stream);
	147	+ success(reverse([value . so_far]))
	148	+ }
	149	+ }.
	150	+
	151	+define Maybe(List(XML_RPC_value))
	152	+ read_data
	153	+ (
	154	+ Stream stream
	155	+ )=
	156	+ if next_xml_token(stream) is
	157	+ {
	158	+ none then failure,
	159	+ token(token) then
	160	+ if token = "data" then
	161	+ if next_xml_token(stream) is
	162	+ {
	163	+ none then failure,
	164	+ token(token) then
	165	+ if token = "value" then
	166	+ if read_values(stream, []) is
	167	+ {
	168	+ failure then failure
	169	+ success(values) then
	170	+ if next_xml_token(stream) is
	171	+ {
	172	+ none then failure,
	173	+ token(token) then
	174	+ if token = "/data" then
	175	+ success(values)
	176	+ else
	177	+ failure
	178	+ }
	179	+ }
	180	+ else
	181	+ failure
	182	+ }
	183	+ else
	184	+ failure
	185	+ }.
	186	+
	187	+define Maybe(XML_RPC_value)
	188	+ read_array
	189	+ (
	190	+ Stream stream
	191	+ )=
	192	+ if read_data(stream) is
	193	+ {
	194	+ failure then failure
	195	+ success(values) then
	196	+ if next_xml_token(stream) is
	197	+ {
	198	+ none then failure,
	199	+ token(token) then
	200	+ if token = "/array" then
	201	+ success(array(array(values)))
	202	+ else
	203	+ failure
	204	+ }
	205	+ }.
	206	+
	207	+ /*** STRUCT functions ****/
	208	+
	209	+define Maybe(List(XML_RPC_struct_member))
	210	+ read_members
	211	+ (
	212	+ Stream stream,
	213	+ List(XML_RPC_struct_member) so_far
	214	+ )=
	215	+ if xml_pair_tag_content(stream, "name") is
	216	+ {
	217	+ failure then failure,
	218	+ success(member_name) then
	219	+ if next_xml_token(stream) is
	220	+ {
	221	+ none then failure,
	222	+ token(tok) then
	223	+ if tok = "value" then
	224	+ if read_value(stream) is
	225	+ {
	226	+ failure then failure,
	227	+ success(value) then
	228	+ if next_xml_token(stream) is
	229	+ {
	230	+ none then failure,
	231	+ token(tok) then
	232	+ if tok = "/member" then
	233	+ if next_xml_token(stream) is
	234	+ {
	235	+ none then failure,
	236	+ token(tok) then
	237	+ if tok = "member" then //there is another member in structure, we read it
	238	+ read_members(stream, [member(member_name, value) . so_far])
	239	+ else if tok = "/struct" then //End of structrue found
	240	+ println("End struct");
	241	+ success(reverse([member(member_name, value) . so_far])) //return all members in right order
	242	+ else
	243	+ failure //unexpected token
	244	+ }
	245	+ else
	246	+ failure
	247	+ }
	248	+ }
	249	+ else
	250	+ failure
	251	+ }
	252	+ } .
	253	+
	254	+define Maybe(XML_RPC_value)
	255	+ read_struct
	256	+ (
	257	+ Stream stream
	258	+ )=
	259	+ if next_xml_token(stream) is
	260	+ {
	261	+ none then failure,
	262	+ token(token) then
	263	+ if token = "member" then
	264	+ if read_members(stream, []) is
	265	+ {
	266	+ failure then failure
	267	+ success(members_list) then success(struct(members(members_list)))
	268	+ }
	269	+ else
	270	+ failure
	271	+ }.
	272	+
	273	+define Maybe(XML_RPC_value)
	274	+ read_value
	275	+ (
	276	+ Stream stream
	277	+ )=
	278	+ if next_xml_token(stream) is
	279	+ {
	280	+ none then failure,
	281	+ token(token) then
	282	+ with value = if token = "string" then
	283	+ if xml_tag_content(stream, "string") is
	284	+ {
	285	+ failure then failure,
	286	+ success(v) then success(string(v))
	287	+ }
	288	+ else if token = "int" then
	289	+ if xml_tag_content(stream, "int") is
	290	+ {
	291	+ failure then failure,
	292	+ success(v) then
	293	+ if decimal_scan(v) is
	294	+ {
	295	+ failure then failure,
	296	+ success(int_v) then success(int(truncate_to_Word32(int_v)))
	297	+ }
	298	+ }
	299	+ else if token = "i4" then
	300	+ if xml_tag_content(stream, "i4") is
	301	+ {
	302	+ failure then failure,
	303	+ success(v) then
	304	+ if decimal_scan(v) is
	305	+ {
	306	+ failure then failure,
	307	+ success(int_v) then success(int(truncate_to_Word32(int_v)))
	308	+ }
	309	+ }
	310	+ else if token = "boolean" then
	311	+ if xml_tag_content(stream, "boolean") is
	312	+ {
	313	+ failure then failure,
	314	+ success(v) then success(bool(to_Bool(v)))
	315	+ }
	316	+ else if token = "double" then
	317	+ if xml_tag_content(stream, "string") is
	318	+ {
	319	+ failure then failure,
	320	+ success(v) then success(double(0.0))
	321	+ }
	322	+ else if token = "datetime" then
	323	+ if xml_tag_content(stream, "string") is
	324	+ {
	325	+ failure then failure,
	326	+ success(v) then success(datetime(v))
	327	+ }
	328	+ else if token = "base64" then
	329	+ if xml_tag_content(stream, "base64") is
	330	+ {
	331	+ failure then failure,
	332	+ success(b64) then success(base64(b64))
	333	+ }
	334	+ else if token = "struct" then read_struct(stream)
	335	+ else if token = "array" then read_array(stream)
	336	+ else
	337	+ failure,
	338	+ if next_xml_token(stream) is
	339	+ {
	340	+ none then failure
	341	+ token(token) then
	342	+ if token = "/value" then
	343	+ value
	344	+ else
	345	+ failure
	346	+ }
	347	+ }.
	348	+
	349	+define Maybe(XML_RPC_parameter)
	350	+ in_value
	351	+ (
	352	+ Stream stream,
	353	+ List(XML_RPC_value) so_far
	354	+ )=
	355	+ if next_xml_token(stream) is
	356	+ {
	357	+ none then failure,
	358	+ token(tok) then
	359	+ if tok = "value" then
	360	+ if read_value(stream) is
	361	+ {
	362	+ failure then failure,
	363	+ success(value) then in_value(stream, [ value. so_far])
	364	+ }
	365	+ else if tok = "/param" then
	366	+ success(parameter(reverse(so_far)))
	367	+ else
	368	+ failure
	369	+ }.
	370	+
	371	+define Maybe(XML_RPC_value)
	372	+ in_fault
	373	+ (
	374	+ Stream stream,
	375	+ )=
	376	+ if next_xml_token(stream) is
	377	+ {
	378	+ none then failure,
	379	+ token(tok) then
	380	+ if tok = "value" then
	381	+ if read_value(stream) is
	382	+ {
	383	+ failure then failure,
	384	+ success(value) then
	385	+ if next_xml_token(stream) is
	386	+ {
	387	+ none then failure,
	388	+ token(tok) then
	389	+ if tok = "/fault" then
	390	+ success(value)
	391	+ else
	392	+ failure
	393	+ }
	394	+ }
	395	+ else
	396	+ failure
	397	+ }.
	398	+
	399	+define Maybe(XML_RPC_parameters)
	400	+ in_param
	401	+ (
	402	+ Stream stream,
	403	+ List(XML_RPC_parameter) so_far
	404	+ )=
	405	+ if next_xml_token(stream) is
	406	+ {
	407	+ none then failure,
	408	+ token(tok) then
	409	+ if tok = "param" then
	410	+ if in_value(stream, []) is
	411	+ {
	412	+ failure then failure,
	413	+ success(param) then in_param(stream, [ param . so_far])
	414	+ }
	415	+
	416	+ else if tok = "/params" then
	417	+ success(parameters(reverse(so_far)))
	418	+ else
	419	+ failure
	420	+ }
	421	+ .
	422	+
	423	+define Maybe(XML_RPC_response)
	424	+ in_params
	425	+ (
	426	+ Stream stream
	427	+ )=
	428	+ if next_xml_token(stream) is
	429	+ {
	430	+ none then failure,
	431	+ token(tok) then
	432	+ if tok = "params" then
	433	+ if in_param(stream, []) is
	434	+ {
	435	+ failure then failure,
	436	+ success(resp) then success(ok(resp))
	437	+ }
	438	+ else if tok = "fault" then
	439	+ if in_fault(stream) is
	440	+ {
	441	+ failure then failure,
	442	+ success(resp) then success(fault(resp))
	443	+ }
	444	+ else
	445	+ failure
	446	+ }
	447	+
	448	+ .
	449	+
	450	+public define Maybe(XML_RPC_response)
	451	+ xml_rpc_get_response
	452	+ (
	453	+ String response
	454	+ )=
	455	+ with stream = make_stream(response),
	456	+ if next_xml_token(stream) is
	457	+ {
	458	+ none then failure
	459	+ token(tok) then
	460	+ if tok = "?xml version='1.0'?" then
	461	+ if next_xml_token(stream) is
	462	+ {
	463	+ none then failure
	464	+ token(tok) then
	465	+ if tok = "methodresponse" then
	466	+ in_params(stream)
	467	+ else
	468	+ failure
	469	+ }
	470	+ else
	471	+ failure
	472	+ }.
...	...

web/CXM_xml_rpc_types.anubis 0 → 100644

Wrap text Show/Hide comments View file @7264ac9

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: Totoro
	4	+ * Date: 06/07/2013
	5	+ * Time: 15:27
	6	+ *
	7	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	8	+ */
	9	+
	10	+public type XML_RPC_struct:...
	11	+public type XML_RPC_array:...
	12	+
	13	+public type XML_RPC_value:
	14	+ int(Word32),
	15	+ bool(Bool),
	16	+ string(String),
	17	+ double(Float),
	18	+ datetime(String),
	19	+ base64(String),
	20	+ struct(XML_RPC_struct),
	21	+ array(XML_RPC_array).
	22	+
	23	+public type XML_RPC_array:
	24	+ array(List(XML_RPC_value)).
	25	+
	26	+public type XML_RPC_struct_member:
	27	+ member(String name, XML_RPC_value value).
	28	+
	29	+public type XML_RPC_struct:
	30	+ members(List(XML_RPC_struct_member)).
	31	+
	32	+public type XML_RPC_parameter:
	33	+ parameter(List(XML_RPC_value)).
	34	+
	35	+public type XML_RPC_parameters:
	36	+ parameters(List(XML_RPC_parameter)).
	37	+
	38	+public type XML_RPC_response:
	39	+ ok(XML_RPC_parameters params),
	40	+ fault(XML_RPC_value fault).
	41	+
...	...