Lots of stuff

4 files changed, 295 insertions, 0 deletions

diff --git a/lib/supple.lua b/lib/supple.lua
index 5fc405b..0d87d20 100644
--- a/lib/supple.lua
+++ b/lib/supple.lua
@@ -8,6 +8,8 @@
 --
 
 local capi = require 'supple.capi'
+local request = require 'supple.request'
+local objects = require 'supple.objects'
 
 local _VERSION = 1
 local _ABI = 1
@@ -16,6 +18,8 @@ local VERSION = "Supple Version " .. tostring(_VERSION)
 
 return {
    capi = capi,
+   request = request,
+   objects = objects,
    _VERSION = _VERSION,
    VERSION = VERSION,
    _ABI = _ABI,
diff --git a/lib/supple/capi.c b/lib/supple/capi.c
index 139cfe6..c413c20 100644
--- a/lib/supple/capi.c
+++ b/lib/supple/capi.c
@@ -13,13 +13,156 @@
 #include <lua.h>
 #include <lauxlib.h>
 
+#include <string.h>
+
 /* The API exposed, increment on backward-compatible changes */
 #define CAPI_API 1
 /* The ABI exposed, increment on backward-incompatible changes */
 #define CAPI_ABI 1
 
+static int
+supple_capi_explain(lua_State *L)
+{
+	int one_type;
+	if (lua_gettop(L) != 2) {
+		return luaL_error(L, "Expected 2 args got %d", lua_gettop(L));
+	}
+	one_type = lua_type(L, 1);
+	if ((one_type != LUA_TTABLE) &&
+	    (one_type != LUA_TFUNCTION) &&
+	    (one_type != LUA_TUSERDATA)) {
+		return luaL_error(L, 
+			"Expected one of table, function or userdata.  " \
+			"Got %s instead",
+			lua_typename(L, one_type));
+	}
+	if (lua_type(L, 2) != LUA_TSTRING) {
+		return luaL_error(L, "Expected string, got %s instead",
+				  lua_typename(L, lua_type(L, 2)));
+	}
+	lua_newtable(L);
+	lua_pushvalue(L, 2);
+	lua_setfield(L, -2, "tag");
+	lua_pushstring(L, lua_typename(L, one_type));
+	lua_setfield(L, -2, "type");
+	if (one_type != LUA_TFUNCTION) {
+		/* Get the metatable */
+		if (lua_getmetatable(L, 1) != 0) {
+			int idx = 1;
+			/* Prepare a methods table */
+			lua_newtable(L);
+			lua_pushnil(L); /* For iterating */
+			while (lua_next(L, -3) != 0) { /* Iterate the metatable */
+				lua_pop(L, 1); /* Don't need the value */
+				if (lua_type(L, -1) != LUA_TSTRING) {
+					/* Not a string key */
+				} else if (strcmp(lua_tostring(L, -1),
+						  "__mode") == 0) {
+					/* mode key is ignored */
+				} else {
+					/* dup */
+					lua_pushvalue(L, -1);
+					/* And copy into methods */
+					lua_rawseti(L, -3, idx++);
+				}
+				/* Key is left ready for lua_next() */
+			}
+			/* Stuff the methods table into the return */
+			lua_setfield(L, -3, "methods");
+			/* And pop the metatable */
+			lua_pop(L, 1);
+		}
+	}
+	/* And return the new table */
+	return 1;
+}
+
+static int
+supple_capi_proxy_tostring(lua_State *L)
+{
+	/* arg 1 is the object, upvalue 1 is the original type */
+	const char *orig_type = lua_tostring(L, lua_upvalueindex(1));
+	lua_pushfstring(L, "%s: %p", orig_type, lua_touserdata(L, 1));
+	return 1;
+}
+
+static int
+supple_capi_proxy_type(lua_State *L)
+{
+	/* arg 1 is the object, upvalue 1 is the original type */
+	lua_pushvalue(L, lua_upvalueindex(1));
+	return 1;
+}
+
+static int
+supple_capi_new_proxy(lua_State *L)
+{
+	void *proxy_ptr;
+	/* Input is a type string */
+	if (lua_type(L, 1) != LUA_TSTRING) {
+		return luaL_error(L, "Expected type string, got %s",
+				  lua_typename(L, lua_type(L, 1)));
+	}
+	proxy_ptr = lua_newuserdata(L, 1);
+	if (proxy_ptr == NULL) {
+		return 0;
+	}
+	lua_newtable(L);
+	/* typestr, proxyobj, metatable */
+	/* First job is the tostring metamethod, we always add that */
+	lua_pushvalue(L, 1);
+	lua_pushcclosure(L, supple_capi_proxy_tostring, 1);
+	lua_setfield(L, -2, "__tostring");
+	/* next the __type metamethod for the lua level type call */
+	lua_pushvalue(L, 1);
+	lua_pushcclosure(L, supple_capi_proxy_type, 1);
+	lua_setfield(L, -2, "__type");
+	/* And now prevent anything poking in us later */
+	lua_pushboolean(L, 1);
+	lua_setfield(L, -2, "__metatable");
+
+	/* Finally set the metatable and return proxy, metatable */
+	lua_pushvalue(L, -1);
+	lua_setmetatable(L, -3);
+
+	return 2;
+}
+
+/* Replacement for lbaselib.c's type method, honouring __type */
+static int
+supple_capi_type(lua_State *L)
+{
+	lua_settop(L, 1);
+	if (lua_getmetatable(L, 1) != 0) {
+		/* There is a metatable, try and find __type */
+		lua_getfield(L, 2, "__type");
+		if (lua_isfunction(L, 3)) {
+			lua_pushvalue(L, 1);
+			lua_call(L, 1, 1);
+			return 1;
+		}
+	}
+	
+	lua_pushstring(L, lua_typename(L, lua_type(L, 1)));
+
+	return 1;
+}
+
+/* Reimplementation of base type in case it's not available */
+static int
+supple_capi_rawtype(lua_State *L)
+{
+	lua_settop(L, 1);
+	lua_pushstring(L, lua_typename(L, lua_type(L, 1)));
+	return 1;
+}
+
 static const struct luaL_Reg
 supple_capi_functions[] = {
+	{ "explain", supple_capi_explain },
+	{ "new_proxy", supple_capi_new_proxy },
+	{ "type", supple_capi_type },
+	{ "rawtype", supple_capi_rawtype },
 	{ NULL, NULL }
 };
 
diff --git a/lib/supple/objects.lua b/lib/supple/objects.lua
new file mode 100644
index 0000000..67cb71b
--- /dev/null
+++ b/lib/supple/objects.lua
@@ -0,0 +1,111 @@
+-- lib/supple/request.lua
+--
+-- Sandbox (for) Untrusted Procedure Partitioning (in) Lua Engine
+--
+-- Contextual object storage and identification.  Wrapping and unwrapping.
+--
+-- Copyright 2012 Daniel Silverstone <dsilvers@digital-scurf.org>
+--
+-- For licence terms, see COPYING
+--
+
+local capi = require 'supple.capi'
+
+local my_objects_by_obj = {}
+local my_objects_by_tag = {}
+local my_name = "UNSET"
+local my_counter = 0
+local their_objects_by_tag = setmetatable({}, { __mode="v" })
+local their_objects_by_obj = setmetatable({}, { __mode="k" })
+local proc_call = nil
+
+local type = capi.rawtype
+
+local function set_name(newname)
+   my_name = newname
+end
+
+local function set_proc_call(pc)
+   proc_call = pc
+end
+
+local integral = {
+   ["nil"] = true,
+   boolean = true,
+   string = true,
+   number = true,
+}
+
+local function give(obj)
+   -- If the object is integral, return it directly
+   if integral[type(obj)] then
+      return obj
+   end
+   -- If the passed object is one of their objects then "unwrap" it by
+   -- returning their tag.
+   local tag = their_objects_by_obj[obj];
+   if tag then
+      return { tag = tag }
+   end
+   -- If it's one of our objects which has already been wrapped, return our
+   -- tag
+   local tag = my_objects_by_obj[obj]
+   if tag then
+      return { tag = tag }
+   end
+   -- otherwise wrap it freshly for us and return that.
+   local tag = ("%s:%d"):format(my_name, my_counter)
+   local expn = capi.explain(obj, tag)
+   my_objects_by_obj[obj] = tag
+   my_objects_by_tag[tag] = obj
+   return expn
+end
+
+local function receive(obj)
+   -- If the object is integral, return it directly
+   if integral[type(obj)] then
+      return obj
+   end
+   -- It's not integral, so it must be a tagged object
+   assert(type(obj) == "table")
+   assert(type(obj.tag) == "string")
+   local tag = obj.tag
+   -- First up, is it one of our objects?
+   local ret = my_objects_by_tag[tag]
+   if ret then
+      return ret
+   end
+   -- Now is it a known one of their objects?
+   ret = their_objects_by_tag[tag]
+   if ret then
+      return ret
+   end
+   -- Okay, prepare a proxy?
+   assert(type(obj.type) == "string")
+   local proxy, mt = capi.new_proxy(obj.type)
+   their_objects_by_tag[tag] = proxy
+   their_objects_by_obj[proxy] = tag
+   -- Fill out the metatable
+   obj.methods = obj.methods or {}
+   obj.methods[#obj.methods+1] = "__gc"
+   if obj.type == "function" then
+      obj.methods[#obj.methods+1] = "__call"
+   end
+   if obj.type == "table" then
+      obj.methods[#obj.methods+1] = "__index"
+      obj.methods[#obj.methods+1] = "__newindex"
+   end
+   for _, name in ipairs(obj.methods or {}) do
+      mt[name] = function(...)
+		    proc_call(tag, name, ...)
+		 end
+   end
+   -- And return the proxy object
+   return proxy
+end
+
+return {
+   set_name = set_name,
+   set_proc_call = set_proc_call,
+   give = give,
+}
diff --git a/lib/supple/request.lua b/lib/supple/request.lua
new file mode 100644
index 0000000..7f01e99
--- /dev/null
+++ b/lib/supple/request.lua
@@ -0,0 +1,37 @@
+-- lib/supple/request.lua
+--
+-- Sandbox (for) Untrusted Procedure Partitioning (in) Lua Engine
+--
+-- Request/response serialisation/deserialisation including contextual object
+-- management and organisation.
+--
+-- Copyright 2012 Daniel Silverstone <dsilvers@digital-scurf.org>
+--
+-- For licence terms, see COPYING
+--
+
+local tconcat = table.concat
+
+local function serialise_error(errstr, traceback)
+   return tconcat {
+      "error=true,",
+      ("message=%q,"):format(errstr),
+      ("traceback=%q"):format(traceback)
+   }
+end
+
+local function serialise_request(obj, method, ...)
+end
+
+local function serialise_response(...)
+end
+
+local function deserialise_entity(entity)
+end
+
+return {
+   error = serialise_error,
+   request = serialise_request,
+   response = serialise_response,
+   deserialise = deserialise_entity,
+}