Anubis / Xlib

Commit 28dc8eb2be6606adf9bac40e2c3b7f1b033d1a82

Authored by totoro
1 parent ec1c6c0b

BufferedConnection type is now public, since it uses by XML_RPC 

remove the use of dead_line, DenialOfService and SState which was no longer in use in the Calexium lib
Showing 3 changed files with 1077 additions and 1036 deletions   Show diff stats
Inline Side-by-side
web/CXM_multihost_http_server.anubis
  Show/Hide comments   View file @28dc8eb
@@ -694,20 +694,29 @@ type EncodingType: @@ -694,20 +694,29 @@ type EncodingType:
694 www_url, 694 www_url,
695 multipart_form_data. 695 multipart_form_data.
696 696
697 -type BufferedConnection: 697 +public type BufferedConnection:
698 buffered_connection(Connection conn, 698 buffered_connection(Connection conn,
699 Var(ByteArray) buffer, 699 Var(ByteArray) buffer,
700 - Var(Int) read_pos).  
701 - 700 + Var(Int) read_pos,
  701 + Var(List(Word8)) unput_chars // for reading requests
  702 + ).
702 703
703 704
  705 +public define BufferedConnection
  706 + buffered_connection
  707 + (
  708 + Connection conn
  709 + )=
  710 + buffered_connection(conn, var(constant_byte_array(0, 0)), var(0), var([]))
  711 + .
  712 +
