diff --git a/web/CXM_multihost_http_server.anubis b/web/CXM_multihost_http_server.anubis
index cc7f26b..f57cc0f 100644
--- a/web/CXM_multihost_http_server.anubis
+++ b/web/CXM_multihost_http_server.anubis
@@ -694,20 +694,29 @@ type EncodingType:
www_url,
multipart_form_data.
-type BufferedConnection:
+public type BufferedConnection:
buffered_connection(Connection conn,
Var(ByteArray) buffer,
- Var(Int) read_pos).
-
+ Var(Int) read_pos,
+ Var(List(Word8)) unput_chars // for reading requests
+ ).
+public define BufferedConnection
+ buffered_connection
+ (
+ Connection conn
+ )=
+ buffered_connection(conn, var(constant_byte_array(0, 0)), var(0), var([]))
+ .
+
*** [2] Tools.
*** [2.1] Formating an error message.
The next function formats an error message.
-define String
+public define String
format
(
Error msg
@@ -751,7 +760,7 @@ define String
public type SState:
sstate
(
- Var(List(Word8)) unput_chars, // for reading requests
+ //Var(List(Word8)) unput_chars, // for reading requests
Var(Int) sttm, // 'start time'
Var(Int) uploaded_file_count
).
@@ -775,8 +784,8 @@ public type SState:
define One
unput // unputting a character (add it in front of the list)
(
- Word8 character,
- SState s
+ Word8 character,
+ BufferedConnection s
) =
s.unput_chars <- (List(Word8))[character . *(s.unput_chars)].
@@ -880,13 +889,12 @@ define Result(Error,Word8)
next_char // reading a character (check the list first, and read on the connection
// only when the list is empty).
(
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
+ BufferedConnection connection
+// Int dead_line,
+// DenialOfService dos
) =
//with t2_tmp = (UTime) now,
- if *(s.unput_chars) is
+ if *(connection.unput_chars) is
{
[ ] then
// ///////////////////
@@ -930,17 +938,16 @@ define Result(Error,Word8)
// },
[h . t] then
- s.unput_chars <- t; //accumulate_t2(t2_tmp);
+ connection.unput_chars <- t; //accumulate_t2(t2_tmp);
ok(h)
}.
define ByteArray
get_and_erase_buffer
(
- BufferedConnection connection,
- SState s
+ BufferedConnection connection
)=
- with head = to_byte_array(implode(*s.unput_chars)),
+ with head = to_byte_array(implode(*connection.unput_chars)),
tail = extract(*connection.buffer, *connection.read_pos, length(*connection.buffer)),
// println("--- get_and_erase_buffer ----");
// println("unput char length : "+length(to_string(head)));
@@ -953,7 +960,7 @@ define ByteArray
// println("["+to_string(*connection.buffer)+"]");
// println(" -- tail content ");
// println("["+to_string(tail)+"]");
- s.unput_chars <- [];
+ connection.unput_chars <- [];
connection.buffer <- constant_byte_array(0,0);
connection.read_pos <- 0;
head + tail
@@ -970,20 +977,19 @@ define ByteArray
just before the body of a request.
define Result(Error,One)
- read_and_ignore
- (
- BufferedConnection connection, // to client
- Int dead_line,
- Int number_of_characters, // number of characters to read and ignore
- DenialOfService dos,
- SState s
- ) =
- if number_of_characters =< 0 then ok(unique) else
- if next_char(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos, s)
- }.
+ read_and_ignore
+ (
+ BufferedConnection connection, // to client
+ Int number_of_characters // number of characters to read and ignore
+ ) =
+ if number_of_characters =< 0 then
+ ok(unique)
+ else
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(c) then read_and_ignore(connection, number_of_characters-1)
+ }.
@@ -1001,28 +1007,25 @@ define Result(Error,One)
define Result(Error,String)
read_string
(
- BufferedConnection connection, // connection with the client
- Int dead_line,
- List(Word8) so_far, // characters read so far (in reverse order)
- DenialOfService dos,
- SState s
+ BufferedConnection connection, // connection with the client
+ List(Word8) so_far // characters read so far (in reverse order)
) =
- if next_char(connection, dead_line,dos, s) is
+ if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = '\\'
- then if next_char(connection,dead_line,dos, s) is
+ then if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = '\"'
- then read_string(connection,dead_line,['\"' . so_far],dos, s)
- else read_string(connection,dead_line,[d, c . so_far],dos, s)
+ then read_string(connection,['\"' . so_far])
+ else read_string(connection,[d, c . so_far])
}
else if c = '\"'
then ok(implode(reverse(so_far)))
- else read_string(connection,dead_line,[c . so_far],dos, s)
+ else read_string(connection,[c . so_far])
}.
@@ -1304,34 +1307,31 @@ define Bool
define Result(Error,One)
skip_http_blanks
(
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
+ BufferedConnection connection
) =
- if next_char(connection, dead_line, dos, s) is
+ if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if is_strict_blank(c)
- then skip_http_blanks(connection, dead_line, dos, s)
+ then skip_http_blanks(connection)
else if c = 13
- then if next_char(connection, dead_line, dos, s) is
+ then if next_char(connection) is
{
error(msg) then error(msg), // (unput(c); ok(unique)),
ok(d) then
if d = 10
- then if next_char(connection, dead_line, dos, s) is
+ then if next_char(connection) is
{
error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
ok(e) then
if is_strict_blank(e)
- then skip_http_blanks(connection, dead_line, dos, s)
- else (unput(e, s); unput(d, s); unput(c, s); ok(unique))
+ then skip_http_blanks(connection)
+ else (unput(e, connection); unput(d, connection); unput(c, connection); ok(unique))
}
- else (unput(d, s); unput(c, s); ok(unique))
+ else (unput(d, connection); unput(c, connection); ok(unique))
}
- else (unput(c, s); ok(unique))
+ else (unput(c, connection); ok(unique))
}.
@@ -1358,39 +1358,59 @@ define Result(Error,One)
come. This is the reason for 'read_and_ignore' above, which is used precisely for
reading that last (13,10) pair.
-define Result(Error,One)
- read_new_line
- (
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
- ) =
- if skip_http_blanks(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(_) then
- if next_char(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = 13
- then if next_char(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(d) then
- if d = 10
- then ok(unique)
- else (unput(d, s);
- unput(c, s);
- error(end_of_line_expected))
- }
- else (unput(c, s);
- error(end_of_line_expected))
- }}.
-
+public define Result(Error,One)
+ read_new_line
+ (
+ BufferedConnection connection
+ ) =
+ if skip_http_blanks(connection) is
+ {
+ error(msg) then error(msg),
+ ok(_) then
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = 13
+ then if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(d) then
+ if d = 10
+ then ok(unique)
+ else (unput(d, connection);
+ unput(c, connection);
+ println("1");
+ error(end_of_line_expected))
+ }
+ else (unput(c, connection);
+ println("2");
+ error(end_of_line_expected))
+ }}.
+public define Result(Error,One)
+ skip_line
+ (
+ BufferedConnection connection
+ ) =
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = 13 then
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(d) then
+ if d = 10 then
+ ok(unique)
+ else
+ skip_line(connection)
+ }
+ else
+ skip_line(connection)
+ }.
@@ -1412,42 +1432,36 @@ define Result(Error,String)
read_word_aux
(
BufferedConnection connection,
- Int dead_line,
- List(Word8) so_far,
- DenialOfService dos,
- SState s
+ List(Word8) so_far
) =
- if next_char(connection,dead_line,dos, s) is
- {
- error(msg) then error(msg),
- ok(c) then
- if is_blank(c)
- then (unput(c, s);
- ok(implode(reverse(so_far))))
- else read_word_aux(connection,dead_line,[c . so_far],dos, s)
- }.
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if is_blank(c)
+ then (unput(c, connection);
+ ok(implode(reverse(so_far))))
+ else read_word_aux(connection,[c . so_far])
+ }.
define Result(Error,String)
- read_word
- (
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
- ) =
- if skip_http_blanks(connection,dead_line,dos, s) is
- {
- error(msg) then error(msg),
- ok(_) then
- if next_char(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = '\"'
- then read_string(connection,dead_line,[],dos, s)
- else read_word_aux(connection,dead_line,[c],dos, s)
- }
- }.
+ read_word
+ (
+ BufferedConnection connection
+ ) =
+ if skip_http_blanks(connection) is
+ {
+ error(msg) then error(msg),
+ ok(_) then
+ if next_char(connection) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = '\"'
+ then read_string(connection,[])
+ else read_word_aux(connection,[c])
+ }
+ }.
@@ -1602,24 +1616,22 @@ define Result(Error,HTTP_RequestType)
if ls = "post" then ok(post) else
error(not_get_or_post_request(ls)).
-define Result(Error,HTTP_RequestLine)
- read_request_line
- (
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
- ) =
- if read_word(connection, dead_line, dos, s) is
+public define Result(Error, HTTP_RequestLine)
+ read_request_line
+ (
+ BufferedConnection connection
+ ) =
+ if read_word(connection) is
{
- error(msg) then error(msg),
- ok(get_or_post) then if read_word(connection, dead_line, dos, s) is
- {
- error(msg) then error(msg),
- ok(uri_and_query_string) then if read_word(connection, dead_line, dos, s) is
+ error(msg) then error(msg),
+ ok(get_or_post) then
+ if read_word(connection) is
+ {
+ error(msg) then error(msg),
+ ok(uri_and_query_string) then if read_word(connection) is
{
- error(msg) then error(msg),
- ok(http_version) then if read_new_line(connection, dead_line, dos, s) is
+ error(msg) then error(msg),
+ ok(http_version) then if read_new_line(connection) is
{
error(msg) then error(msg),
ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
@@ -1636,10 +1648,6 @@ define Result(Error,HTTP_RequestLine)
-
-
-
-
*** [4.8] Reading the HTTP headers.
Each header is made of a name (containing only letters, the underscore, digits and the
@@ -1663,34 +1671,28 @@ define Result(Error,String)
read_header_name
(
BufferedConnection connection,
- Int dead_line,
- List(Word8) so_far,
- DenialOfService dos,
- SState s
+ List(Word8) so_far
) =
- if next_char(connection, dead_line, dos, s) is
+ if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if is_header_name_char(c)
- then read_header_name(connection, dead_line, [to_lower(c) . so_far], dos, s)
- else unput(c, s); ok(implode(reverse(so_far)))
+ then read_header_name(connection, [to_lower(c) . so_far])
+ else unput(c, connection); ok(implode(reverse(so_far)))
}.
define Result(Error,One)
skip_colon
(
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
+ BufferedConnection connection
) =
//Skip the blank char until ':'
- if skip_http_blanks(connection, dead_line, dos, s) is
+ if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
- if next_char(connection, dead_line, dos, s) is
+ if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
@@ -1701,72 +1703,66 @@ define Result(Error,One)
define Result(Error,String)
- read_header_value
- (
- BufferedConnection connection,
- Int dead_line,
- List(Word8) so_far,
- DenialOfService dos,
- SState s
- ) =
- if next_char(connection, dead_line, dos, s) is
+ read_header_value
+ (
+ BufferedConnection connection,
+ List(Word8) so_far
+ ) =
+ if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = 13
- then if next_char(connection, dead_line, dos, s) is
+ then if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = 10
- then if next_char(connection, dead_line, dos, s) is
+ then if next_char(connection) is
{
error(msg) then error(msg),
ok(e) then
if is_strict_blank(e)
- then read_header_value(connection,dead_line, [e . so_far], dos, s)
- else (unput(e, s); ok(implode(reverse(so_far))))
+ then read_header_value(connection, [e . so_far])
+ else (unput(e, connection); ok(implode(reverse(so_far))))
}
- else read_header_value(connection,dead_line,[d, c . so_far],dos, s)
+ else read_header_value(connection,[d, c . so_far])
}
- else read_header_value(connection,dead_line,[c . so_far],dos, s)
+ else read_header_value(connection,[c . so_far])
}.
Reading a single header.
define Result(Error,Maybe(HTTP_header))
- read_header
- (
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
- ) =
+ read_header
+ (
+ BufferedConnection connection
+ ) =
//Find the name
- if read_header_name(connection, dead_line, [], dos, s) is
+ if read_header_name(connection, []) is
{
error(msg) then error(msg),
ok(name) then
if name = "" then
- if read_and_ignore(connection, dead_line, 2, dos, s) /* 13 and 10 */ is
+ if read_and_ignore(connection, 2) /* 13 and 10 */ is
{
error(msg) then error(msg),
ok(_) then // this is the blank line
ok(failure) // end of headers
}
//skip the ':' and blank before and after it
- else if skip_colon(connection, dead_line, dos, s) is
+ else if skip_colon(connection) is
{
error(msg) then error(msg),
ok(_) then
//skip the blank char after the ':'
- if skip_http_blanks(connection, dead_line, dos, s) is
+ if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
//Now read the value
- if read_header_value(connection, dead_line, [], dos, s) is
+ if read_header_value(connection, []) is
{
error(msg) then error(msg),
ok(value) then ok(success(http_header(name,value)))
@@ -1779,22 +1775,19 @@ define Result(Error,Maybe(HTTP_header))
Reading all the headers.
-define Result(Error,List(HTTP_header))
+public define Result(Error,List(HTTP_header))
read_http_headers
(
- BufferedConnection connection,
- Int dead_line,
- DenialOfService dos,
- SState s
+ BufferedConnection connection
) =
- if read_header(connection, dead_line, dos, s) is
+ if read_header(connection) is
{
error(msg) then error(msg),
ok(mbh) then if mbh is
{
failure then ok([ ]),
success(header) then
- if read_http_headers(connection, dead_line, dos, s) is
+ if read_http_headers(connection) is
{
error(msg) then error(msg),
ok(others) then ok([header . others])
@@ -1813,7 +1806,7 @@ define Result(Error,List(HTTP_header))
The size of the body of the request is given under the 'Content-Length' header. If this
header is not present, the size is assumed to be zero.
-define Result(Error,Int)
+public define Result(Error,Int)
get_body_size
(
List(HTTP_header) headers
@@ -1843,7 +1836,7 @@ define Result(Error,Int)
may be broken. In that case, we must not try to read indefinitely. On the contrary, we
make at most 10 retries, with a small sleeping time between any two of them.
-define Result(Error, ByteArray)
+public define Result(Error, ByteArray)
read_http_body
(
BufferedConnection connection,
@@ -3183,12 +3176,12 @@ define One
//println("Request time: " + format_http_date(start_time));
if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then
- if read_request_line(connection, start_time+*rld_v, dos, s) is
+ if read_request_line(connection) is
{
error(msg) then print(format(msg)),
ok(rqline) then //request line
//print_delta("read_request_line");
- if read_http_headers(connection, start_time+*hd_v, dos, s) is
+ if read_http_headers(connection) is
{
error(msg) then print(format(msg)),
ok(headers) then //print_delta("read_http_headers");
@@ -3237,7 +3230,7 @@ define One
success(target) then
//get the content of the current buffer and unput char list
- with buffer = get_and_erase_buffer(connection, s),
+ with buffer = get_and_erase_buffer(connection),
buffer_size = length(buffer),
//println("buffer Size = "+buffer_size);
//println("Old body size "+body_size+" New body size request = "+body_size - buffer_size);
@@ -3295,8 +3288,8 @@ define Server -> ((RWStream) -> One)
if is_dubious_IP(addr,dos)
then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
else
- with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
- http_https_handler(sites, connection, false, dos, sstate(var([]),var(0),var(0))).
+ with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
+ http_https_handler(sites, connection, false, dos, sstate(var(0),var(0))).
public define One
http_direct_handler
(
@@ -3308,8 +3301,8 @@ public define One
if is_dubious_IP(addr,dos)
then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
else
- with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
- http_https_handler(sites, connection, false, dos, sstate(var([]),var(0),var(0))).
+ with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
+ http_https_handler(sites, connection, false, dos, sstate(var(0),var(0))).
define Server -> (SSL_Connection -> One)
@@ -3319,8 +3312,8 @@ define Server -> (SSL_Connection -> One)
DenialOfService dos
) =
(Server server) |-> (SSL_Connection conn) |->
- with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
- http_https_handler(sites, connection, true, dos, sstate(var([]),var(0),var(0))).
+ with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0), var([])),
+ http_https_handler(sites, connection, true, dos, sstate(var(0),var(0))).
@@ -3712,12 +3705,12 @@ define Server -> ((RWStream) -> One)
) =
(Server server) |-> (RWStream conn) |->
with start_time = (Int)now,
- connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
- if read_request_line(connection, start_time+*request_line_delay(dos), dos, ss) is
+ connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
+ if read_request_line(connection) is
{
error(msg) then print(format(msg)),
ok(request_line) then
- if read_http_headers(connection, start_time+*headers_delay(dos), dos, ss) is
+ if read_http_headers(connection) is
{
error(msg) then print(format(msg)),
ok(headers) then if get_host_header_value(headers) is
diff --git a/web/CXM_xml_rpc.anubis b/web/CXM_xml_rpc.anubis
index 46b4804..e8b6475 100644
--- a/web/CXM_xml_rpc.anubis
+++ b/web/CXM_xml_rpc.anubis
@@ -1,366 +1,415 @@
-/*
- * 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))
- }.
-
+/*
+ * Created by PyramIDE.
+ * User: Totoro
+ * Date: 29/06/2013
+ * Time: 00:47
+ *
+ */
+
+read tools/base64.anubis
+transmit tools/basis.anubis
+read tools/connections.anubis
+read system/convert.anubis
+transmit system/string.anubis
+read calexium_lib/web/CXM_common.anubis
+read calexium_lib/web/CXM_http_get_common.anubis
+read calexium_lib/web/CXM_multihost_http_server.anubis
+transmit calexium_lib/web/CXM_xml_rpc_parser.anubis
+transmit calexium_lib/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
+ }
+ .
+
+define Maybe(XML_RPC_response)
+ receive_new
+ (
+ Bool print_dump,
+ Connection conn
+ )=
+ //TODO find the header and content-lenght to get full length of answer
+ //construct a buffered connection
+ with b_con = buffered_connection(conn),
+ if skip_line(b_con) is
+ {
+ error(msg) then print(format(msg));failure,
+ ok(_) then
+ if read_http_headers(b_con) is
+ {
+ error(msg) then print(format(msg));failure,
+ ok(headers) then
+ if get_body_size(headers) is
+ {
+ error(msg) then print(format(msg));failure,
+ ok(body_size) then
+ if read_http_body(b_con, body_size, constant_byte_array(0,0), 1000) is
+ {
+ error(msg) then print(format(msg));failure,
+ ok(body) then
+ with xml_response = to_string(body),
+ with 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_new(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(false, 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
index 1190356..7f99bcb 100644
--- a/web/CXM_xml_rpc_parser.anubis
+++ b/web/CXM_xml_rpc_parser.anubis
@@ -1,472 +1,471 @@
-/*
- * 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
- }.
+/*
+ * Created by PyramIDE.
+ * User: Totoro
+ * Date: 06/07/2013
+ * Time: 01:13
+ *
+ */
+
+read calexium_lib/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
+ }.
--
libgit2 0.21.4