Added util/xmlrpc.lua - functions for converting between XML-RPC stanzas and Lua...

diff --git a/util/xmlrpc.lua b/util/xmlrpc.lua
new file mode 100644 (file)
index 0000000..5a39175
--- /dev/null
+++ b/util/xmlrpc.lua
@@ -0,0 +1,163 @@
+-- Prosody IM v0.3
+-- Copyright (C) 2008-2009 Matthew Wild
+-- Copyright (C) 2008-2009 Waqas Hussain
+-- 
+-- This project is MIT/X11 licensed. Please see the
+-- COPYING file in the source package for more information.
+--
+
+
+local pairs = pairs;
+local type = type;
+local error = error;
+local t_concat = table.concat;
+local t_insert = table.insert;
+local tostring = tostring;
+local tonumber = tonumber;
+local st = require "util.stanza";
+
+module "xmlrpc"
+
+local _lua_to_xmlrpc;
+local map = {
+       table=function(stanza, object)
+               stanza:tag("struct");
+               for name, value in pairs(object) do
+                       stanza:tag("member");
+                               stanza:tag("name"):text(tostring(name)):up();
+                               stanza:tag("value");
+                                       _lua_to_xmlrpc(stanza, value);
+                               stanza:up();
+                       stanza:up();
+               end
+               stanza:up();
+       end;
+       boolean=function(stanza, object)
+               stanza:tag("boolean"):text(object and "1" or "0"):up();
+       end;
+       string=function(stanza, object)
+               stanza:tag("string"):text(object):up();
+       end;
+       number=function(stanza, object)
+               stanza:tag("int"):text(tostring(object)):up();
+       end;
+};
+_lua_to_xmlrpc = function(stanza, object)
+       local h = map[type(object)];
+       if h then
+               h(stanza, object);
+       else
+               error("Type not supported by XML-RPC: " .. type(object));
+       end
+end
+function create_response(object)
+       local stanza = st.stanza("methodResponse"):tag("params"):tag("param"):tag("value");
+       _lua_to_xmlrpc(stanza, object);
+       stanza:up():up():up();
+       return stanza;
+end
+function create_error_response(faultCode, faultString)
+       local stanza = st.stanza("methodResponse"):tag("fault"):tag("value");
+       _lua_to_xmlrpc(stanza, {faultCode=faultCode, faultString=faultString});
+       stanza:up():up();
+       return stanza;
+end
+
+
+local _xmlrpc_to_lua;
+local int_parse = function(stanza)
+       if #stanza.tags ~= 0 or #stanza == 0 then error("<"..stanza.name.."> must have a single text child"); end
+       local n = tonumber(t_concat(stanza));
+       if n then return n; end
+       error("Failed to parse content of <"..stanza.name..">");
+end
+local rmap = {
+       methodCall=function(stanza)
+               if #stanza.tags ~= 2 then error("<methodCall> must have exactly two subtags"); end -- FIXME <params> is optional
+               if stanza.tags[1].name ~= "methodName" then error("First <methodCall> child tag must be <methodName>") end
+               if stanza.tags[2].name ~= "params" then error("Second <methodCall> child tag must be <params>") end
+               return _xmlrpc_to_lua(stanza.tags[1]), _xmlrpc_to_lua(stanza.tags[2]);
+       end;
+       methodName=function(stanza)
+               if #stanza.tags ~= 0 then error("<methodName> must not have any subtags"); end
+               if #stanza == 0 then error("<methodName> must have text content"); end
+               return t_concat(stanza);
+       end;
+       params=function(stanza)
+               local t = {};
+               for _, child in pairs(stanza.tags) do
+                       if child.name ~= "param" then error("<params> can only have <param> children"); end;
+                       t_insert(t, _xmlrpc_to_lua(child));
+               end
+               return t;
+       end;
+       param=function(stanza)
+               if not(#stanza.tags == 1 and stanza.tags[1].name == "value") then error("<param> must have exactly one <value> child"); end
+               return _xmlrpc_to_lua(stanza.tags[1]);
+       end;
+       value=function(stanza)
+               if #stanza.tags == 0 then return t_concat(stanza); end
+               if #stanza.tags ~= 1 then error("<value> must have a single child"); end
+               return _xmlrpc_to_lua(stanza.tags[1]);
+       end;
+       int=int_parse;
+       i4=int_parse;
+       double=int_parse;
+       boolean=function(stanza)
+               if #stanza.tags ~= 0 or #stanza == 0 then error("<boolean> must have a single text child"); end
+               local b = t_concat(stanza);
+               if b ~= "1" and b ~= "0" then error("Failed to parse content of <boolean>"); end
+               return b == "1" and true or false;
+       end;
+       string=function(stanza)
+               if #stanza.tags ~= 0 then error("<string> must have a single text child"); end
+               return t_concat(stanza);
+       end;
+       array=function(stanza)
+               if #stanza.tags ~= 1 then error("<array> must have a single <data> child"); end
+               return _xmlrpc_to_lua(stanza.tags[1]);
+       end;
+       data=function(stanza)
+               local t = {};
+               for _,child in pairs(stanza.tags) do
+                       if child.name ~= "value" then error("<data> can only have <value> children"); end
+                       t_insert(t, _xmlrpc_to_lua(child));
+               end
+               return t;
+       end;
+       struct=function(stanza)
+               local t = {};
+               for _,child in pairs(stanza.tags) do
+                       if child.name ~= "member" then error("<struct> can only have <member> children"); end
+                       local name, value = _xmlrpc_to_lua(child);
+                       t[name] = value;
+               end
+               return t;
+       end;
+       member=function(stanza)
+               if #stanza.tags ~= 2 then error("<member> must have exactly two subtags"); end -- FIXME <params> is optional
+               if stanza.tags[1].name ~= "name" then error("First <member> child tag must be <name>") end
+               if stanza.tags[2].name ~= "value" then error("Second <member> child tag must be <value>") end
+               return _xmlrpc_to_lua(stanza.tags[1]), _xmlrpc_to_lua(stanza.tags[2]);
+       end;
+       name=function(stanza)
+               if #stanza.tags ~= 0 then error("<name> must have a single text child"); end
+               local n = t_concat(stanza)
+               if tostring(tonumber(n)) == n then n = tonumber(n); end
+               return n;
+       end;
+}
+_xmlrpc_to_lua = function(stanza)
+       local h = rmap[stanza.name];
+       if h then
+               return h(stanza);
+       else
+               error("Unknown element: "..stanza.name);
+       end
+end
+function translate_request(stanza)
+       if stanza.name ~= "methodCall" then error("XML-RPC requests must have <methodCall> as root element"); end
+       return _xmlrpc_to_lua(stanza);
+end
+
+return _M;