704 *** [2] Tools. 713 *** [2] Tools.
705 714
706 *** [2.1] Formating an error message. 715 *** [2.1] Formating an error message.
707 716
708 The next function formats an error message. 717 The next function formats an error message.
709 718
710 -define String 719 +public define String
711 format 720 format
712 ( 721 (
713 Error msg 722 Error msg
@@ -751,7 +760,7 @@ define String @@ -751,7 +760,7 @@ define String
751 public type SState: 760 public type SState:
752 sstate 761 sstate
753 ( 762 (
754 - Var(List(Word8)) unput_chars, // for reading requests 763 + //Var(List(Word8)) unput_chars, // for reading requests
755 Var(Int) sttm, // 'start time' 764 Var(Int) sttm, // 'start time'
756 Var(Int) uploaded_file_count 765 Var(Int) uploaded_file_count
757 ). 766 ).
@@ -775,8 +784,8 @@ public type SState: @@ -775,8 +784,8 @@ public type SState:
775 define One 784 define One
776 unput // unputting a character (add it in front of the list) 785 unput // unputting a character (add it in front of the list)
777 ( 786 (
778 - Word8 character,  
779 - SState s 787 + Word8 character,
  788 + BufferedConnection s
780 ) = 789 ) =
781 s.unput_chars <- (List(Word8))[character . *(s.unput_chars)]. 790 s.unput_chars <- (List(Word8))[character . *(s.unput_chars)].
782 791
@@ -880,13 +889,12 @@ define Result(Error,Word8) @@ -880,13 +889,12 @@ define Result(Error,Word8)
880 next_char // reading a character (check the list first, and read on the connection 889 next_char // reading a character (check the list first, and read on the connection
881 // only when the list is empty). 890 // only when the list is empty).
882 ( 891 (
883 - BufferedConnection connection,  
884 - Int dead_line,  
885 - DenialOfService dos,  
886 - SState s 892 + BufferedConnection connection
  893 +// Int dead_line,
  894 +// DenialOfService dos
887 ) = 895 ) =
888 //with t2_tmp = (UTime) now, 896 //with t2_tmp = (UTime) now,
889 - if *(s.unput_chars) is 897 + if *(connection.unput_chars) is
890 { 898 {
891 [ ] then 899 [ ] then
892 // /////////////////// 900 // ///////////////////
@@ -930,17 +938,16 @@ define Result(Error,Word8) @@ -930,17 +938,16 @@ define Result(Error,Word8)
930 // }, 938 // },
931 939
932 [h . t] then 940 [h . t] then
933 - s.unput_chars <- t; //accumulate_t2(t2_tmp); 941 + connection.unput_chars <- t; //accumulate_t2(t2_tmp);
934 ok(h) 942 ok(h)
935 }. 943 }.
936 944
937 define ByteArray 945 define ByteArray
938 get_and_erase_buffer 946 get_and_erase_buffer
939 ( 947 (
940 - BufferedConnection connection,  
941 - SState s 948 + BufferedConnection connection
942 )= 949 )=
943 - with head = to_byte_array(implode(*s.unput_chars)), 950 + with head = to_byte_array(implode(*connection.unput_chars)),
944 tail = extract(*connection.buffer, *connection.read_pos, length(*connection.buffer)), 951 tail = extract(*connection.buffer, *connection.read_pos, length(*connection.buffer)),
945 // println("--- get_and_erase_buffer ----"); 952 // println("--- get_and_erase_buffer ----");
946 // println("unput char length : "+length(to_string(head))); 953 // println("unput char length : "+length(to_string(head)));
@@ -953,7 +960,7 @@ define ByteArray @@ -953,7 +960,7 @@ define ByteArray
953 // println("["+to_string(*connection.buffer)+"]"); 960 // println("["+to_string(*connection.buffer)+"]");
954 // println(" -- tail content "); 961 // println(" -- tail content ");
955 // println("["+to_string(tail)+"]"); 962 // println("["+to_string(tail)+"]");
956 - s.unput_chars <- []; 963 + connection.unput_chars <- [];
957 connection.buffer <- constant_byte_array(0,0); 964 connection.buffer <- constant_byte_array(0,0);
958 connection.read_pos <- 0; 965 connection.read_pos <- 0;
959 head + tail 966 head + tail
@@ -970,20 +977,19 @@ define ByteArray @@ -970,20 +977,19 @@ define ByteArray
970 just before the body of a request. 977 just before the body of a request.
971 978
972 define Result(Error,One) 979 define Result(Error,One)
973 - read_and_ignore  
974 - (  
975 - BufferedConnection connection, // to client  
976 - Int dead_line,  
977 - Int number_of_characters, // number of characters to read and ignore  
978 - DenialOfService dos,  
979 - SState s  
980 - ) =  
981 - if number_of_characters =< 0 then ok(unique) else  
982 - if next_char(connection, dead_line, dos, s) is  
983 - {  
984 - error(msg) then error(msg),  
985 - ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos, s)  
986 - }. 980 + read_and_ignore
  981 + (
  982 + BufferedConnection connection, // to client
  983 + Int number_of_characters // number of characters to read and ignore
  984 + ) =
  985 + if number_of_characters =< 0 then
  986 + ok(unique)
  987 + else
  988 + if next_char(connection) is
  989 + {
  990 + error(msg) then error(msg),
  991 + ok(c) then read_and_ignore(connection, number_of_characters-1)
  992 + }.
987 993
988 994
989 995
@@ -1001,28 +1007,25 @@ define Result(Error,One) @@ -1001,28 +1007,25 @@ define Result(Error,One)
1001 define Result(Error,String) 1007 define Result(Error,String)
1002 read_string 1008 read_string
1003 ( 1009 (
1004 - BufferedConnection connection, // connection with the client  
1005 - Int dead_line,  
1006 - List(Word8) so_far, // characters read so far (in reverse order)  
1007 - DenialOfService dos,  
1008 - SState s 1010 + BufferedConnection connection, // connection with the client
  1011 + List(Word8) so_far // characters read so far (in reverse order)
1009 ) = 1012 ) =
1010 - if next_char(connection, dead_line,dos, s) is 1013 + if next_char(connection) is
1011 { 1014 {
1012 error(msg) then error(msg), 1015 error(msg) then error(msg),
1013 ok(c) then 1016 ok(c) then
1014 if c = '\\' 1017 if c = '\\'
1015 - then if next_char(connection,dead_line,dos, s) is 1018 + then if next_char(connection) is
1016 { 1019 {
1017 error(msg) then error(msg), 1020 error(msg) then error(msg),
1018 ok(d) then 1021 ok(d) then
1019 if d = '\"' 1022 if d = '\"'
1020 - then read_string(connection,dead_line,['\"' . so_far],dos, s)  
1021 - else read_string(connection,dead_line,[d, c . so_far],dos, s) 1023 + then read_string(connection,['\"' . so_far])
  1024 + else read_string(connection,[d, c . so_far])
1022 } 1025 }
1023 else if c = '\"' 1026 else if c = '\"'
1024 then ok(implode(reverse(so_far))) 1027 then ok(implode(reverse(so_far)))
1025 - else read_string(connection,dead_line,[c . so_far],dos, s) 1028 + else read_string(connection,[c . so_far])
1026 }. 1029 }.
1027 1030
1028 1031
@@ -1304,34 +1307,31 @@ define Bool @@ -1304,34 +1307,31 @@ define Bool
1304 define Result(Error,One) 1307 define Result(Error,One)
1305 skip_http_blanks 1308 skip_http_blanks
1306 ( 1309 (
1307 - BufferedConnection connection,  
1308 - Int dead_line,  
1309 - DenialOfService dos,  
1310 - SState s 1310 + BufferedConnection connection
1311 ) = 1311 ) =
1312 - if next_char(connection, dead_line, dos, s) is 1312 + if next_char(connection) is
1313 { 1313 {
1314 error(msg) then error(msg), 1314 error(msg) then error(msg),
1315 ok(c) then 1315 ok(c) then
1316 if is_strict_blank(c) 1316 if is_strict_blank(c)
1317 - then skip_http_blanks(connection, dead_line, dos, s) 1317 + then skip_http_blanks(connection)
1318 else if c = 13 1318 else if c = 13
1319 - then if next_char(connection, dead_line, dos, s) is 1319 + then if next_char(connection) is
1320 { 1320 {
1321 error(msg) then error(msg), // (unput(c); ok(unique)), 1321 error(msg) then error(msg), // (unput(c); ok(unique)),
1322 ok(d) then 1322 ok(d) then
1323 if d = 10 1323 if d = 10
1324 - then if next_char(connection, dead_line, dos, s) is 1324 + then if next_char(connection) is
1325 { 1325 {
1326 error(msg) then error(msg), // (unput(d); unput(c); ok(unique)), 1326 error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
1327 ok(e) then 1327 ok(e) then
1328 if is_strict_blank(e) 1328 if is_strict_blank(e)
1329 - then skip_http_blanks(connection, dead_line, dos, s)  
1330 - else (unput(e, s); unput(d, s); unput(c, s); ok(unique)) 1329 + then skip_http_blanks(connection)
  1330 + else (unput(e, connection); unput(d, connection); unput(c, connection); ok(unique))
1331 } 1331 }
1332 - else (unput(d, s); unput(c, s); ok(unique)) 1332 + else (unput(d, connection); unput(c, connection); ok(unique))
1333 } 1333 }
1334 - else (unput(c, s); ok(unique)) 1334 + else (unput(c, connection); ok(unique))
1335 }. 1335 }.
1336 1336
1337 1337
@@ -1358,39 +1358,59 @@ define Result(Error,One) @@ -1358,39 +1358,59 @@ define Result(Error,One)
1358 come. This is the reason for 'read_and_ignore' above, which is used precisely for 1358 come. This is the reason for 'read_and_ignore' above, which is used precisely for
1359 reading that last (13,10) pair. 1359 reading that last (13,10) pair.
1360 1360
1361 -define Result(Error,One)  
1362 - read_new_line  
1363 - (  
1364 - BufferedConnection connection,  
1365 - Int dead_line,  
1366 - DenialOfService dos,  
1367 - SState s  
1368 - ) =  
1369 - if skip_http_blanks(connection, dead_line, dos, s) is  
1370 - {  
1371 - error(msg) then error(msg),  
1372 - ok(_) then  
1373 - if next_char(connection, dead_line, dos, s) is  
1374 - {  
1375 - error(msg) then error(msg),  
1376 - ok(c) then  
1377 - if c = 13  
1378 - then if next_char(connection, dead_line, dos, s) is  
1379 - {  
1380 - error(msg) then error(msg),  
1381 - ok(d) then  
1382 - if d = 10  
1383 - then ok(unique)  
1384 - else (unput(d, s);  
1385 - unput(c, s);  
1386 - error(end_of_line_expected))  
1387 - }  
1388 - else (unput(c, s);  
1389 - error(end_of_line_expected))  
1390 - }}.  
1391 - 1361 +public define Result(Error,One)
  1362 + read_new_line
  1363 + (
  1364 + BufferedConnection connection
  1365 + ) =
  1366 + if skip_http_blanks(connection) is
  1367 + {
  1368 + error(msg) then error(msg),
  1369 + ok(_) then
  1370 + if next_char(connection) is
  1371 + {
  1372 + error(msg) then error(msg),
  1373 + ok(c) then
  1374 + if c = 13
  1375 + then if next_char(connection) is
  1376 + {
  1377 + error(msg) then error(msg),
  1378 + ok(d) then
  1379 + if d = 10
  1380 + then ok(unique)
  1381 + else (unput(d, connection);
  1382 + unput(c, connection);
  1383 + println("1");
  1384 + error(end_of_line_expected))
  1385 + }
  1386 + else (unput(c, connection);
  1387 + println("2");
  1388 + error(end_of_line_expected))
  1389 + }}.
1392 1390
1393 1391
  1392 +public define Result(Error,One)
  1393 + skip_line
  1394 + (
  1395 + BufferedConnection connection
  1396 + ) =
  1397 + if next_char(connection) is
  1398 + {
  1399 + error(msg) then error(msg),
  1400 + ok(c) then
  1401 + if c = 13 then
  1402 + if next_char(connection) is
  1403 + {
  1404 + error(msg) then error(msg),
  1405 + ok(d) then
  1406 + if d = 10 then
  1407 + ok(unique)
  1408 + else
  1409 + skip_line(connection)
  1410 + }
  1411 + else
  1412 + skip_line(connection)
  1413 + }.
1394 1414
1395 1415
1396 1416
@@ -1412,42 +1432,36 @@ define Result(Error,String) @@ -1412,42 +1432,36 @@ define Result(Error,String)
1412 read_word_aux 1432 read_word_aux
1413 ( 1433 (
1414 BufferedConnection connection, 1434 BufferedConnection connection,
1415 - Int dead_line,  
1416 - List(Word8) so_far,  
1417 - DenialOfService dos,  
1418 - SState s 1435 + List(Word8) so_far
1419 ) = 1436 ) =
1420 - if next_char(connection,dead_line,dos, s) is  
1421 - {  
1422 - error(msg) then error(msg),  
1423 - ok(c) then  
1424 - if is_blank(c)  
1425 - then (unput(c, s);  
1426 - ok(implode(reverse(so_far))))  
1427 - else read_word_aux(connection,dead_line,[c . so_far],dos, s)  
1428 - }. 1437 + if next_char(connection) is
  1438 + {
  1439 + error(msg) then error(msg),
  1440 + ok(c) then
  1441 + if is_blank(c)
  1442 + then (unput(c, connection);
  1443 + ok(implode(reverse(so_far))))
  1444 + else read_word_aux(connection,[c . so_far])
  1445 + }.
1429 1446
1430 define Result(Error,String) 1447 define Result(Error,String)
1431 - read_word  
1432 - (  
1433 - BufferedConnection connection,  
1434 - Int dead_line,  
1435 - DenialOfService dos,  
1436 - SState s  
1437 - ) =  
1438 - if skip_http_blanks(connection,dead_line,dos, s) is  
1439 - {  
1440 - error(msg) then error(msg),  
1441 - ok(_) then  
1442 - if next_char(connection, dead_line, dos, s) is  
1443 - {  
1444 - error(msg) then error(msg),  
1445 - ok(c) then  
1446 - if c = '\"'  
1447 - then read_string(connection,dead_line,[],dos, s)  
1448 - else read_word_aux(connection,dead_line,[c],dos, s)  
1449 - }  
1450 - }. 1448 + read_word
  1449 + (
  1450 + BufferedConnection connection
  1451 + ) =
  1452 + if skip_http_blanks(connection) is
  1453 + {
  1454 + error(msg) then error(msg),
  1455 + ok(_) then
  1456 + if next_char(connection) is
  1457 + {
  1458 + error(msg) then error(msg),
  1459 + ok(c) then
  1460 + if c = '\"'
  1461 + then read_string(connection,[])
  1462 + else read_word_aux(connection,[c])
  1463 + }
  1464 + }.
1451 1465
1452 1466
1453 1467
@@ -1602,24 +1616,22 @@ define Result(Error,HTTP_RequestType) @@ -1602,24 +1616,22 @@ define Result(Error,HTTP_RequestType)
1602 if ls = "post" then ok(post) else 1616 if ls = "post" then ok(post) else
1603 error(not_get_or_post_request(ls)). 1617 error(not_get_or_post_request(ls)).
1604 1618
1605 -define Result(Error,HTTP_RequestLine)  
1606 - read_request_line  
1607 - (  
1608 - BufferedConnection connection,  
1609 - Int dead_line,  
1610 - DenialOfService dos,  
1611 - SState s  
1612 - ) =  
1613 - if read_word(connection, dead_line, dos, s) is 1619 +public define Result(Error, HTTP_RequestLine)
  1620 + read_request_line
  1621 + (
  1622 + BufferedConnection connection
  1623 + ) =
  1624 + if read_word(connection) is
1614 { 1625 {
1615 - error(msg) then error(msg),  
1616 - ok(get_or_post) then if read_word(connection, dead_line, dos, s) is  
1617 - {  
1618 - error(msg) then error(msg),  
1619 - ok(uri_and_query_string) then if read_word(connection, dead_line, dos, s) is 1626 + error(msg) then error(msg),
  1627 + ok(get_or_post) then
  1628 + if read_word(connection) is
  1629 + {
  1630 + error(msg) then error(msg),
  1631 + ok(uri_and_query_string) then if read_word(connection) is
1620 { 1632 {
1621 - error(msg) then error(msg),  
1622 - ok(http_version) then if read_new_line(connection, dead_line, dos, s) is 1633 + error(msg) then error(msg),
  1634 + ok(http_version) then if read_new_line(connection) is
1623 { 1635 {
1624 error(msg) then error(msg), 1636 error(msg) then error(msg),
1625 ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is 1637 ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
@@ -1636,10 +1648,6 @@ define Result(Error,HTTP_RequestLine) @@ -1636,10 +1648,6 @@ define Result(Error,HTTP_RequestLine)
1636 1648
1637 1649
1638 1650
1639 -  
1640 -  
1641 -  
1642 -  
1643 *** [4.8] Reading the HTTP headers. 1651 *** [4.8] Reading the HTTP headers.
1644 1652
1645 Each header is made of a name (containing only letters, the underscore, digits and the 1653 Each header is made of a name (containing only letters, the underscore, digits and the
@@ -1663,34 +1671,28 @@ define Result(Error,String) @@ -1663,34 +1671,28 @@ define Result(Error,String)
1663 read_header_name 1671 read_header_name
1664 ( 1672 (
1665 BufferedConnection connection, 1673 BufferedConnection connection,
1666 - Int dead_line,  
1667 - List(Word8) so_far,  
1668 - DenialOfService dos,  
1669 - SState s 1674 + List(Word8) so_far
1670 ) = 1675 ) =
1671 - if next_char(connection, dead_line, dos, s) is 1676 + if next_char(connection) is
1672 { 1677 {
1673 error(msg) then error(msg), 1678 error(msg) then error(msg),
1674 ok(c) then 1679 ok(c) then
1675 if is_header_name_char(c) 1680 if is_header_name_char(c)
1676 - then read_header_name(connection, dead_line, [to_lower(c) . so_far], dos, s)  
1677 - else unput(c, s); ok(implode(reverse(so_far))) 1681 + then read_header_name(connection, [to_lower(c) . so_far])
  1682 + else unput(c, connection); ok(implode(reverse(so_far)))
1678 }. 1683 }.
1679 1684
1680 define Result(Error,One) 1685 define Result(Error,One)
1681 skip_colon 1686 skip_colon
1682 ( 1687 (
1683 - BufferedConnection connection,  
1684 - Int dead_line,  
1685 - DenialOfService dos,  
1686 - SState s 1688 + BufferedConnection connection
1687 ) = 1689 ) =
1688 //Skip the blank char until ':' 1690 //Skip the blank char until ':'
1689 - if skip_http_blanks(connection, dead_line, dos, s) is 1691 + if skip_http_blanks(connection) is
1690 { 1692 {
1691 error(msg) then error(msg), 1693 error(msg) then error(msg),
1692 ok(_) then 1694 ok(_) then
1693 - if next_char(connection, dead_line, dos, s) is 1695 + if next_char(connection) is
1694 { 1696 {
1695 error(msg) then error(msg), 1697 error(msg) then error(msg),
1696 ok(c) then 1698 ok(c) then
@@ -1701,72 +1703,66 @@ define Result(Error,One) @@ -1701,72 +1703,66 @@ define Result(Error,One)
1701 1703
1702 1704
1703 define Result(Error,String) 1705 define Result(Error,String)
1704 - read_header_value  
1705 - (  
1706 - BufferedConnection connection,  
1707 - Int dead_line,  
1708 - List(Word8) so_far,  
1709 - DenialOfService dos,  
1710 - SState s  
1711 - ) =  
1712 - if next_char(connection, dead_line, dos, s) is 1706 + read_header_value
  1707 + (
  1708 + BufferedConnection connection,
  1709 + List(Word8) so_far
  1710 + ) =
  1711 + if next_char(connection) is
1713 { 1712 {
1714 error(msg) then error(msg), 1713 error(msg) then error(msg),
1715 ok(c) then 1714 ok(c) then
1716 if c = 13 1715 if c = 13
1717 - then if next_char(connection, dead_line, dos, s) is 1716 + then if next_char(connection) is
1718 { 1717 {
1719 error(msg) then error(msg), 1718 error(msg) then error(msg),
1720 ok(d) then 1719 ok(d) then
1721 if d = 10 1720 if d = 10
1722 - then if next_char(connection, dead_line, dos, s) is 1721 + then if next_char(connection) is
1723 { 1722 {
1724 error(msg) then error(msg), 1723 error(msg) then error(msg),
1725 ok(e) then 1724 ok(e) then
1726 if is_strict_blank(e) 1725 if is_strict_blank(e)
1727 - then read_header_value(connection,dead_line, [e . so_far], dos, s)  
1728 - else (unput(e, s); ok(implode(reverse(so_far)))) 1726 + then read_header_value(connection, [e . so_far])
  1727 + else (unput(e, connection); ok(implode(reverse(so_far))))
1729 } 1728 }
1730 - else read_header_value(connection,dead_line,[d, c . so_far],dos, s) 1729 + else read_header_value(connection,[d, c . so_far])
1731 } 1730 }
1732 - else read_header_value(connection,dead_line,[c . so_far],dos, s) 1731 + else read_header_value(connection,[c . so_far])
1733 }. 1732 }.
1734 1733
1735 1734
1736 Reading a single header. 1735 Reading a single header.
1737 1736
1738 define Result(Error,Maybe(HTTP_header)) 1737 define Result(Error,Maybe(HTTP_header))
1739 - read_header  
1740 - (  
1741 - BufferedConnection connection,  
1742 - Int dead_line,  
1743 - DenialOfService dos,  
1744 - SState s  
1745 - ) = 1738 + read_header
  1739 + (
  1740 + BufferedConnection connection
  1741 + ) =
1746 //Find the name 1742 //Find the name
1747 - if read_header_name(connection, dead_line, [], dos, s) is 1743 + if read_header_name(connection, []) is
1748 { 1744 {
1749 error(msg) then error(msg), 1745 error(msg) then error(msg),
1750 ok(name) then 1746 ok(name) then
1751 if name = "" then 1747 if name = "" then
1752 - if read_and_ignore(connection, dead_line, 2, dos, s) /* 13 and 10 */ is 1748 + if read_and_ignore(connection, 2) /* 13 and 10 */ is
1753 { 1749 {
1754 error(msg) then error(msg), 1750 error(msg) then error(msg),
1755 ok(_) then // this is the blank line 1751 ok(_) then // this is the blank line
1756 ok(failure) // end of headers 1752 ok(failure) // end of headers
1757 } 1753 }
1758 //skip the ':' and blank before and after it 1754 //skip the ':' and blank before and after it
1759 - else if skip_colon(connection, dead_line, dos, s) is 1755 + else if skip_colon(connection) is
1760 { 1756 {
1761 error(msg) then error(msg), 1757 error(msg) then error(msg),
1762 ok(_) then 1758 ok(_) then
1763 //skip the blank char after the ':' 1759 //skip the blank char after the ':'
1764 - if skip_http_blanks(connection, dead_line, dos, s) is 1760 + if skip_http_blanks(connection) is
1765 { 1761 {
1766 error(msg) then error(msg), 1762 error(msg) then error(msg),
1767 ok(_) then 1763 ok(_) then
1768 //Now read the value 1764 //Now read the value
1769 - if read_header_value(connection, dead_line, [], dos, s) is 1765 + if read_header_value(connection, []) is
1770 { 1766 {
1771 error(msg) then error(msg), 1767 error(msg) then error(msg),
1772 ok(value) then ok(success(http_header(name,value))) 1768 ok(value) then ok(success(http_header(name,value)))
@@ -1779,22 +1775,19 @@ define Result(Error,Maybe(HTTP_header)) @@ -1779,22 +1775,19 @@ define Result(Error,Maybe(HTTP_header))
1779 1775
1780 Reading all the headers. 1776 Reading all the headers.
1781 1777
1782 -define Result(Error,List(HTTP_header)) 1778 +public define Result(Error,List(HTTP_header))
1783 read_http_headers 1779 read_http_headers
1784 ( 1780 (
1785 - BufferedConnection connection,  
1786 - Int dead_line,  
1787 - DenialOfService dos,  
1788 - SState s 1781 + BufferedConnection connection
1789 ) = 1782 ) =
1790 - if read_header(connection, dead_line, dos, s) is 1783 + if read_header(connection) is
1791 { 1784 {
1792 error(msg) then error(msg), 1785 error(msg) then error(msg),
1793 ok(mbh) then if mbh is 1786 ok(mbh) then if mbh is
1794 { 1787 {
1795 failure then ok([ ]), 1788 failure then ok([ ]),
1796 success(header) then 1789 success(header) then
1797 - if read_http_headers(connection, dead_line, dos, s) is 1790 + if read_http_headers(connection) is
1798 { 1791 {
1799 error(msg) then error(msg), 1792 error(msg) then error(msg),
1800 ok(others) then ok([header . others]) 1793 ok(others) then ok([header . others])
@@ -1813,7 +1806,7 @@ define Result(Error,List(HTTP_header)) @@ -1813,7 +1806,7 @@ define Result(Error,List(HTTP_header))
1813 The size of the body of the request is given under the 'Content-Length' header. If this 1806 The size of the body of the request is given under the 'Content-Length' header. If this
1814 header is not present, the size is assumed to be zero. 1807 header is not present, the size is assumed to be zero.
1815 1808
1816 -define Result(Error,Int) 1809 +public define Result(Error,Int)
1817 get_body_size 1810 get_body_size
1818 ( 1811 (
1819 List(HTTP_header) headers 1812 List(HTTP_header) headers
@@ -1843,7 +1836,7 @@ define Result(Error,Int) @@ -1843,7 +1836,7 @@ define Result(Error,Int)
1843 may be broken. In that case, we must not try to read indefinitely. On the contrary, we 1836 may be broken. In that case, we must not try to read indefinitely. On the contrary, we
1844 make at most 10 retries, with a small sleeping time between any two of them. 1837 make at most 10 retries, with a small sleeping time between any two of them.
1845 1838
1846 -define Result(Error, ByteArray) 1839 +public define Result(Error, ByteArray)
1847 read_http_body 1840 read_http_body
1848 ( 1841 (
1849 BufferedConnection connection, 1842 BufferedConnection connection,
@@ -3183,12 +3176,12 @@ define One @@ -3183,12 +3176,12 @@ define One
3183 //println("Request time: " + format_http_date(start_time)); 3176 //println("Request time: " + format_http_date(start_time));
3184 if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then 3177 if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
3185 if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then 3178 if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then
3186 - if read_request_line(connection, start_time+*rld_v, dos, s) is 3179 + if read_request_line(connection) is
3187 { 3180 {
3188 error(msg) then print(format(msg)), 3181 error(msg) then print(format(msg)),
3189 ok(rqline) then //request line 3182 ok(rqline) then //request line
3190 //print_delta("read_request_line"); 3183 //print_delta("read_request_line");
3191 - if read_http_headers(connection, start_time+*hd_v, dos, s) is 3184 + if read_http_headers(connection) is
3192 { 3185 {
3193 error(msg) then print(format(msg)), 3186 error(msg) then print(format(msg)),
3194 ok(headers) then //print_delta("read_http_headers"); 3187 ok(headers) then //print_delta("read_http_headers");
@@ -3237,7 +3230,7 @@ define One @@ -3237,7 +3230,7 @@ define One
3237 success(target) then 3230 success(target) then
3238 3231
3239 //get the content of the current buffer and unput char list 3232 //get the content of the current buffer and unput char list
3240 - with buffer = get_and_erase_buffer(connection, s), 3233 + with buffer = get_and_erase_buffer(connection),
3241 buffer_size = length(buffer), 3234 buffer_size = length(buffer),
3242 //println("buffer Size = "+buffer_size); 3235 //println("buffer Size = "+buffer_size);
3243 //println("Old body size "+body_size+" New body size request = "+body_size - buffer_size); 3236 //println("Old body size "+body_size+" New body size request = "+body_size - buffer_size);
@@ -3295,8 +3288,8 @@ define Server -&gt; ((RWStream) -&gt; One) @@ -3295,8 +3288,8 @@ define Server -&gt; ((RWStream) -&gt; One)
3295 if is_dubious_IP(addr,dos) 3288 if is_dubious_IP(addr,dos)
3296 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n") 3289 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
3297 else 3290 else
3298 - with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),  
3299 - http_https_handler(sites, connection, false, dos, sstate(var([]),var(0),var(0))). 3291 + with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
  3292 + http_https_handler(sites, connection, false, dos, sstate(var(0),var(0))).
3300 public define One 3293 public define One
3301 http_direct_handler 3294 http_direct_handler
3302 ( 3295 (
@@ -3308,8 +3301,8 @@ public define One @@ -3308,8 +3301,8 @@ public define One
3308 if is_dubious_IP(addr,dos) 3301 if is_dubious_IP(addr,dos)
3309 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n") 3302 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
3310 else 3303 else
3311 - with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),  
3312 - http_https_handler(sites, connection, false, dos, sstate(var([]),var(0),var(0))). 3304 + with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
  3305 + http_https_handler(sites, connection, false, dos, sstate(var(0),var(0))).
3313 3306
3314 3307
3315 define Server -> (SSL_Connection -> One) 3308 define Server -> (SSL_Connection -> One)
@@ -3319,8 +3312,8 @@ define Server -&gt; (SSL_Connection -&gt; One) @@ -3319,8 +3312,8 @@ define Server -&gt; (SSL_Connection -&gt; One)
3319 DenialOfService dos 3312 DenialOfService dos
3320 ) = 3313 ) =
3321 (Server server) |-> (SSL_Connection conn) |-> 3314 (Server server) |-> (SSL_Connection conn) |->
3322 - with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),  
3323 - http_https_handler(sites, connection, true, dos, sstate(var([]),var(0),var(0))). 3315 + with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0), var([])),
  3316 + http_https_handler(sites, connection, true, dos, sstate(var(0),var(0))).
3324 3317
3325 3318
3326 3319
@@ -3712,12 +3705,12 @@ define Server -&gt; ((RWStream) -&gt; One) @@ -3712,12 +3705,12 @@ define Server -&gt; ((RWStream) -&gt; One)
3712 ) = 3705 ) =
3713 (Server server) |-> (RWStream conn) |-> 3706 (Server server) |-> (RWStream conn) |->
3714 with start_time = (Int)now, 3707 with start_time = (Int)now,
3715 - connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),  
3716 - if read_request_line(connection, start_time+*request_line_delay(dos), dos, ss) is 3708 + connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
  3709 + if read_request_line(connection) is
3717 { 3710 {
3718 error(msg) then print(format(msg)), 3711 error(msg) then print(format(msg)),
3719 ok(request_line) then 3712 ok(request_line) then
3720 - if read_http_headers(connection, start_time+*headers_delay(dos), dos, ss) is 3713 + if read_http_headers(connection) is
3721 { 3714 {
3722 error(msg) then print(format(msg)), 3715 error(msg) then print(format(msg)),
3723 ok(headers) then if get_host_header_value(headers) is 3716 ok(headers) then if get_host_header_value(headers) is
web/CXM_xml_rpc.anubis
  Show/Hide comments   View file @28dc8eb
1 -๏ปฟ/*  
2 - * Created by PyramIDE.  
3 - * User: Totoro  
4 - * Date: 29/06/2013  
5 - * Time: 00:47  
6 - *  
7 - * To change this template use Tools | Options | Coding | Edit Standard Headers.  
8 - */  
9 -  
10 -read tools/base64.anubis  
11 -read tools/basis.anubis  
12 -read tools/connections.anubis  
13 -read system/convert.anubis  
14 -read system/string.anubis  
15 -read web/CXM_common.anubis  
16 -read web/CXM_http_get_common.anubis  
17 -read web/CXM_xml_rpc_parser.anubis  
18 -read web/CXM_xml_rpc_types.anubis  
19 -  
20 -  
21 -define XML_RPC_parameters sysinfo_params =  
22 - parameters  
23 - [  
24 - parameter[int(1)],  
25 - parameter[bool(true)],  
26 - parameter[string("This is a string")],  
27 - parameter[double(1.45)],  
28 - parameter[datetime("date to do")],  
29 - parameter[base64("Base 64 content")],  
30 - parameter[struct(members([  
31 - member("1st member", int(2)),  
32 - member("2nd member", string("this is the 2nd string"))  
33 - ]))],  
34 - parameter[array(array([  
35 - int(3),  
36 - string("3rd string")  
37 - ]))]  
38 - ].  
39 -  
40 -define XML_RPC_parameters empty_param = parameters [].  
41 -  
42 -public type XML_RPC_Result:  
43 - cannot_resolve_server_name(DNS_Result),  
44 - cannot_connect_to_server(NetworkConnectError),  
45 - transmission_problem,  
46 - request_refused_by_server,  
47 - ok(String response, // HTTP response line from the server  
48 - List(HTTP_header) headers, // HTTP headers received from the server  
49 - String document). // The HTML document itself  
50 -  
51 -public type XML_RPC_Auth:  
52 - none,  
53 - basic(String login, String password).  
54 -  
55 -public type XML_RPC_client:  
56 - xml_rpc_client(  
57 - Connection conn,  
58 - XML_RPC_Auth auth,  
59 - String url,  
60 - String user_agent,  
61 - String host).  
62 -  
63 -define String  
64 - tab  
65 - (  
66 - Int position  
67 - )=  
68 - to_string(constant_byte_array(position * 2, ' ')).  
69 -  
70 -define String format_struct(XML_RPC_struct structure, Int position).  
71 -define String format_array(XML_RPC_array array, Int position).  
72 -  
73 -define String format_int_value ( Word32 value) = "<value><i4>"+to_String(value)+"</i4></value>" + crlf.  
74 -define String format_boolean_value ( Bool value) = "<value><boolean>"+to_String_value(value)+"</boolean></value>" + crlf.  
75 -define String format_string_value ( String value) = "<value><string>"+value+"</string></value>" + crlf.  
76 -define String format_double_value ( Float value) = "<value><double>"+float_to_string(value, 10)+"</double></value>" + crlf.  
77 -define String format_datetime_value ( String value) = "<value><dateTime.iso8601>"+value+"</dateTime.iso8601></value>" + crlf.  
78 -define String format_base64_value ( String value) = "<value><base64>"+value+"</base64></value>" + crlf.  
79 -  
80 -define String  
81 - format_value  
82 - (  
83 - XML_RPC_value rpc_value,  
84 - Int position  
85 - )=  
86 - with return = if rpc_value is  
87 - {  
88 - int(value) then format_int_value(value),  
89 - bool(value) then format_boolean_value(value),  
90 - string(value) then format_string_value(value),  
91 - double(value) then format_double_value(value),  
92 - datetime(value) then format_datetime_value(value),  
93 - base64(value) then format_base64_value(value),  
94 - struct(value) then format_struct(value, position + 1),  
95 - array(value) then format_array(value, position + 1)  
96 - },  
97 - tab(position) + return.  
98 -  
99 -  
100 -define String  
101 - _format_struct  
102 - (  
103 - String so_far,  
104 - List(XML_RPC_struct_member) members,  
105 - Int position  
106 - )=  
107 - if members is  
108 - {  
109 - [] then so_far,  
110 - [h . t] then  
111 - if h is member(name, val) then  
112 - _format_struct( so_far + tab(position) + "<member>" + crlf +  
113 - tab(position + 1)+"<name>"+name+"</name>" + crlf +  
114 - format_value(val, position + 1) +  
115 - tab(position + 1) + "</member>" + crlf,  
116 - t,  
117 - position)  
118 - }.  
119 -  
120 -define String  
121 - format_struct  
122 - (  
123 - XML_RPC_struct struct,  
124 - Int position  
125 - ) =  
126 - if struct is members(structure_members) then  
127 - /*tab(position) +*/ "<struct>" + crlf +  
128 - _format_struct("", structure_members, position+1)+  
129 - tab(position + 1) + "</struct>" + crlf.  
130 -  
131 -define String  
132 - _format_array  
133 - (  
134 - String so_far,  
135 - List(XML_RPC_value) values,  
136 - Int position  
137 - )=  
138 - if values is  
139 - {  
140 - [] then so_far,  
141 - [h . t] then _format_array( so_far + format_value(h, position), t, position)  
142 - }.  
143 -  
144 -define String  
145 - format_array  
146 - (  
147 - XML_RPC_array arr,  
148 - Int position  
149 - )  
150 - =  
151 - if arr is array(values) then  
152 - /*tab(position) +*/ "<array>" + crlf +  
153 - tab(position + 1) + "<data>" + crlf+  
154 - _format_array("", values, position + 2)+  
155 - tab(position+2)+"</data>" + crlf +  
156 - tab(position + 1) + "</array>" + crlf.  
157 -  
158 -public define String  
159 - format_xml_rpc_values  
160 - (  
161 - List(XML_RPC_value) values,  
162 - Int position,  
163 - String so_far  
164 - )=  
165 - if values is  
166 - {  
167 - [] then so_far,  
168 - [ h . t ] then  
169 - format_xml_rpc_values(t, position, so_far + format_value(h, position))  
170 - }.  
171 -  
172 -public define String  
173 - format_xml_rpc_parameter  
174 - (  
175 - XML_RPC_parameter param,  
176 - Int position  
177 - )=  
178 - if param is parameter(values) then  
179 - format_xml_rpc_values(values, position, "")  
180 - .  
181 -  
182 -  
183 -define String  
184 - _format_xml_rpc_parameters  
185 - (  
186 - String so_far,  
187 - List(XML_RPC_parameter) params,  
188 - Int position  
189 - )=  
190 - if params is  
191 - {  
192 - [] then so_far,  
193 - [ h . t ] then  
194 - _format_xml_rpc_parameters( so_far + tab(position) + "<param>" + crlf +  
195 - format_xml_rpc_parameter(h, position + 1) +  
196 - tab(position+1) + "</param>" + crlf,  
197 - t,  
198 - position)  
199 - }.  
200 -  
201 -public define String  
202 - format_xml_rpc_parameters  
203 - (  
204 - XML_RPC_parameters params,  
205 - Int position  
206 - )=  
207 - if params is parameters(list_param) then  
208 - tab(position)+"<params>" + crlf +  
209 - _format_xml_rpc_parameters("", list_param, position+1) +  
210 - tab(position+1)+"</params>".  
211 -  
212 -public define String  
213 - format_xml_rpc_fault  
214 - (  
215 - XML_RPC_value value,  
216 - Int position  
217 - )=  
218 - tab(position)+"<fault>" + crlf +  
219 - format_value(value, position+1) +  
220 - tab(position+1)+"</fault>".  
221 -  
222 -public define Bool  
223 - accept_policy  
224 - (  
225 - Maybe(X509) suspect_certificate  
226 - ) = true.  
227 -  
228 -public define Maybe(XML_RPC_client)  
229 - xml_rpc_new_client  
230 - (  
231 - String server_name,  
232 - Bool use_ssl,  
233 - XML_RPC_Auth auth,  
234 - String user_agent,  
235 - String host  
236 - )=  
237 - if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then  
238 - //  
239 - // resolve server name and call 'https_get' with numeric server address:  
240 - //  
241 - with a = dns(name),  
242 - if a is ok(server_addr) then  
243 - //connect to server with right protocol  
244 - if use_ssl then  
245 - println("SSL "+server_port+ " "+server_name);  
246 - if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is  
247 - {  
248 - error(msg) then failure,  
249 - ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host))  
250 - }  
251 - else  
252 - println("TCP "+server_port+ " "+server_name);  
253 - if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is  
254 - {  
255 - error(e) then failure,  
256 - ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host))  
257 - }  
258 - else  
259 - failure.  
260 -  
261 -define Maybe(XML_RPC_response)  
262 - receive  
263 - (  
264 - Bool print_dump,  
265 - Connection conn  
266 - )=  
267 - //TODO find the header and content-lenght to get full length of answer  
268 -  
269 - if read(conn, 16384, 5) is  
270 - {  
271 - error then println("Read error");failure,  
272 - timeout then println("Read timeout");failure,  
273 - ok(ba) then  
274 - with xml_response = to_string(ba),  
275 - typed_response = xml_rpc_get_response(xml_response),  
276 - (if print_dump then  
277 -  
278 - println("=== Server answer ==="+crlf + xml_response );  
279 - println("=== XML_RPC Anubis interpretation ===");  
280 -  
281 - if typed_response is  
282 - {  
283 - failure then println("Interpretation error"),  
284 - success(result) then  
285 - if result is  
286 - {  
287 - ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)),  
288 - fault(fault) then println(format_xml_rpc_fault(fault,1))  
289 - }  
290 -  
291 - }  
292 - else unique);  
293 - typed_response  
294 - }  
295 - .  
296 -  
297 -public define Maybe(XML_RPC_response)  
298 - xml_rpc_client_execute  
299 - (  
300 - Bool print_dump,  
301 - XML_RPC_client client,  
302 - String url,  
303 - String method_name,  
304 - XML_RPC_parameters params  
305 - //(XML-string)->$T answer_handler //convert the xml answer to anubis type  
306 - )=  
307 - if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then  
308 - //execute the method on remote server  
309 - // - 1 - Format the xml body to comply with XML RPC  
310 - with body = "<?xml version=\"1.0\"?>" + crlf +  
311 - tab(1)+"<methodCall>" + crlf +  
312 - tab(2)+"<methodName>" + method_name +"</methodName>" + crlf +  
313 - format_xml_rpc_parameters(params, 2) +  
314 - tab(1)+"</methodCall>",  
315 -  
316 - // - 2 - Format the POST HTTP request  
317 - with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute  
318 - "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1)  
319 - "Host: " + server_name + crlf +  
320 - "Content-type: text/xml" + crlf +  
321 - if auth is  
322 - {  
323 - none then "",  
324 - basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf  
325 - }+  
326 - "Content-length: " + length(body)+ crlf +  
327 -  
328 - //format_headers(headers) +  
329 - crlf +  
330 - body,  
331 -  
332 - // - 3 - send it to remote  
333 -  
334 - //  
335 - // Send the HTTP request, and receive the answer:  
336 - //  
337 - (if print_dump then  
338 - (  
339 - print("----- request ----\n");  
340 - print(request);  
341 - print("\n")  
342 - ) else unique);  
343 -  
344 - if write(conn, to_byte_array(request)) is  
345 - {  
346 - failure then failure,  
347 - success(_) then receive(print_dump, conn)  
348 - }.  
349 -  
350 - //wait the answer  
351 -  
352 -  
353 -global define One  
354 - xml_rpc_test  
355 - (  
356 - List(String) args  
357 - )=  
358 - if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is  
359 - {  
360 - failure then println(" xml_rpc_test new client failure"),  
361 - success(rpc_client) then  
362 - forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "list_domains", empty_param))  
363 - //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]])))  
364 - //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param))  
365 - }.  
366 - 1 +๏ปฟ/*
  2 + * Created by PyramIDE.
  3 + * User: Totoro
  4 + * Date: 29/06/2013
  5 + * Time: 00:47
  6 + *
  7 + */
  8 +
  9 +read tools/base64.anubis
  10 +transmit tools/basis.anubis
  11 +read tools/connections.anubis
  12 +read system/convert.anubis
  13 +transmit system/string.anubis
  14 +read calexium_lib/web/CXM_common.anubis
  15 +read calexium_lib/web/CXM_http_get_common.anubis
  16 +read calexium_lib/web/CXM_multihost_http_server.anubis
  17 +transmit calexium_lib/web/CXM_xml_rpc_parser.anubis
  18 +transmit calexium_lib/web/CXM_xml_rpc_types.anubis
  19 +
  20 +
  21 +define XML_RPC_parameters sysinfo_params =
  22 + parameters
  23 + [
  24 + parameter[int(1)],
  25 + parameter[bool(true)],
  26 + parameter[string("This is a string")],
  27 + parameter[double(1.45)],
  28 + parameter[datetime("date to do")],
  29 + parameter[base64("Base 64 content")],
  30 + parameter[struct(members([
  31 + member("1st member", int(2)),
  32 + member("2nd member", string("this is the 2nd string"))
  33 + ]))],
  34 + parameter[array(array([
  35 + int(3),
  36 + string("3rd string")
  37 + ]))]
  38 + ].
  39 +
  40 +define XML_RPC_parameters empty_param = parameters [].
  41 +
  42 +public type XML_RPC_Result:
  43 + cannot_resolve_server_name(DNS_Result),
  44 + cannot_connect_to_server(NetworkConnectError),
  45 + transmission_problem,
  46 + request_refused_by_server,
  47 + ok(String response, // HTTP response line from the server
  48 + List(HTTP_header) headers, // HTTP headers received from the server
  49 + String document). // The HTML document itself
  50 +
  51 +public type XML_RPC_Auth:
  52 + none,
  53 + basic(String login, String password).
  54 +
  55 +public type XML_RPC_client:
  56 + xml_rpc_client(
  57 + Connection conn,
  58 + XML_RPC_Auth auth,
  59 + String url,
  60 + String user_agent,
  61 + String host).
  62 +
  63 +define String
  64 + tab
  65 + (
  66 + Int position
  67 + )=
  68 + to_string(constant_byte_array(position * 2, ' ')).
  69 +
  70 +define String format_struct(XML_RPC_struct structure, Int position).
  71 +define String format_array(XML_RPC_array array, Int position).
  72 +
  73 +define String format_int_value ( Word32 value) = "<value><i4>"+to_String(value)+"</i4></value>" + crlf.
  74 +define String format_boolean_value ( Bool value) = "<value><boolean>"+to_String_value(value)+"</boolean></value>" + crlf.
  75 +define String format_string_value ( String value) = "<value><string>"+value+"</string></value>" + crlf.
  76 +define String format_double_value ( Float value) = "<value><double>"+float_to_string(value, 10)+"</double></value>" + crlf.
  77 +define String format_datetime_value ( String value) = "<value><dateTime.iso8601>"+value+"</dateTime.iso8601></value>" + crlf.
  78 +define String format_base64_value ( String value) = "<value><base64>"+value+"</base64></value>" + crlf.
  79 +
  80 +define String
  81 + format_value
  82 + (
  83 + XML_RPC_value rpc_value,
  84 + Int position
  85 + )=
  86 + with return = if rpc_value is
  87 + {
  88 + int(value) then format_int_value(value),
  89 + bool(value) then format_boolean_value(value),
  90 + string(value) then format_string_value(value),
  91 + double(value) then format_double_value(value),
  92 + datetime(value) then format_datetime_value(value),
  93 + base64(value) then format_base64_value(value),
  94 + struct(value) then format_struct(value, position + 1),
  95 + array(value) then format_array(value, position + 1)
  96 + },
  97 + tab(position) + return.
  98 +
  99 +
  100 +define String
  101 + _format_struct
  102 + (
  103 + String so_far,
  104 + List(XML_RPC_struct_member) members,
  105 + Int position
  106 + )=
  107 + if members is
  108 + {
  109 + [] then so_far,
  110 + [h . t] then
  111 + if h is member(name, val) then
  112 + _format_struct( so_far + tab(position) + "<member>" + crlf +
  113 + tab(position + 1)+"<name>"+name+"</name>" + crlf +
  114 + format_value(val, position + 1) +
  115 + tab(position + 1) + "</member>" + crlf,
  116 + t,
  117 + position)
  118 + }.
  119 +
  120 +define String
  121 + format_struct
  122 + (
  123 + XML_RPC_struct struct,
  124 + Int position
  125 + ) =
  126 + if struct is members(structure_members) then
  127 + /*tab(position) +*/ "<struct>" + crlf +
  128 + _format_struct("", structure_members, position+1)+
  129 + tab(position + 1) + "</struct>" + crlf.
  130 +
  131 +define String
  132 + _format_array
  133 + (
  134 + String so_far,
  135 + List(XML_RPC_value) values,
  136 + Int position
  137 + )=
  138 + if values is
  139 + {
  140 + [] then so_far,
  141 + [h . t] then _format_array( so_far + format_value(h, position), t, position)
  142 + }.
  143 +
  144 +define String
  145 + format_array
  146 + (
  147 + XML_RPC_array arr,
  148 + Int position
  149 + )
  150 + =
  151 + if arr is array(values) then
  152 + /*tab(position) +*/ "<array>" + crlf +
  153 + tab(position + 1) + "<data>" + crlf+
  154 + _format_array("", values, position + 2)+
  155 + tab(position+2)+"</data>" + crlf +
  156 + tab(position + 1) + "</array>" + crlf.
  157 +
  158 +public define String
  159 + format_xml_rpc_values
  160 + (
  161 + List(XML_RPC_value) values,
  162 + Int position,
  163 + String so_far
  164 + )=
  165 + if values is
  166 + {
  167 + [] then so_far,
  168 + [ h . t ] then
  169 + format_xml_rpc_values(t, position, so_far + format_value(h, position))
  170 + }.
  171 +
  172 +public define String
  173 + format_xml_rpc_parameter
  174 + (
  175 + XML_RPC_parameter param,
  176 + Int position
  177 + )=
  178 + if param is parameter(values) then
  179 + format_xml_rpc_values(values, position, "")
  180 + .
  181 +
  182 +
  183 +define String
  184 + _format_xml_rpc_parameters
  185 + (
  186 + String so_far,
  187 + List(XML_RPC_parameter) params,
  188 + Int position
  189 + )=
  190 + if params is
  191 + {
  192 + [] then so_far,
  193 + [ h . t ] then
  194 + _format_xml_rpc_parameters( so_far + tab(position) + "<param>" + crlf +
  195 + format_xml_rpc_parameter(h, position + 1) +
  196 + tab(position+1) + "</param>" + crlf,
  197 + t,
  198 + position)
  199 + }.
  200 +
  201 +public define String
  202 + format_xml_rpc_parameters
  203 + (
  204 + XML_RPC_parameters params,
  205 + Int position
  206 + )=
  207 + if params is parameters(list_param) then
  208 + tab(position)+"<params>" + crlf +
  209 + _format_xml_rpc_parameters("", list_param, position+1) +
  210 + tab(position+1)+"</params>".
  211 +
  212 +public define String
  213 + format_xml_rpc_fault
  214 + (
  215 + XML_RPC_value value,
  216 + Int position
  217 + )=
  218 + tab(position)+"<fault>" + crlf +
  219 + format_value(value, position+1) +
  220 + tab(position+1)+"</fault>".
  221 +
  222 +public define Bool
  223 + accept_policy
  224 + (
  225 + Maybe(X509) suspect_certificate
  226 + ) = true.
  227 +
  228 +public define Maybe(XML_RPC_client)
  229 + xml_rpc_new_client
  230 + (
  231 + String server_name,
  232 + Bool use_ssl,
  233 + XML_RPC_Auth auth,
  234 + String user_agent,
  235 + String host
  236 + )=
  237 + if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then
  238 + //
  239 + // resolve server name and call 'https_get' with numeric server address:
  240 + //
  241 + with a = dns(name),
  242 + if a is ok(server_addr) then
  243 + //connect to server with right protocol
  244 + if use_ssl then
  245 + println("SSL "+server_port+ " "+server_name);
  246 + if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is
  247 + {
  248 + error(msg) then failure,
  249 + ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host))
  250 + }
  251 + else
  252 + println("TCP "+server_port+ " "+server_name);
  253 + if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is
  254 + {
  255 + error(e) then failure,
  256 + ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host))
  257 + }
  258 + else
  259 + failure.
  260 +define Maybe(XML_RPC_response)
  261 + receive
  262 + (
  263 + Bool print_dump,
  264 + Connection conn
  265 + )=
  266 + //TODO find the header and content-lenght to get full length of answer
  267 +
  268 + if read(conn, 16384, 5) is
  269 + {
  270 + error then println("Read error");failure,
  271 + timeout then println("Read timeout");failure,
  272 + ok(ba) then
  273 + with xml_response = to_string(ba),
  274 + typed_response = xml_rpc_get_response(xml_response),
  275 + (if print_dump then
  276 +
  277 + println("=== Server answer ==="+crlf + xml_response );
  278 + println("=== XML_RPC Anubis interpretation ===");
  279 +
  280 + if typed_response is
  281 + {
  282 + failure then println("Interpretation error"),
  283 + success(result) then
  284 + if result is
  285 + {
  286 + ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)),
  287 + fault(fault) then println(format_xml_rpc_fault(fault,1))
  288 + }
  289 +
  290 + }
  291 + else unique);
  292 + typed_response
  293 + }
  294 + .
  295 +
  296 +define Maybe(XML_RPC_response)
  297 + receive_new
  298 + (
  299 + Bool print_dump,
  300 + Connection conn
  301 + )=
  302 + //TODO find the header and content-lenght to get full length of answer
  303 + //construct a buffered connection
  304 + with b_con = buffered_connection(conn),
  305 + if skip_line(b_con) is
  306 + {
  307 + error(msg) then print(format(msg));failure,
  308 + ok(_) then
  309 + if read_http_headers(b_con) is
  310 + {
  311 + error(msg) then print(format(msg));failure,
  312 + ok(headers) then
  313 + if get_body_size(headers) is
  314 + {
  315 + error(msg) then print(format(msg));failure,
  316 + ok(body_size) then
  317 + if read_http_body(b_con, body_size, constant_byte_array(0,0), 1000) is
  318 + {
  319 + error(msg) then print(format(msg));failure,
  320 + ok(body) then
  321 + with xml_response = to_string(body),
  322 + with typed_response = xml_rpc_get_response(xml_response),
  323 + (if print_dump then
  324 +
  325 + println("=== Server answer ==="+crlf + xml_response);
  326 + println("=== XML_RPC Anubis interpretation ===");
  327 +
  328 + if typed_response is
  329 + {
  330 + failure then println("Interpretation error"),
  331 + success(result) then
  332 + if result is
  333 + {
  334 + ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)),
  335 + fault(fault) then println(format_xml_rpc_fault(fault,1))
  336 + }
  337 +
  338 + }
  339 + else unique);
  340 + typed_response
  341 + }
  342 + }
  343 + }}
  344 + .
  345 +
  346 +public define Maybe(XML_RPC_response)
  347 + xml_rpc_client_execute
  348 + (
  349 + Bool print_dump,
  350 + XML_RPC_client client,
  351 + String url,
  352 + String method_name,
  353 + XML_RPC_parameters params
  354 + //(XML-string)->$T answer_handler //convert the xml answer to anubis type
  355 + )=
  356 + if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then
  357 + //execute the method on remote server
  358 + // - 1 - Format the xml body to comply with XML RPC
  359 + with body = "<?xml version=\"1.0\"?>" + crlf +
  360 + tab(1)+"<methodCall>" + crlf +
  361 + tab(2)+"<methodName>" + method_name +"</methodName>" + crlf +
  362 + format_xml_rpc_parameters(params, 2) +
  363 + tab(1)+"</methodCall>",
  364 +
  365 + // - 2 - Format the POST HTTP request
  366 + with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute
  367 + "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1)
  368 + "Host: " + server_name + crlf +
  369 + "Content-type: text/xml" + crlf +
  370 + if auth is
  371 + {
  372 + none then "",
  373 + basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf
  374 + }+
  375 + "Content-length: " + length(body)+ crlf +
  376 +
  377 + //format_headers(headers) +
  378 + crlf +
  379 + body,
  380 +
  381 + // - 3 - send it to remote
  382 +
  383 + //
  384 + // Send the HTTP request, and receive the answer:
  385 + //
  386 + (if print_dump then
  387 + (
  388 + print("----- request ----\n");
  389 + print(request);
  390 + print("\n")
  391 + ) else unique);
  392 +
  393 + if write(conn, to_byte_array(request)) is
  394 + {
  395 + failure then failure,
  396 + success(_) then receive_new(print_dump, conn)
  397 + }.
  398 +
  399 + //wait the answer
  400 +
  401 +
  402 +global define One
  403 + xml_rpc_test
  404 + (
  405 + List(String) args
  406 + )=
  407 + if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is
  408 + {
  409 + failure then println(" xml_rpc_test new client failure"),
  410 + success(rpc_client) then
  411 + forget(xml_rpc_client_execute(false, rpc_client, "/Settings", "list_domains", empty_param))
  412 + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]])))
  413 + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param))
  414 + }.
  415 +
web/CXM_xml_rpc_parser.anubis
  Show/Hide comments   View file @28dc8eb
1 -๏ปฟ/*  
2 - * Created by PyramIDE.  
3 - * User: Totoro  
4 - * Date: 06/07/2013  
5 - * Time: 01:13  
6 - *  
7 - * To change this template use Tools | Options | Coding | Edit Standard Headers.  
8 - */  
9 -  
10 -read web/CXM_xml_rpc_types.anubis  
11 -read tools/streams.anubis  
12 -read tools/basis.anubis  
13 -read system/string.anubis  
14 -read system/convert.anubis  
15 -  
16 -type XML_RPC_Token:  
17 - none,  
18 - token(String token).  
19 -  
20 -define Maybe(XML_RPC_value) read_value(Stream stream).  
21 -  
22 -define XML_RPC_Token  
23 - _next_xml_token  
24 - (  
25 - Stream stream,  
26 - List(Word8) so_far,  
27 - Bool in_token  
28 - )=  
29 - if read_byte(stream) is  
30 - {  
31 - failure then none, //can't read on stream !!  
32 - success(b) then  
33 - //println("["+implode([b])+"]");  
34 - if in_token then  
35 - if b = '>' then //just found the end of bracket, so we return the token in LOWER case  
36 - with tok = to_lower(implode(reverse(so_far))),  
37 - //println("found tag "+tok);  
38 - token(tok)  
39 - else  
40 - _next_xml_token(stream, [b . so_far], in_token)  
41 - else  
42 - if b = '<' then //just found the begin of token  
43 - _next_xml_token(stream, [], true)  
44 - else  
45 - _next_xml_token(stream, so_far, in_token)  
46 - }  
47 - .  
48 -  
49 -  
50 -  
51 -define XML_RPC_Token  
52 - next_xml_token  
53 - (  
54 - Stream stream  
55 - )= _next_xml_token(stream, [], false).  
56 -  
57 -define Maybe(String)  
58 - _xml_tag_content  
59 - (  
60 - Stream stream,  
61 - String tag, //tag to match  
62 - List(Word8) so_far,  
63 - List(Word8) content,  
64 - Bool in_first_token,  
65 - Bool in_content,  
66 - Bool in_last_token  
67 -  
68 - )=  
69 - if read_byte(stream) is  
70 - {  
71 - failure then failure, //can't read on stream !!  
72 - success(b) then  
73 - if in_first_token then  
74 - if b = '>' then //just found the end of bracket, so we return the token in LOWER case  
75 - if to_lower(implode(reverse(so_far))) = tag then  
76 - _xml_tag_content(stream, tag, [], [], false, true, false)  
77 - else  
78 - failure  
79 - else  
80 - _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token)  
81 - else if in_content then  
82 - if b = '<' then //just found the begin bracket,  
83 - if read_byte(stream) is  
84 - {  
85 - failure then failure, //can't read on stream !!  
86 - success(b) then  
87 - if b = '/' then //can't find / => syntax error  
88 - _xml_tag_content(stream, tag, [], content, false, false, true)  
89 - else  
90 - failure  
91 - }  
92 - else  
93 - _xml_tag_content(stream, tag, [], [b . content], false, true, false)  
94 - else if in_last_token then  
95 - if b = '>' then //just found the end of bracket, so we return the token in LOWER case  
96 - if to_lower(implode(reverse(so_far))) = tag then  
97 - with content = implode(reverse(content)),  
98 - println("Tag ["+tag+"] content found ["+content+"]");  
99 - success(content)  
100 - else  
101 - failure  
102 - else  
103 - _xml_tag_content(stream, tag, [b . so_far], content, false, false, true)  
104 -  
105 - else  
106 - if b = '<' then //just found the begin of token  
107 - _xml_tag_content(stream, tag, [], [], true, false, false)  
108 - else  
109 - _xml_tag_content(stream, tag, [], [], false, false, false)  
110 - }  
111 - .  
112 -define Maybe(String)  
113 - xml_pair_tag_content  
114 - (  
115 - Stream stream,  
116 - String tag  
117 - )= _xml_tag_content( stream, tag, [], [], false, false, false).  
118 -  
119 -define Maybe(String)  
120 - xml_tag_content  
121 - (  
122 - Stream stream,  
123 - String tag  
124 - )= _xml_tag_content( stream, tag, [], [], false, true, false).  
125 -  
126 - /***** ARRAY functions ******/  
127 -  
128 -define Maybe(List(XML_RPC_value))  
129 - read_values  
130 - (  
131 - Stream stream,  
132 - List(XML_RPC_value) so_far  
133 - )=  
134 - if read_value(stream) is  
135 - {  
136 - failure then failure,  
137 - success(value) then  
138 - if next_xml_token(stream) is  
139 - {  
140 - none then failure,  
141 - token(token) then  
142 -  
143 - if token = "value" then //there is another value we read it  
144 - read_values(stream, [value . so_far])  
145 - else  
146 - unput_string("<"+token+">", stream);  
147 - success(reverse([value . so_far]))  
148 - }  
149 - }.  
150 -  
151 -define Maybe(List(XML_RPC_value))  
152 - read_data  
153 - (  
154 - Stream stream  
155 - )=  
156 - if next_xml_token(stream) is  
157 - {  
158 - none then failure,  
159 - token(token) then  
160 - if token = "data" then  
161 - if next_xml_token(stream) is  
162 - {  
163 - none then failure,  
164 - token(token) then  
165 - if token = "value" then  
166 - if read_values(stream, []) is  
167 - {  
168 - failure then failure  
169 - success(values) then  
170 - if next_xml_token(stream) is  
171 - {  
172 - none then failure,  
173 - token(token) then  
174 - if token = "/data" then  
175 - success(values)  
176 - else  
177 - failure  
178 - }  
179 - }  
180 - else  
181 - failure  
182 - }  
183 - else  
184 - failure  
185 - }.  
186 -  
187 -define Maybe(XML_RPC_value)  
188 - read_array  
189 - (  
190 - Stream stream  
191 - )=  
192 - if read_data(stream) is  
193 - {  
194 - failure then failure  
195 - success(values) then  
196 - if next_xml_token(stream) is  
197 - {  
198 - none then failure,  
199 - token(token) then  
200 - if token = "/array" then  
201 - success(array(array(values)))  
202 - else  
203 - failure  
204 - }  
205 - }.  
206 -  
207 - /***** STRUCT functions ******/  
208 -  
209 -define Maybe(List(XML_RPC_struct_member))  
210 - read_members  
211 - (  
212 - Stream stream,  
213 - List(XML_RPC_struct_member) so_far  
214 - )=  
215 - if xml_pair_tag_content(stream, "name") is  
216 - {  
217 - failure then failure,  
218 - success(member_name) then  
219 - if next_xml_token(stream) is  
220 - {  
221 - none then failure,  
222 - token(tok) then  
223 - if tok = "value" then  
224 - if read_value(stream) is  
225 - {  
226 - failure then failure,  
227 - success(value) then  
228 - if next_xml_token(stream) is  
229 - {  
230 - none then failure,  
231 - token(tok) then  
232 - if tok = "/member" then  
233 - if next_xml_token(stream) is  
234 - {  
235 - none then failure,  
236 - token(tok) then  
237 - if tok = "member" then //there is another member in structure, we read it  
238 - read_members(stream, [member(member_name, value) . so_far])  
239 - else if tok = "/struct" then //End of structrue found  
240 - println("End struct");  
241 - success(reverse([member(member_name, value) . so_far])) //return all members in right order  
242 - else  
243 - failure //unexpected token  
244 - }  
245 - else  
246 - failure  
247 - }  
248 - }  
249 - else  
250 - failure  
251 - }  
252 - } .  
253 -  
254 -define Maybe(XML_RPC_value)  
255 - read_struct  
256 - (  
257 - Stream stream  
258 - )=  
259 - if next_xml_token(stream) is  
260 - {  
261 - none then failure,  
262 - token(token) then  
263 - if token = "member" then  
264 - if read_members(stream, []) is  
265 - {  
266 - failure then failure  
267 - success(members_list) then success(struct(members(members_list)))  
268 - }  
269 - else  
270 - failure  
271 - }.  
272 -  
273 -define Maybe(XML_RPC_value)  
274 - read_value  
275 - (  
276 - Stream stream  
277 - )=  
278 - if next_xml_token(stream) is  
279 - {  
280 - none then failure,  
281 - token(token) then  
282 - with value = if token = "string" then  
283 - if xml_tag_content(stream, "string") is  
284 - {  
285 - failure then failure,  
286 - success(v) then success(string(v))  
287 - }  
288 - else if token = "int" then  
289 - if xml_tag_content(stream, "int") is  
290 - {  
291 - failure then failure,  
292 - success(v) then  
293 - if decimal_scan(v) is  
294 - {  
295 - failure then failure,  
296 - success(int_v) then success(int(truncate_to_Word32(int_v)))  
297 - }  
298 - }  
299 - else if token = "i4" then  
300 - if xml_tag_content(stream, "i4") is  
301 - {  
302 - failure then failure,  
303 - success(v) then  
304 - if decimal_scan(v) is  
305 - {  
306 - failure then failure,  
307 - success(int_v) then success(int(truncate_to_Word32(int_v)))  
308 - }  
309 - }  
310 - else if token = "boolean" then  
311 - if xml_tag_content(stream, "boolean") is  
312 - {  
313 - failure then failure,  
314 - success(v) then success(bool(to_Bool(v)))  
315 - }  
316 - else if token = "double" then  
317 - if xml_tag_content(stream, "string") is  
318 - {  
319 - failure then failure,  
320 - success(v) then success(double(0.0))  
321 - }  
322 - else if token = "datetime" then  
323 - if xml_tag_content(stream, "string") is  
324 - {  
325 - failure then failure,  
326 - success(v) then success(datetime(v))  
327 - }  
328 - else if token = "base64" then  
329 - if xml_tag_content(stream, "base64") is  
330 - {  
331 - failure then failure,  
332 - success(b64) then success(base64(b64))  
333 - }  
334 - else if token = "struct" then read_struct(stream)  
335 - else if token = "array" then read_array(stream)  
336 - else  
337 - failure,  
338 - if next_xml_token(stream) is  
339 - {  
340 - none then failure  
341 - token(token) then  
342 - if token = "/value" then  
343 - value  
344 - else  
345 - failure  
346 - }  
347 - }.  
348 -  
349 -define Maybe(XML_RPC_parameter)  
350 - in_value  
351 - (  
352 - Stream stream,  
353 - List(XML_RPC_value) so_far  
354 - )=  
355 - if next_xml_token(stream) is  
356 - {  
357 - none then failure,  
358 - token(tok) then  
359 - if tok = "value" then  
360 - if read_value(stream) is  
361 - {  
362 - failure then failure,  
363 - success(value) then in_value(stream, [ value. so_far])  
364 - }  
365 - else if tok = "/param" then  
366 - success(parameter(reverse(so_far)))  
367 - else  
368 - failure  
369 - }.  
370 -  
371 -define Maybe(XML_RPC_value)  
372 - in_fault  
373 - (  
374 - Stream stream,  
375 - )=  
376 - if next_xml_token(stream) is  
377 - {  
378 - none then failure,  
379 - token(tok) then  
380 - if tok = "value" then  
381 - if read_value(stream) is  
382 - {  
383 - failure then failure,  
384 - success(value) then  
385 - if next_xml_token(stream) is  
386 - {  
387 - none then failure,  
388 - token(tok) then  
389 - if tok = "/fault" then  
390 - success(value)  
391 - else  
392 - failure  
393 - }  
394 - }  
395 - else  
396 - failure  
397 - }.  
398 -  
399 -define Maybe(XML_RPC_parameters)  
400 - in_param  
401 - (  
402 - Stream stream,  
403 - List(XML_RPC_parameter) so_far  
404 - )=  
405 - if next_xml_token(stream) is  
406 - {  
407 - none then failure,  
408 - token(tok) then  
409 - if tok = "param" then  
410 - if in_value(stream, []) is  
411 - {  
412 - failure then failure,  
413 - success(param) then in_param(stream, [ param . so_far])  
414 - }  
415 -  
416 - else if tok = "/params" then  
417 - success(parameters(reverse(so_far)))  
418 - else  
419 - failure  
420 - }  
421 - .  
422 -  
423 -define Maybe(XML_RPC_response)  
424 - in_params  
425 - (  
426 - Stream stream  
427 - )=  
428 - if next_xml_token(stream) is  
429 - {  
430 - none then failure,  
431 - token(tok) then  
432 - if tok = "params" then  
433 - if in_param(stream, []) is  
434 - {  
435 - failure then failure,  
436 - success(resp) then success(ok(resp))  
437 - }  
438 - else if tok = "fault" then  
439 - if in_fault(stream) is  
440 - {  
441 - failure then failure,  
442 - success(resp) then success(fault(resp))  
443 - }  
444 - else  
445 - failure  
446 - }  
447 -  
448 - .  
449 -  
450 -public define Maybe(XML_RPC_response)  
451 - xml_rpc_get_response  
452 - (  
453 - String response  
454 - )=  
455 - with stream = make_stream(response),  
456 - if next_xml_token(stream) is  
457 - {  
458 - none then failure  
459 - token(tok) then  
460 - if tok = "?xml version='1.0'?" then  
461 - if next_xml_token(stream) is  
462 - {  
463 - none then failure  
464 - token(tok) then  
465 - if tok = "methodresponse" then  
466 - in_params(stream)  
467 - else  
468 - failure  
469 - }  
470 - else  
471 - failure  
472 - }. 1 +๏ปฟ/*
  2 + * Created by PyramIDE.
  3 + * User: Totoro
  4 + * Date: 06/07/2013
  5 + * Time: 01:13
  6 + *
  7 + */
  8 +
  9 +read calexium_lib/web/CXM_xml_rpc_types.anubis
  10 +read tools/streams.anubis
  11 +read tools/basis.anubis
  12 +read system/string.anubis
  13 +read system/convert.anubis
  14 +
  15 +type XML_RPC_Token:
  16 + none,
  17 + token(String token).
  18 +
  19 +define Maybe(XML_RPC_value) read_value(Stream stream).
  20 +
  21 +define XML_RPC_Token
  22 + _next_xml_token
  23 + (
  24 + Stream stream,
  25 + List(Word8) so_far,
  26 + Bool in_token
  27 + )=
  28 + if read_byte(stream) is
  29 + {
  30 + failure then none, //can't read on stream !!
  31 + success(b) then
  32 + //println("["+implode([b])+"]");
  33 + if in_token then
  34 + if b = '>' then //just found the end of bracket, so we return the token in LOWER case
  35 + with tok = to_lower(implode(reverse(so_far))),
  36 + //println("found tag "+tok);
  37 + token(tok)
  38 + else
  39 + _next_xml_token(stream, [b . so_far], in_token)
  40 + else
  41 + if b = '<' then //just found the begin of token
  42 + _next_xml_token(stream, [], true)
  43 + else
  44 + _next_xml_token(stream, so_far, in_token)
  45 + }
  46 + .
  47 +
  48 +
  49 +
  50 +define XML_RPC_Token
  51 + next_xml_token
  52 + (
  53 + Stream stream
  54 + )= _next_xml_token(stream, [], false).
  55 +
  56 +define Maybe(String)
  57 + _xml_tag_content
  58 + (
  59 + Stream stream,
  60 + String tag, //tag to match
  61 + List(Word8) so_far,
  62 + List(Word8) content,
  63 + Bool in_first_token,
  64 + Bool in_content,
  65 + Bool in_last_token
  66 +
  67 + )=
  68 + if read_byte(stream) is
  69 + {
  70 + failure then failure, //can't read on stream !!
  71 + success(b) then
  72 + if in_first_token then
  73 + if b = '>' then //just found the end of bracket, so we return the token in LOWER case
  74 + if to_lower(implode(reverse(so_far))) = tag then
  75 + _xml_tag_content(stream, tag, [], [], false, true, false)
  76 + else
  77 + failure
  78 + else
  79 + _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token)
  80 + else if in_content then
  81 + if b = '<' then //just found the begin bracket,
  82 + if read_byte(stream) is
  83 + {
  84 + failure then failure, //can't read on stream !!
  85 + success(b) then
  86 + if b = '/' then //can't find / => syntax error
  87 + _xml_tag_content(stream, tag, [], content, false, false, true)
  88 + else
  89 + failure
  90 + }
  91 + else
  92 + _xml_tag_content(stream, tag, [], [b . content], false, true, false)
  93 + else if in_last_token then
  94 + if b = '>' then //just found the end of bracket, so we return the token in LOWER case
  95 + if to_lower(implode(reverse(so_far))) = tag then
  96 + with content = implode(reverse(content)),
  97 + println("Tag ["+tag+"] content found ["+content+"]");
  98 + success(content)
  99 + else
  100 + failure
  101 + else
  102 + _xml_tag_content(stream, tag, [b . so_far], content, false, false, true)
  103 +
  104 + else
  105 + if b = '<' then //just found the begin of token
  106 + _xml_tag_content(stream, tag, [], [], true, false, false)
  107 + else
  108 + _xml_tag_content(stream, tag, [], [], false, false, false)
  109 + }
  110 + .
  111 +define Maybe(String)
  112 + xml_pair_tag_content
  113 + (
  114 + Stream stream,
  115 + String tag
  116 + )= _xml_tag_content( stream, tag, [], [], false, false, false).
  117 +
  118 +define Maybe(String)
  119 + xml_tag_content
  120 + (
  121 + Stream stream,
  122 + String tag
  123 + )= _xml_tag_content( stream, tag, [], [], false, true, false).
  124 +
  125 + /***** ARRAY functions ******/
  126 +
  127 +define Maybe(List(XML_RPC_value))
  128 + read_values
  129 + (
  130 + Stream stream,
  131 + List(XML_RPC_value) so_far
  132 + )=
  133 + if read_value(stream) is
  134 + {
  135 + failure then failure,
  136 + success(value) then
  137 + if next_xml_token(stream) is
  138 + {
  139 + none then failure,
  140 + token(token) then
  141 +
  142 + if token = "value" then //there is another value we read it
  143 + read_values(stream, [value . so_far])
  144 + else
  145 + unput_string("<"+token+">", stream);
  146 + success(reverse([value . so_far]))
  147 + }
  148 + }.
  149 +
  150 +define Maybe(List(XML_RPC_value))
  151 + read_data
  152 + (
  153 + Stream stream
  154 + )=
  155 + if next_xml_token(stream) is
  156 + {
  157 + none then failure,
  158 + token(token) then
  159 + if token = "data" then
  160 + if next_xml_token(stream) is
  161 + {
  162 + none then failure,
  163 + token(token) then
  164 + if token = "value" then
  165 + if read_values(stream, []) is
  166 + {
  167 + failure then failure
  168 + success(values) then
  169 + if next_xml_token(stream) is
  170 + {
  171 + none then failure,
  172 + token(token) then
  173 + if token = "/data" then
  174 + success(values)
  175 + else
  176 + failure
  177 + }
  178 + }
  179 + else
  180 + failure
  181 + }
  182 + else
  183 + failure
  184 + }.
  185 +
  186 +define Maybe(XML_RPC_value)
  187 + read_array
  188 + (
  189 + Stream stream
  190 + )=
  191 + if read_data(stream) is
  192 + {
  193 + failure then failure
  194 + success(values) then
  195 + if next_xml_token(stream) is
  196 + {
  197 + none then failure,
  198 + token(token) then
  199 + if token = "/array" then
  200 + success(array(array(values)))
  201 + else
  202 + failure
  203 + }
  204 + }.
  205 +
  206 + /***** STRUCT functions ******/
  207 +
  208 +define Maybe(List(XML_RPC_struct_member))
  209 + read_members
  210 + (
  211 + Stream stream,
  212 + List(XML_RPC_struct_member) so_far
  213 + )=
  214 + if xml_pair_tag_content(stream, "name") is
  215 + {
  216 + failure then failure,
  217 + success(member_name) then
  218 + if next_xml_token(stream) is
  219 + {
  220 + none then failure,
  221 + token(tok) then
  222 + if tok = "value" then
  223 + if read_value(stream) is
  224 + {
  225 + failure then failure,
  226 + success(value) then
  227 + if next_xml_token(stream) is
  228 + {
  229 + none then failure,
  230 + token(tok) then
  231 + if tok = "/member" then
  232 + if next_xml_token(stream) is
  233 + {
  234 + none then failure,
  235 + token(tok) then
  236 + if tok = "member" then //there is another member in structure, we read it
  237 + read_members(stream, [member(member_name, value) . so_far])
  238 + else if tok = "/struct" then //End of structrue found
  239 + println("End struct");
  240 + success(reverse([member(member_name, value) . so_far])) //return all members in right order
  241 + else
  242 + failure //unexpected token
  243 + }
  244 + else
  245 + failure
  246 + }
  247 + }
  248 + else
  249 + failure
  250 + }
  251 + } .
  252 +
  253 +define Maybe(XML_RPC_value)
  254 + read_struct
  255 + (
  256 + Stream stream
  257 + )=
  258 + if next_xml_token(stream) is
  259 + {
  260 + none then failure,
  261 + token(token) then
  262 + if token = "member" then
  263 + if read_members(stream, []) is
  264 + {
  265 + failure then failure
  266 + success(members_list) then success(struct(members(members_list)))
  267 + }
  268 + else
  269 + failure
  270 + }.
  271 +
  272 +define Maybe(XML_RPC_value)
  273 + read_value
  274 + (
  275 + Stream stream
  276 + )=
  277 + if next_xml_token(stream) is
  278 + {
  279 + none then failure,
  280 + token(token) then
  281 + with value = if token = "string" then
  282 + if xml_tag_content(stream, "string") is
  283 + {
  284 + failure then failure,
  285 + success(v) then success(string(v))
  286 + }
  287 + else if token = "int" then
  288 + if xml_tag_content(stream, "int") is
  289 + {
  290 + failure then failure,
  291 + success(v) then
  292 + if decimal_scan(v) is
  293 + {
  294 + failure then failure,
  295 + success(int_v) then success(int(truncate_to_Word32(int_v)))
  296 + }
  297 + }
  298 + else if token = "i4" then
  299 + if xml_tag_content(stream, "i4") is
  300 + {
  301 + failure then failure,
  302 + success(v) then
  303 + if decimal_scan(v) is
  304 + {
  305 + failure then failure,
  306 + success(int_v) then success(int(truncate_to_Word32(int_v)))
  307 + }
  308 + }
  309 + else if token = "boolean" then
  310 + if xml_tag_content(stream, "boolean") is
  311 + {
  312 + failure then failure,
  313 + success(v) then success(bool(to_Bool(v)))
  314 + }
  315 + else if token = "double" then
  316 + if xml_tag_content(stream, "string") is
  317 + {
  318 + failure then failure,
  319 + success(v) then success(double(0.0))
  320 + }
  321 + else if token = "datetime" then
  322 + if xml_tag_content(stream, "string") is
  323 + {
  324 + failure then failure,
  325 + success(v) then success(datetime(v))
  326 + }
  327 + else if token = "base64" then
  328 + if xml_tag_content(stream, "base64") is
  329 + {
  330 + failure then failure,
  331 + success(b64) then success(base64(b64))
  332 + }
  333 + else if token = "struct" then read_struct(stream)
  334 + else if token = "array" then read_array(stream)
  335 + else
  336 + failure,
  337 + if next_xml_token(stream) is
  338 + {
  339 + none then failure
  340 + token(token) then
  341 + if token = "/value" then
  342 + value
  343 + else
  344 + failure
  345 + }
  346 + }.
  347 +
  348 +define Maybe(XML_RPC_parameter)
  349 + in_value
  350 + (
  351 + Stream stream,
  352 + List(XML_RPC_value) so_far
  353 + )=
  354 + if next_xml_token(stream) is
  355 + {
  356 + none then failure,
  357 + token(tok) then
  358 + if tok = "value" then
  359 + if read_value(stream) is
  360 + {
  361 + failure then failure,
  362 + success(value) then in_value(stream, [ value. so_far])
  363 + }
  364 + else if tok = "/param" then
  365 + success(parameter(reverse(so_far)))
  366 + else
  367 + failure
  368 + }.
  369 +
  370 +define Maybe(XML_RPC_value)
  371 + in_fault
  372 + (
  373 + Stream stream,
  374 + )=
  375 + if next_xml_token(stream) is
  376 + {
  377 + none then failure,
  378 + token(tok) then
  379 + if tok = "value" then
  380 + if read_value(stream) is
  381 + {
  382 + failure then failure,
  383 + success(value) then
  384 + if next_xml_token(stream) is
  385 + {
  386 + none then failure,
  387 + token(tok) then
  388 + if tok = "/fault" then
  389 + success(value)
  390 + else
  391 + failure
  392 + }
  393 + }
  394 + else
  395 + failure
  396 + }.
  397 +
  398 +define Maybe(XML_RPC_parameters)
  399 + in_param
  400 + (
  401 + Stream stream,
  402 + List(XML_RPC_parameter) so_far
  403 + )=
  404 + if next_xml_token(stream) is
  405 + {
  406 + none then failure,
  407 + token(tok) then
  408 + if tok = "param" then
  409 + if in_value(stream, []) is
  410 + {
  411 + failure then failure,
  412 + success(param) then in_param(stream, [ param . so_far])
  413 + }
  414 +
  415 + else if tok = "/params" then
  416 + success(parameters(reverse(so_far)))
  417 + else
  418 + failure
  419 + }
  420 + .
  421 +
  422 +define Maybe(XML_RPC_response)
  423 + in_params
  424 + (
  425 + Stream stream
  426 + )=
  427 + if next_xml_token(stream) is
  428 + {
  429 + none then failure,
  430 + token(tok) then
  431 + if tok = "params" then
  432 + if in_param(stream, []) is
  433 + {
  434 + failure then failure,
  435 + success(resp) then success(ok(resp))
  436 + }
  437 + else if tok = "fault" then
  438 + if in_fault(stream) is
  439 + {
  440 + failure then failure,
  441 + success(resp) then success(fault(resp))
  442 + }
  443 + else
  444 + failure
  445 + }
  446 +
  447 + .
  448 +
  449 +public define Maybe(XML_RPC_response)
  450 + xml_rpc_get_response
  451 + (
  452 + String response
  453 + )=
  454 + with stream = make_stream(response),
  455 + if next_xml_token(stream) is
  456 + {
  457 + none then failure
  458 + token(tok) then
  459 + if tok = "?xml version='1.0'?" then
  460 + if next_xml_token(stream) is
  461 + {
  462 + none then failure
  463 + token(tok) then
  464 + if tok = "methodresponse" then
  465 + in_params(stream)
  466 + else
  467 + failure
  468 + }
  469 + else
  470 + failure
  471 + }.