diff --git a/web/CXM_http_get.anubis b/web/CXM_http_get.anubis new file mode 100644 index 0000000..be3e1c9 --- /dev/null +++ b/web/CXM_http_get.anubis @@ -0,0 +1,311 @@ + *Project* The Anubis Project + + *Title* Getting a document from the Web. + + *Copyright* Copyright (c) Alain Prouté 2001. + + + *Author* Alain Prouté + + + + *Overview* + This file defines the function 'http_get' which retrieves a document from the world + wide web (a similar function 'https_get' for secured documents is defined in + 'https_get.anubis'). The function simulates the behavior of a browser, at least just + what is needed to retrieve the document. It does not display the document, but returns + it (if found) in the form of a string. It also returns the response line from the + server, and the list af all HTTP headers. + + The function 'http_get' takes the following arguments: + + - the name of the server to which the request is to be sent, + - the name (including the path) of the document on this server, + - a list of headers to be added to mandatory standard headers, + - a list of 'arguments' in the form of pairs of strings '(name,value)' to be sent as + the body of the request. + + + The result returned by 'http_get' has the following type, which defines the problems + which may happen: + + +read tools/basis.anubis +read system/string.anubis +read web/CXM_common.anubis +read web/CXM_http_get_common.anubis + + +public type HTTP_GET_Result: + cannot_resolve_server_name(DNS_Result), + cannot_connect_to_server(NetworkConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, // HTTP response line from the server + List(HTTP_header) headers, // HTTP headers received from the server + String document). // The HTML document itself + + +public define HTTP_GET_Result + http_get + ( //-------- example: ----------------------- + String server_name, // "www.machin.com" + String document_name, // "/truc/bidule.html" + List(HTTP_header) headers, // [http_header("Cookie","..."),...] + List(HTTP_argument) arguments // [http_argument("ga","bu"),...] + ). + + The same one without the 'headers' argument: + +public define HTTP_GET_Result + http_get + ( //-------- example: ----------------------- + String server_name, // "www.machin.com" + String document_name, // "/truc/bidule.html" + List(HTTP_argument) arguments // [http_argument("ga","bu"),...] + ) = http_get(server_name,document_name,[],arguments). + + + + This file also defines the command 'http_get' to be used directly from the system + prompt. To learn about the syntax, just type 'http_get' at the system prompt, or have + a look at the end of this file + + --- That's all for public definitions. ------------------------------------------------ + + + + We need two functions for sending and receiving bytes. + +define Maybe(One) + send + ( + RWStream conn, // where to send the text + String text, // the text to be sent + Word32 n // start sending at character number 'n' in 'text' + ) = + if nth(to_Int(n),text) is + { + failure then success(unique), + success(c) then + if conn <- c is + { + failure then failure, + success(_) then send(conn,text,n+1) + } + }. + +define Maybe(String) + receive_text_chunk + ( + RWStream conn, + List(Word8) so_far, + Word32 count + ) = + if count = 100 + then success(implode(reverse(so_far))) + else if *conn is // *conn waits for data to be readable from connection + { + failure then success(implode(reverse(so_far))), // means 'connection closed by peer' + success(c) then receive_text_chunk(conn,[c . so_far],count+1) + }. + + +define HTTP_GET_Result + receive + ( + RWStream conn, + String headers, + String text_so_far, + Bool double_crlf_seen + ) = + if receive_text_chunk(conn,[],0) is + { + failure then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + }, + + success(s) then + if s = "" + then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + } + else with new_s = text_so_far+s, + if double_crlf_seen + then receive(conn,headers,new_s,true) + else if has_double_crlf(new_s) is + { + failure then receive(conn,headers,new_s,false), + success(n) then + if sub_string(new_s,n+4,length(new_s)-n-4) is + { + failure then alert, + success(s1) then + if sub_string(new_s,0,n) is + { + failure then alert, + success(h) then receive(conn,h,s1,true) + } + } + } + }. + + + + The next function has a valid TCP/IP connection to the server, and tries to retrieve + the document. + + +define HTTP_GET_Result + http_get + ( + Bool print_all, + RWStream conn, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + // + // Send the HTTP request, and receive the answer: + // + with body = format_http_args(arguments), + with request = (if arguments = [] then "GET " else "POST ") + + document_name + " HTTP/1.0" + crlf + + "Host: " + server_name + crlf + + "Accept-Charset: iso-8859-1,*,utf-8" + crlf + + (if arguments = [] then "" + else "Content-type: application/x-www-form-urlencoded" + crlf + + "Content-length: " + to_decimal(length(body))+ crlf) + + format_headers(headers) + + crlf + + body, + (if print_all then + ( + print("----- request ----\n"); + print(request); + print("\n") + ) else unique); + if send(conn,request,0) is + { + failure then transmission_problem, + success(_) then receive(conn,"","",false) + }. + + + The next function retrieves the document using the numerical (resolved) server address. + +define HTTP_GET_Result + http_get + ( + Bool print_all, + Word32 server_addr, + Word32 server_port, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + // + // try to connect to the server before sending the request + // + if (Result(NetworkConnectError,RWStream))connect(server_addr,server_port) is + { + error(e) then cannot_connect_to_server(e), + ok(conn) then http_get(print_all,conn,server_name,document_name,headers,arguments) + }. + + +define HTTP_GET_Result + http_get + ( + Bool print_all, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + if separate_name_port(server_name,80) is (name,port) then + // + // resolve server name and call 'http_get' with numeric server address: + // + with a = dns(name), + if a is ok(addr) + then http_get(print_all,addr,port,name,document_name,headers,arguments) + else cannot_resolve_server_name(a). + + + Now, here is our public tool: + +define HTTP_GET_Result + http_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = http_get(false,server_name,document_name,headers,arguments). + + + + Finally, we construct the executable module 'http_get': + +define One + recall_syntax = + print("\nUsage: http_get [options] =
... - ...\n"); + print(" Options are:\n"); + print(" -print_all print request, response line, headers and document\n"); + print(" (default is to print only the document)\n"). + + + + +global define One + http_get + ( + List(String) args + ) = + if args is + { + [ ] then recall_syntax, + [server . t] then if t is + { + [ ] then recall_syntax, + [document . rest] then + with print_all = member(rest,"-print_all"), + headers = get_headers(rest), + arguments = get_arguments(rest), + if http_get(print_all,server,document,headers,arguments) is + { + cannot_resolve_server_name(dns_error) then + print("Cannot resolve server name: " + format(dns_error) + ".\n"), + + cannot_connect_to_server(connect_error) then + print("Cannot connect to server: " + format(connect_error) + ".\n"), + + transmission_problem then + print("Transmission problem.\n"), + + request_refused_by_server then + print("The request has been refused by server: " + server + ".\n"), + + ok(response,headers1,document1) then + ( + if print_all + then ( + print("\n----- response ----\n"); + print(response); + print("\n----- headers -----\n"); + print_headers(headers1); + print("----- document ----\n") + ) else unique + ); + print(document1) // on the screen (use a redirection to get it in a file) + } + } + }. + diff --git a/web/CXM_https_get.anubis b/web/CXM_https_get.anubis new file mode 100644 index 0000000..3347634 --- /dev/null +++ b/web/CXM_https_get.anubis @@ -0,0 +1,390 @@ + + *Project* The Anubis Project + + *Title* Getting a document from the secured Web. + + *Copyright* Copyright (c) Alain Prouté 2001. + + + *Author* Alain Prouté + + + *Overview* + This file defines the function 'https_get' which retrieve a document from the world + wide web in secured mode (HTTPS). The function is analogous to 'http_get', to be found + in 'web/http_get.anubis'. + + The function simulates the behavior of a browser, at least just what is needed to + retrieve the document. It does not display the document, but returns it (if found) in + the form of a string. + + The function 'https_get' takes the following operands: + + - the name of the server to which the request is to be sent, + - the name (including the path) of the document on this server, + - a list of headers to be added to mandatory standard headers, + - a list of 'arguments' to be sent as the body of the request (web arguments). + - an accept policy function (see below), for accepting X.509 certificates in case of + a problem. + + The result returned by 'https_get' has the following type, which defines the problems + which may happen: + + +read tools/basis.anubis +read system/string.anubis +read html.anubis +read http_get_common.anubis +read http_server.anubis +read common.anubis + + +public type HTTPS_GET_Result: + cannot_resolve_server_name(DNS_Result), + ssl_connect_error(SSLConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, + List(HTTP_header) headers, + String document). + + Cookies are among headers. See 'web/cookies.anubis' for cookies handling. + + + Note: The types 'DNS_Result' and 'SSLConnectError' are defined in 'predefined.anubis'. + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ). + + The same one without the 'headers' argument: + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = https_get(server_name,document_name,[],arguments,accept_policy). + + The main difference with 'http_get' is the presence of the 'accept_policy' + argument. 'accept_policy' is the function which determines your personal policy for + accepting a server certificate, if it is the case that either this certificate is + invalid (or missing), or if its common name does not match the server name, that is to + say if 'open_SSL_connection' (defined in 'predefined.anubis') did not already accept + it. + + 'X509' is an 'opaque' type defined in 'predefined.anubis'. It is 'opaque' in the sens + that no alternative of this type is directly accessible to you (despite the fact that + the type is public). + + An accept policy function takes (maybe) an X.509 certificate as its unique argument, so + that the decision may be taken with the suspect certificate at hand. It must return + 'true' for accepting, and 'false' for refusing. + + You may use the following default accept policy function: + +public define Bool + default_accept_policy + ( + Maybe(X509) suspect_certificate + ) = false. + + That is, never accept a certificate which cannot be successfully verified by + 'open_SSL_connection'. Notice that this is not a paranoid behavior, but a normal + behavior. Nevertheless, you still have the possibility to weaken this behavior by + using another accept policy function. Be very careful when writing this function, + because this may weaken your security. This function may for example show the + certificate and ask for user input for accepting it. It may also check the certificate + fingerprint against a data base, etc... + + Another accept policy function is defined in this file: + +public define Bool + command_line_accept_policy + ( + Maybe(X509) suspect_certificate + ). + + It is used by the command line module 'https_get.adm'. If the certificate is not + accepted by 'open_SSL_connection', this function prints the certificate on the screen, + and ask the user for acceptation. It also asks the user for accepting the certificate + for ever. + + It is likely that you will need an accept policy function of your own. See the + definition of 'command_line_accept_policy' below for information and + 'predefined.anubis' for the tools enabling the manipulation of X.509 certificates. + Certificates that you trust are stored into the directory declared under the symbol + 'ca' (for 'Certificate Authorities') in your configuration file. Any certificate + present in this directory is trusted without any condition. + + This file defines the module 'https_get' to be used directly from the command line. To + learn about the syntax, just type 'https_get' at the system prompt, or have a look at + the end of this file. + + + + + --- That's all for public definitions. ------------------------------------------------ + + + + + + + + +define Maybe(String) + receive_text_chunk + ( + SSL_Connection conn + ) = + read(conn,100,1000). + + + + +define HTTPS_GET_Result + receive + ( + SSL_Connection conn, + String headers, + String text_so_far, + Bool double_crlf_seen + ) = + if receive_text_chunk(conn) is + { + failure then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + }, + + success(s) then + if s = "" + then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + } + else with new_s = text_so_far+s, + if double_crlf_seen + then receive(conn,headers,new_s,true) + else if has_double_crlf(new_s) is + { + failure then receive(conn,headers,new_s,false), + success(n) then + if sub_string(new_s,n+4,length(new_s)-n-4) is + { + failure then alert, + success(s1) then + if sub_string(new_s,0,n) is + { + failure then alert, + success(h) then receive(conn,h,s1,true) + } + } + } + }. + + + + The next function has a valid SSL connection to the server, and tries to retrieve the + document. + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + SSL_Connection conn, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments + ) = + // + // Send the HTTP request, and receive the answer: + // + with body = format_http_args(arguments), + with request = (if arguments = [] then "GET " else "POST ") + + document_name + " HTTP/1.0" + crlf + + "Host: " + server_name + crlf + + "Accept-Charset: iso-8859-1,*,utf-8" + crlf + + (if arguments = [] then "" + else "Content-type: application/x-www-form-urlencoded" + crlf + + "Content-length: " + to_decimal(length(body))+ crlf) + + format_headers(headers) + + crlf + + body, + (if print_all then + ( + print("Sending request:\n"); + print(request); + print("\n") + ) else unique); + if write(conn,request) is + { + failure then transmission_problem, + success(_) then receive(conn,"","",false) + }. + + + The next function retrieves the document using the numerical (resolved) server address. + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + Word32 server_addr, + Word32 server_port, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = + if open_SSL_connection(server_name,server_addr,server_port,accept_policy) is + { + error(msg) then ssl_connect_error(msg), + ok(conn) then https_get(print_all,conn,server_name,document_name,headers,arguments) + }. + + + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = + if separate_name_port(server_name,443) is (name,port) then + // + // resolve server name and call 'https_get' with numeric server address: + // + with a = dns(name), + if a is ok(addr) + then https_get(print_all,addr,port,name,document_name,headers,arguments,accept_policy) + else cannot_resolve_server_name(a). + + + + Now, here is our public tool: + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = https_get(false,server_name,document_name,headers,arguments,accept_policy). + + + + + + Finally, we construct the command line executable module 'https_get.adm': + +define One + syntax_https_get = + print("\nUsage: https_get [options] =
... ...\n"); + print(" Options are:\n"); + print(" -print_all print request, response line, headers and document\n"); + print(" (default is to print only the document)\n"). + + + + + Below is our accept policy function for the command line module. This function may + serve as a model for your own accept policy function. + +public define Bool + command_line_accept_policy + ( + Maybe(X509) mbcert + ) = + if mbcert is + { + failure then + print("No server certificate or invalid server certificate.\n"); + print("Do you want to trust this site anyway ? [Y/N]\n"); + yes, // this is the same as 'if yes then true else false' + + success(cert) then + print(to_string(cert)); + print("\nDo you want to accept the above certificate ? [Y/N]\n"); + if yes + then ( + print("Do you want to accept this certificate for ever ? [Y/N]\n"); + if yes + then (if trust_for_ever(cert) is + { + ca_directory_not_found then print("'ca' directory not found.\n"), + cannot_create_file then print("cannot create file.\n"), + cannot_create_symbolic_link then print("cannot create symbolic link.\n"), + write_error then print("write error.\n"), + ok then unique + }; true) + else true + ) + else false + }. + + +global define One + https_get + ( + List(String) args + ) = + if args is + { + [ ] then syntax_https_get, + [server . t] then if t is + { + [ ] then syntax_https_get, + [document . rest] then + with print_all = member(rest,"-print_all"), + headers = get_headers(rest), + arguments = get_arguments(rest), + if https_get(print_all,server,document,headers,arguments,command_line_accept_policy) is + { + cannot_resolve_server_name(dns_error) then + print("Cannot resolve server name: " + format(dns_error) + ".\n"), + + ssl_connect_error(connect_error) then + print("SSL connect error: " + format(connect_error) + ".\n"), + + transmission_problem then + print("Transmission problem.\n"), + + request_refused_by_server then + print("The request has been refused by server: " + server + ".\n"), + + ok(response,headers1,document1) then + ( + if print_all + then ( + print("\n----- response ----\n"); + print(response); + print("\n----- headers -----\n"); + print_headers(headers1); + print("----- document ----\n") + ) else unique + ); + print(document1) // on the screen (use a redirection to get it in a file) + } + } + }. + diff --git a/web/CXM_xml_rpc.anubis b/web/CXM_xml_rpc.anubis new file mode 100644 index 0000000..46b4804 --- /dev/null +++ b/web/CXM_xml_rpc.anubis @@ -0,0 +1,366 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 29/06/2013 + * Time: 00:47 + * + * To change this template use Tools | Options | Coding | Edit Standard Headers. + */ + +read tools/base64.anubis +read tools/basis.anubis +read tools/connections.anubis +read system/convert.anubis +read system/string.anubis +read web/CXM_common.anubis +read web/CXM_http_get_common.anubis +read web/CXM_xml_rpc_parser.anubis +read web/CXM_xml_rpc_types.anubis + + +define XML_RPC_parameters sysinfo_params = + parameters + [ + parameter[int(1)], + parameter[bool(true)], + parameter[string("This is a string")], + parameter[double(1.45)], + parameter[datetime("date to do")], + parameter[base64("Base 64 content")], + parameter[struct(members([ + member("1st member", int(2)), + member("2nd member", string("this is the 2nd string")) + ]))], + parameter[array(array([ + int(3), + string("3rd string") + ]))] + ]. + +define XML_RPC_parameters empty_param = parameters []. + +public type XML_RPC_Result: + cannot_resolve_server_name(DNS_Result), + cannot_connect_to_server(NetworkConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, // HTTP response line from the server + List(HTTP_header) headers, // HTTP headers received from the server + String document). // The HTML document itself + +public type XML_RPC_Auth: + none, + basic(String login, String password). + +public type XML_RPC_client: + xml_rpc_client( + Connection conn, + XML_RPC_Auth auth, + String url, + String user_agent, + String host). + +define String + tab + ( + Int position + )= + to_string(constant_byte_array(position * 2, ' ')). + +define String format_struct(XML_RPC_struct structure, Int position). +define String format_array(XML_RPC_array array, Int position). + +define String format_int_value ( Word32 value) = ""+to_String(value)+"" + crlf. +define String format_boolean_value ( Bool value) = ""+to_String_value(value)+"" + crlf. +define String format_string_value ( String value) = ""+value+"" + crlf. +define String format_double_value ( Float value) = ""+float_to_string(value, 10)+"" + crlf. +define String format_datetime_value ( String value) = ""+value+"" + crlf. +define String format_base64_value ( String value) = ""+value+"" + crlf. + +define String + format_value + ( + XML_RPC_value rpc_value, + Int position + )= + with return = if rpc_value is + { + int(value) then format_int_value(value), + bool(value) then format_boolean_value(value), + string(value) then format_string_value(value), + double(value) then format_double_value(value), + datetime(value) then format_datetime_value(value), + base64(value) then format_base64_value(value), + struct(value) then format_struct(value, position + 1), + array(value) then format_array(value, position + 1) + }, + tab(position) + return. + + +define String + _format_struct + ( + String so_far, + List(XML_RPC_struct_member) members, + Int position + )= + if members is + { + [] then so_far, + [h . t] then + if h is member(name, val) then + _format_struct( so_far + tab(position) + "" + crlf + + tab(position + 1)+""+name+"" + crlf + + format_value(val, position + 1) + + tab(position + 1) + "" + crlf, + t, + position) + }. + +define String + format_struct + ( + XML_RPC_struct struct, + Int position + ) = + if struct is members(structure_members) then + /*tab(position) +*/ "" + crlf + + _format_struct("", structure_members, position+1)+ + tab(position + 1) + "" + crlf. + +define String + _format_array + ( + String so_far, + List(XML_RPC_value) values, + Int position + )= + if values is + { + [] then so_far, + [h . t] then _format_array( so_far + format_value(h, position), t, position) + }. + +define String + format_array + ( + XML_RPC_array arr, + Int position + ) + = + if arr is array(values) then + /*tab(position) +*/ "" + crlf + + tab(position + 1) + "" + crlf+ + _format_array("", values, position + 2)+ + tab(position+2)+"" + crlf + + tab(position + 1) + "" + crlf. + +public define String + format_xml_rpc_values + ( + List(XML_RPC_value) values, + Int position, + String so_far + )= + if values is + { + [] then so_far, + [ h . t ] then + format_xml_rpc_values(t, position, so_far + format_value(h, position)) + }. + +public define String + format_xml_rpc_parameter + ( + XML_RPC_parameter param, + Int position + )= + if param is parameter(values) then + format_xml_rpc_values(values, position, "") + . + + +define String + _format_xml_rpc_parameters + ( + String so_far, + List(XML_RPC_parameter) params, + Int position + )= + if params is + { + [] then so_far, + [ h . t ] then + _format_xml_rpc_parameters( so_far + tab(position) + "" + crlf + + format_xml_rpc_parameter(h, position + 1) + + tab(position+1) + "" + crlf, + t, + position) + }. + +public define String + format_xml_rpc_parameters + ( + XML_RPC_parameters params, + Int position + )= + if params is parameters(list_param) then + tab(position)+"" + crlf + + _format_xml_rpc_parameters("", list_param, position+1) + + tab(position+1)+"". + +public define String + format_xml_rpc_fault + ( + XML_RPC_value value, + Int position + )= + tab(position)+"" + crlf + + format_value(value, position+1) + + tab(position+1)+"". + +public define Bool + accept_policy + ( + Maybe(X509) suspect_certificate + ) = true. + +public define Maybe(XML_RPC_client) + xml_rpc_new_client + ( + String server_name, + Bool use_ssl, + XML_RPC_Auth auth, + String user_agent, + String host + )= + if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then + // + // resolve server name and call 'https_get' with numeric server address: + // + with a = dns(name), + if a is ok(server_addr) then + //connect to server with right protocol + if use_ssl then + println("SSL "+server_port+ " "+server_name); + if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is + { + error(msg) then failure, + ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host)) + } + else + println("TCP "+server_port+ " "+server_name); + if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is + { + error(e) then failure, + ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host)) + } + else + failure. + +define Maybe(XML_RPC_response) + receive + ( + Bool print_dump, + Connection conn + )= + //TODO find the header and content-lenght to get full length of answer + + if read(conn, 16384, 5) is + { + error then println("Read error");failure, + timeout then println("Read timeout");failure, + ok(ba) then + with xml_response = to_string(ba), + typed_response = xml_rpc_get_response(xml_response), + (if print_dump then + + println("=== Server answer ==="+crlf + xml_response ); + println("=== XML_RPC Anubis interpretation ==="); + + if typed_response is + { + failure then println("Interpretation error"), + success(result) then + if result is + { + ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)), + fault(fault) then println(format_xml_rpc_fault(fault,1)) + } + + } + else unique); + typed_response + } + . + +public define Maybe(XML_RPC_response) + xml_rpc_client_execute + ( + Bool print_dump, + XML_RPC_client client, + String url, + String method_name, + XML_RPC_parameters params + //(XML-string)->$T answer_handler //convert the xml answer to anubis type + )= + if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then + //execute the method on remote server + // - 1 - Format the xml body to comply with XML RPC + with body = "" + crlf + + tab(1)+"" + crlf + + tab(2)+"" + method_name +"" + crlf + + format_xml_rpc_parameters(params, 2) + + tab(1)+"", + + // - 2 - Format the POST HTTP request + with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute + "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1) + "Host: " + server_name + crlf + + "Content-type: text/xml" + crlf + + if auth is + { + none then "", + basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf + }+ + "Content-length: " + length(body)+ crlf + + + //format_headers(headers) + + crlf + + body, + + // - 3 - send it to remote + + // + // Send the HTTP request, and receive the answer: + // + (if print_dump then + ( + print("----- request ----\n"); + print(request); + print("\n") + ) else unique); + + if write(conn, to_byte_array(request)) is + { + failure then failure, + success(_) then receive(print_dump, conn) + }. + + //wait the answer + + +global define One + xml_rpc_test + ( + List(String) args + )= + if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is + { + failure then println(" xml_rpc_test new client failure"), + success(rpc_client) then + forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "list_domains", empty_param)) + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]]))) + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param)) + }. + diff --git a/web/CXM_xml_rpc_parser.anubis b/web/CXM_xml_rpc_parser.anubis new file mode 100644 index 0000000..1190356 --- /dev/null +++ b/web/CXM_xml_rpc_parser.anubis @@ -0,0 +1,472 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 06/07/2013 + * Time: 01:13 + * + * To change this template use Tools | Options | Coding | Edit Standard Headers. + */ + +read web/CXM_xml_rpc_types.anubis +read tools/streams.anubis +read tools/basis.anubis +read system/string.anubis +read system/convert.anubis + +type XML_RPC_Token: + none, + token(String token). + +define Maybe(XML_RPC_value) read_value(Stream stream). + +define XML_RPC_Token + _next_xml_token + ( + Stream stream, + List(Word8) so_far, + Bool in_token + )= + if read_byte(stream) is + { + failure then none, //can't read on stream !! + success(b) then + //println("["+implode([b])+"]"); + if in_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + with tok = to_lower(implode(reverse(so_far))), + //println("found tag "+tok); + token(tok) + else + _next_xml_token(stream, [b . so_far], in_token) + else + if b = '<' then //just found the begin of token + _next_xml_token(stream, [], true) + else + _next_xml_token(stream, so_far, in_token) + } + . + + + +define XML_RPC_Token + next_xml_token + ( + Stream stream + )= _next_xml_token(stream, [], false). + +define Maybe(String) + _xml_tag_content + ( + Stream stream, + String tag, //tag to match + List(Word8) so_far, + List(Word8) content, + Bool in_first_token, + Bool in_content, + Bool in_last_token + + )= + if read_byte(stream) is + { + failure then failure, //can't read on stream !! + success(b) then + if in_first_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + if to_lower(implode(reverse(so_far))) = tag then + _xml_tag_content(stream, tag, [], [], false, true, false) + else + failure + else + _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token) + else if in_content then + if b = '<' then //just found the begin bracket, + if read_byte(stream) is + { + failure then failure, //can't read on stream !! + success(b) then + if b = '/' then //can't find / => syntax error + _xml_tag_content(stream, tag, [], content, false, false, true) + else + failure + } + else + _xml_tag_content(stream, tag, [], [b . content], false, true, false) + else if in_last_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + if to_lower(implode(reverse(so_far))) = tag then + with content = implode(reverse(content)), + println("Tag ["+tag+"] content found ["+content+"]"); + success(content) + else + failure + else + _xml_tag_content(stream, tag, [b . so_far], content, false, false, true) + + else + if b = '<' then //just found the begin of token + _xml_tag_content(stream, tag, [], [], true, false, false) + else + _xml_tag_content(stream, tag, [], [], false, false, false) + } + . +define Maybe(String) + xml_pair_tag_content + ( + Stream stream, + String tag + )= _xml_tag_content( stream, tag, [], [], false, false, false). + +define Maybe(String) + xml_tag_content + ( + Stream stream, + String tag + )= _xml_tag_content( stream, tag, [], [], false, true, false). + + /***** ARRAY functions ******/ + +define Maybe(List(XML_RPC_value)) + read_values + ( + Stream stream, + List(XML_RPC_value) so_far + )= + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + + if token = "value" then //there is another value we read it + read_values(stream, [value . so_far]) + else + unput_string("<"+token+">", stream); + success(reverse([value . so_far])) + } + }. + +define Maybe(List(XML_RPC_value)) + read_data + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "data" then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "value" then + if read_values(stream, []) is + { + failure then failure + success(values) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "/data" then + success(values) + else + failure + } + } + else + failure + } + else + failure + }. + +define Maybe(XML_RPC_value) + read_array + ( + Stream stream + )= + if read_data(stream) is + { + failure then failure + success(values) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "/array" then + success(array(array(values))) + else + failure + } + }. + + /***** STRUCT functions ******/ + +define Maybe(List(XML_RPC_struct_member)) + read_members + ( + Stream stream, + List(XML_RPC_struct_member) so_far + )= + if xml_pair_tag_content(stream, "name") is + { + failure then failure, + success(member_name) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "/member" then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "member" then //there is another member in structure, we read it + read_members(stream, [member(member_name, value) . so_far]) + else if tok = "/struct" then //End of structrue found + println("End struct"); + success(reverse([member(member_name, value) . so_far])) //return all members in right order + else + failure //unexpected token + } + else + failure + } + } + else + failure + } + } . + +define Maybe(XML_RPC_value) + read_struct + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "member" then + if read_members(stream, []) is + { + failure then failure + success(members_list) then success(struct(members(members_list))) + } + else + failure + }. + +define Maybe(XML_RPC_value) + read_value + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + with value = if token = "string" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(string(v)) + } + else if token = "int" then + if xml_tag_content(stream, "int") is + { + failure then failure, + success(v) then + if decimal_scan(v) is + { + failure then failure, + success(int_v) then success(int(truncate_to_Word32(int_v))) + } + } + else if token = "i4" then + if xml_tag_content(stream, "i4") is + { + failure then failure, + success(v) then + if decimal_scan(v) is + { + failure then failure, + success(int_v) then success(int(truncate_to_Word32(int_v))) + } + } + else if token = "boolean" then + if xml_tag_content(stream, "boolean") is + { + failure then failure, + success(v) then success(bool(to_Bool(v))) + } + else if token = "double" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(double(0.0)) + } + else if token = "datetime" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(datetime(v)) + } + else if token = "base64" then + if xml_tag_content(stream, "base64") is + { + failure then failure, + success(b64) then success(base64(b64)) + } + else if token = "struct" then read_struct(stream) + else if token = "array" then read_array(stream) + else + failure, + if next_xml_token(stream) is + { + none then failure + token(token) then + if token = "/value" then + value + else + failure + } + }. + +define Maybe(XML_RPC_parameter) + in_value + ( + Stream stream, + List(XML_RPC_value) so_far + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then in_value(stream, [ value. so_far]) + } + else if tok = "/param" then + success(parameter(reverse(so_far))) + else + failure + }. + +define Maybe(XML_RPC_value) + in_fault + ( + Stream stream, + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "/fault" then + success(value) + else + failure + } + } + else + failure + }. + +define Maybe(XML_RPC_parameters) + in_param + ( + Stream stream, + List(XML_RPC_parameter) so_far + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "param" then + if in_value(stream, []) is + { + failure then failure, + success(param) then in_param(stream, [ param . so_far]) + } + + else if tok = "/params" then + success(parameters(reverse(so_far))) + else + failure + } + . + +define Maybe(XML_RPC_response) + in_params + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "params" then + if in_param(stream, []) is + { + failure then failure, + success(resp) then success(ok(resp)) + } + else if tok = "fault" then + if in_fault(stream) is + { + failure then failure, + success(resp) then success(fault(resp)) + } + else + failure + } + + . + +public define Maybe(XML_RPC_response) + xml_rpc_get_response + ( + String response + )= + with stream = make_stream(response), + if next_xml_token(stream) is + { + none then failure + token(tok) then + if tok = "?xml version='1.0'?" then + if next_xml_token(stream) is + { + none then failure + token(tok) then + if tok = "methodresponse" then + in_params(stream) + else + failure + } + else + failure + }. diff --git a/web/CXM_xml_rpc_types.anubis b/web/CXM_xml_rpc_types.anubis new file mode 100644 index 0000000..44a7dd9 --- /dev/null +++ b/web/CXM_xml_rpc_types.anubis @@ -0,0 +1,41 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 06/07/2013 + * Time: 15:27 + * + * To change this template use Tools | Options | Coding | Edit Standard Headers. + */ + +public type XML_RPC_struct:... +public type XML_RPC_array:... + +public type XML_RPC_value: + int(Word32), + bool(Bool), + string(String), + double(Float), + datetime(String), + base64(String), + struct(XML_RPC_struct), + array(XML_RPC_array). + +public type XML_RPC_array: + array(List(XML_RPC_value)). + +public type XML_RPC_struct_member: + member(String name, XML_RPC_value value). + +public type XML_RPC_struct: + members(List(XML_RPC_struct_member)). + +public type XML_RPC_parameter: + parameter(List(XML_RPC_value)). + +public type XML_RPC_parameters: + parameters(List(XML_RPC_parameter)). + +public type XML_RPC_response: + ok(XML_RPC_parameters params), + fault(XML_RPC_value fault). + -- libgit2 0.21.4