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 694 www_url,
695 695 multipart_form_data.
696 696  
697   -type BufferedConnection:
  697 +public type BufferedConnection:
698 698 buffered_connection(Connection conn,
699 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 713 *** [2] Tools.
705 714  
706 715 *** [2.1] Formating an error message.
707 716  
708 717 The next function formats an error message.
709 718  
710   -define String
  719 +public define String
711 720 format
712 721 (
713 722 Error msg
... ... @@ -751,7 +760,7 @@ define String
751 760 public type SState:
752 761 sstate
753 762 (
754   - Var(List(Word8)) unput_chars, // for reading requests
  763 + //Var(List(Word8)) unput_chars, // for reading requests
755 764 Var(Int) sttm, // 'start time'
756 765 Var(Int) uploaded_file_count
757 766 ).
... ... @@ -775,8 +784,8 @@ public type SState:
775 784 define One
776 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 790 s.unput_chars <- (List(Word8))[character . *(s.unput_chars)].
782 791  
... ... @@ -880,13 +889,12 @@ define Result(Error,Word8)
880 889 next_char // reading a character (check the list first, and read on the connection
881 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 896 //with t2_tmp = (UTime) now,
889   - if *(s.unput_chars) is
  897 + if *(connection.unput_chars) is
890 898 {
891 899 [ ] then
892 900 // ///////////////////
... ... @@ -930,17 +938,16 @@ define Result(Error,Word8)
930 938 // },
931 939  
932 940 [h . t] then
933   - s.unput_chars <- t; //accumulate_t2(t2_tmp);
  941 + connection.unput_chars <- t; //accumulate_t2(t2_tmp);
934 942 ok(h)
935 943 }.
936 944  
937 945 define ByteArray
938 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 951 tail = extract(*connection.buffer, *connection.read_pos, length(*connection.buffer)),
945 952 // println("--- get_and_erase_buffer ----");
946 953 // println("unput char length : "+length(to_string(head)));
... ... @@ -953,7 +960,7 @@ define ByteArray
953 960 // println("["+to_string(*connection.buffer)+"]");
954 961 // println(" -- tail content ");
955 962 // println("["+to_string(tail)+"]");
956   - s.unput_chars <- [];
  963 + connection.unput_chars <- [];
957 964 connection.buffer <- constant_byte_array(0,0);
958 965 connection.read_pos <- 0;
959 966 head + tail
... ... @@ -970,20 +977,19 @@ define ByteArray
970 977 just before the body of a request.
971 978  
972 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 1007 define Result(Error,String)
1002 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 1015 error(msg) then error(msg),
1013 1016 ok(c) then
1014 1017 if c = '\\'
1015   - then if next_char(connection,dead_line,dos, s) is
  1018 + then if next_char(connection) is
1016 1019 {
1017 1020 error(msg) then error(msg),
1018 1021 ok(d) then
1019 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 1026 else if c = '\"'
1024 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 1307 define Result(Error,One)
1305 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 1314 error(msg) then error(msg),
1315 1315 ok(c) then
1316 1316 if is_strict_blank(c)
1317   - then skip_http_blanks(connection, dead_line, dos, s)
  1317 + then skip_http_blanks(connection)
1318 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 1321 error(msg) then error(msg), // (unput(c); ok(unique)),
1322 1322 ok(d) then
1323 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 1326 error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
1327 1327 ok(e) then
1328 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 1358 come. This is the reason for 'read_and_ignore' above, which is used precisely for
1359 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 1432 read_word_aux
1413 1433 (
1414 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 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 1616 if ls = "post" then ok(post) else
1603 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 1636 error(msg) then error(msg),
1625 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 1648  
1637 1649  
1638 1650  
1639   -
1640   -
1641   -
1642   -
1643 1651 *** [4.8] Reading the HTTP headers.
1644 1652  
1645 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 1671 read_header_name
1664 1672 (
1665 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 1678 error(msg) then error(msg),
1674 1679 ok(c) then
1675 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 1685 define Result(Error,One)
1681 1686 skip_colon
1682 1687 (
1683   - BufferedConnection connection,
1684   - Int dead_line,
1685   - DenialOfService dos,
1686   - SState s
  1688 + BufferedConnection connection
1687 1689 ) =
1688 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 1693 error(msg) then error(msg),
1692 1694 ok(_) then
1693   - if next_char(connection, dead_line, dos, s) is
  1695 + if next_char(connection) is
1694 1696 {
1695 1697 error(msg) then error(msg),
1696 1698 ok(c) then
... ... @@ -1701,72 +1703,66 @@ define Result(Error,One)
1701 1703  
1702 1704  
1703 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 1713 error(msg) then error(msg),
1715 1714 ok(c) then
1716 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 1718 error(msg) then error(msg),
1720 1719 ok(d) then
1721 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 1723 error(msg) then error(msg),
1725 1724 ok(e) then
1726 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 1735 Reading a single header.
1737 1736  
1738 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 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 1745 error(msg) then error(msg),
1750 1746 ok(name) then
1751 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 1750 error(msg) then error(msg),
1755 1751 ok(_) then // this is the blank line
1756 1752 ok(failure) // end of headers
1757 1753 }
1758 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 1757 error(msg) then error(msg),
1762 1758 ok(_) then
1763 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 1762 error(msg) then error(msg),
1767 1763 ok(_) then
1768 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 1767 error(msg) then error(msg),
1772 1768 ok(value) then ok(success(http_header(name,value)))
... ... @@ -1779,22 +1775,19 @@ define Result(Error,Maybe(HTTP_header))
1779 1775  
1780 1776 Reading all the headers.
1781 1777  
1782   -define Result(Error,List(HTTP_header))
  1778 +public define Result(Error,List(HTTP_header))
1783 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 1785 error(msg) then error(msg),
1793 1786 ok(mbh) then if mbh is
1794 1787 {
1795 1788 failure then ok([ ]),
1796 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 1792 error(msg) then error(msg),
1800 1793 ok(others) then ok([header . others])
... ... @@ -1813,7 +1806,7 @@ define Result(Error,List(HTTP_header))
1813 1806 The size of the body of the request is given under the 'Content-Length' header. If this
1814 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 1810 get_body_size
1818 1811 (
1819 1812 List(HTTP_header) headers
... ... @@ -1843,7 +1836,7 @@ define Result(Error,Int)
1843 1836 may be broken. In that case, we must not try to read indefinitely. On the contrary, we
1844 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 1840 read_http_body
1848 1841 (
1849 1842 BufferedConnection connection,
... ... @@ -3183,12 +3176,12 @@ define One
3183 3176 //println("Request time: " + format_http_date(start_time));
3184 3177 if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
3185 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 3181 error(msg) then print(format(msg)),
3189 3182 ok(rqline) then //request line
3190 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 3186 error(msg) then print(format(msg)),
3194 3187 ok(headers) then //print_delta("read_http_headers");
... ... @@ -3237,7 +3230,7 @@ define One
3237 3230 success(target) then
3238 3231  
3239 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 3234 buffer_size = length(buffer),
3242 3235 //println("buffer Size = "+buffer_size);
3243 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 3288 if is_dubious_IP(addr,dos)
3296 3289 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
3297 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 3293 public define One
3301 3294 http_direct_handler
3302 3295 (
... ... @@ -3308,8 +3301,8 @@ public define One
3308 3301 if is_dubious_IP(addr,dos)
3309 3302 then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
3310 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 3308 define Server -> (SSL_Connection -> One)
... ... @@ -3319,8 +3312,8 @@ define Server -&gt; (SSL_Connection -&gt; One)
3319 3312 DenialOfService dos
3320 3313 ) =
3321 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 3705 ) =
3713 3706 (Server server) |-> (RWStream conn) |->
3714 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 3711 error(msg) then print(format(msg)),
3719 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 3715 error(msg) then print(format(msg)),
3723 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 + }.
... ...