Commits

Anonymous committed 33f7355

Initial import.

Comments (0)

Files changed (78)

+{-# OPTIONS_GHC -XForeignFunctionInterface -fglasgow-exts #-}
+module Main () where
+
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Utils
+import Foreign.Marshal.Array
+import Foreign.Storable
+
+import Data.Word
+import Data.Bits
+
+type VNodeID = CUInt
+type VSession = Ptr ()
+type Userdata = Ptr ()
+
+#include "verse.h"
+#include "versehelper.h"
+
+class CFlags a where
+    combineFlags :: [a] -> a
+
+newtype VNodeType = VNodeType { unVNodeType :: CUInt }
+
+instance CFlags VNodeType where
+    combineFlags = VNodeType . foldr ((.|.) . unVNodeType) 0 
+
+#{enum VNodeType, VNodeType
+ , v_nt_object = V_NT_OBJECT
+ , v_nt_geometry = V_NT_GEOMETRY
+ , v_nt_bitmap = V_NT_BITMAP
+ , v_nt_text = V_NT_TEXT
+ , v_nt_curve = V_NT_CURVE
+ , v_nt_audio = V_NT_AUDIO
+ , v_nt_num_types = V_NT_NUM_TYPES
+ , v_nt_system = V_NT_SYSTEM
+ , v_nt_num_types_netpack = V_NT_NUM_TYPES_NETPACK }
+ 
+newtype VNodeOwner = VNodeOwner { unVNodeOwner :: CUShort }
+
+instance CFlags VNodeOwner where
+    combineFlags = VNodeOwner . foldr ((.|.) . unVNodeOwner) 0 
+
+#{enum VNodeOwner, VNodeOwner
+ , vn_owner_other = VN_OWNER_OTHER
+ , vn_owner_mine = VN_OWNER_MINE }
+
+--
+--
+
+type SendConnectAcceptCallback = (Userdata -> VNodeID -> Ptr () -> Ptr () -> Ptr CUChar -> IO ())
+foreign import ccall "verse_callback_set_send_connect_accept"
+    c_verse_callback_set_send_connect_accept :: FunPtr SendConnectAcceptCallback -> Userdata -> IO ()   
+foreign import ccall "wrapper"
+    mkSendConnectAcceptCallback :: SendConnectAcceptCallback -> IO (FunPtr SendConnectAcceptCallback)
+
+type SendNodeCreateCallback = (Userdata -> VNodeID -> CUInt -> CUShort -> IO ())
+foreign import ccall "verse_callback_set_send_node_create"
+    c_verse_callback_set_send_node_create :: FunPtr SendNodeCreateCallback -> Userdata -> IO ()
+foreign import ccall "wrapper"
+    mkSendNodeCreateCallback :: SendNodeCreateCallback -> IO (FunPtr SendNodeCreateCallback)
+
+data VerseCallback =
+    SendConnectAccept (VNodeID -> String -> IO ()) |
+    SendNodeCreate (VNodeID -> VNodeType -> VNodeOwner -> IO ())
+    
+verseCallbackSet :: VerseCallback -> IO ()
+verseCallbackSet (SendConnectAccept f) = do
+    let f' = (\userdata_ptr avatar address_ptr connection_ptr hostid_ptr -> do
+        address <- peekCString $ castPtr address_ptr
+        --connection <- peekCString $ castPtr connection_ptr -- Segfaults, maybe it is not a char array? who knows...
+        --hostid <- maybePeek (\p -> peek p >>= return . fromIntegral) hostid_ptr -- Segfaults, don't know why
+        f avatar address)
+    fptr <- mkSendConnectAcceptCallback f'
+    c_verse_callback_set_send_connect_accept fptr nullPtr
+verseCallbackSet (SendNodeCreate f) = do
+    let f' = (\userdata vnodeid vnodetype_int vnodeowner_short -> do
+        f vnodeid (VNodeType vnodetype_int) (VNodeOwner vnodeowner_short))
+    fptr <- mkSendNodeCreateCallback f'
+    c_verse_callback_set_send_node_create fptr nullPtr
+
+foreign import ccall "verse_callback_update"
+    c_verse_callback_update :: CUInt -> IO ()
+    
+verseCallbackUpdate :: Int -> IO ()
+verseCallbackUpdate ms = c_verse_callback_update $ fromIntegral ms
+
+--
+--
+
+foreign import ccall "verse_send_connect"
+    c_verse_send_connect :: CString -> CString -> CString -> Ptr CUChar -> IO VSession
+    
+verseSendConnect :: String -> String -> String -> Maybe Int -> IO VSession
+verseSendConnect name pass address hostid = do
+    name_ptr <- newCString name
+    pass_ptr <- newCString pass
+    address_ptr <- newCString address
+    hostid_ptr <- maybeNew (\i -> new i) $ fmap fromIntegral hostid
+    c_verse_send_connect name_ptr pass_ptr address_ptr hostid_ptr
+
+foreign import ccall "verse_send_connect_accept"
+    c_verse_send_connect_accept :: VNodeID -> CString -> Ptr CUChar -> IO VSession
+    
+verseSendConnectAccept :: VNodeID -> String -> Maybe Int -> IO VSession
+verseSendConnectAccept avatar address hostid = do
+    address_ptr <- newCString address
+    hostid_ptr <- maybeNew (\i -> new i) $ fmap fromIntegral hostid
+    c_verse_send_connect_accept avatar address_ptr hostid_ptr
+    
+foreign import ccall "verse_send_connect_terminate"
+    c_verse_send_connect_terminate :: CString -> CString -> IO ()
+
+verseSendConnectTerminate :: String -> String -> IO ()    
+verseSendConnectTerminate address bye = do
+    address_ptr <- newCString address
+    bye_ptr <- newCString bye
+    c_verse_send_connect_terminate address_ptr bye_ptr
+    
+foreign import ccall "verse_send_ping"
+    c_verse_send_ping :: CString -> CString -> IO ()
+    
+verseSendPing :: String -> String -> IO ()
+verseSendPing address message = do
+    address_ptr <- newCString address
+    message_ptr <- newCString message
+    c_verse_send_ping address_ptr message_ptr
+
+foreign import ccall "verse_send_node_index_subscribe"
+    c_verse_send_node_index_subscribe :: CUInt -> IO ()
+    
+verseSendNodeIndexSubscribe :: CUInt -> IO ()
+verseSendNodeIndexSubscribe = c_verse_send_node_index_subscribe
+
+foreign import ccall "verse_send_node_create"
+    c_verse_send_node_create :: VNodeID -> VNodeType -> VNodeOwner -> IO ()
+    
+verseSendNodeCreate :: VNodeID -> VNodeType -> VNodeOwner -> IO ()
+verseSendNodeCreate = c_verse_send_node_create
+
+main = do
+    verseCallbackSet $ SendConnectAccept (\avatar address -> do
+        print "SendConnectAccept"
+        print avatar
+        print address
+        let mask = foldl (\m i -> (.|.) m (shiftL 1 $ fromIntegral i)) 0 [0..((unVNodeType v_nt_num_types) - 1)]
+        verseSendNodeIndexSubscribe mask)
+    verseCallbackSet $ SendNodeCreate (\vnodeid vnodetype vnodeowner -> do
+        print "SendNodeCreate"
+        print vnodeid)
+    verseSendConnect "foo" "bar" "localhost" Nothing
+    loop
+    
+    where
+    
+    loop = do
+        verseCallbackUpdate 1000
+        loop
+
+default: HsVerse
+
+libverse.a:
+	cd verse/; make
+
+versehelper.o: libverse.a
+	$(CC) -Iverse/ -Lverse/ -static -lverse -c versehelper.c -o versehelper.o
+
+libversehelper.a: versehelper.o
+	$(AR) rcs libversehelper.a versehelper.o
+	ranlib libversehelper.a
+
+HsVerse.hs: HsVerse.hsc
+	hsc2hs -Iverse/ -C-lverse HsVerse.hsc -o HsVerse.hs -v
+
+HsVerse: HsVerse.hs libversehelper.a libverse.a
+	ghc -static -Lverse/ -L. -lverse -lversehelper -no-hs-main HsVerse.hs -o HsVerse
+
+clean:
+	cd verse/; make clean
+	rm HsVerse HsVerse.hi HsVerse.hs HsVerse.o HsVerse_stub.c HsVerse_stub.h HsVerse_stub.o libversehelper.a versehelper.o
+
+Known problems with Verse
+
+2005-07-01, r5p0 release
+* Encryption needs to be re-done.

verse/MAINTAINERS

+
+			Verse Maintainers
+
+This file tries to list credits for the various parts of the
+Verse core distribution, and also identify who maintains what.
+
+We are deeply appreciative of any contributions and thank you
+all for your time and interest in helping make Verse a better
+thing.
+
+* All code was originally written by Eskil Steenberg, and is
+  being maintained by him and Emil Brink. Contact us through
+  the project page at http://www.blender.org/modules/verse/.
+
+* SCons build file by N. Letwory, http://www.jester-depot.net/.
+#
+# Makefile for Verse core; API and reference server.
+# This pretty much requires GNU Make, I think.
+#
+# This build is slightly complicated that part of the C code that
+# needs to go into the API implementation is generated by building
+# and running other C files (this is the protocol definition).
+#
+
+CC	?= gcc
+CFLAGS	?= "-I$(shell pwd)" -Wall -Wpointer-arith -ansi -g # -pg -O2 -finline-functions
+LDFLAGS	?= -pg
+
+AR	?= ar
+ARFLAGS	= rus
+RANLIB	?= ranlib
+
+TARGETS = libverse.a verse
+SUBDIRS = examples-dir
+
+ALL:	$(TARGETS) $(SUBDIRS)
+.PHONY:	all clean cleanprot
+
+# Automatically generated protocol things.
+PROT_DEF  = $(wildcard v_cmd_def_*.c)
+PROT_TOOL = v_cmd_gen.c $(PROT_DEF)
+PROT_OUT  = v_gen_pack_init.c v_gen_unpack_func.h verse.h \
+		$(patsubst v_cmd_def_%.c,v_gen_pack_%_node.c, $(PROT_DEF))
+
+# The API implementation is the protocol code plus a few bits.
+LIBVERSE_SRC =  $(PROT_OUT) v_bignum.c v_cmd_buf.c v_connect.c \
+		v_connection.c v_connection.h v_encryption.c \
+		v_func_storage.c v_internal_verse.h v_man_pack_node.c \
+		v_network.c v_network.h v_network_in_que.c v_network_out_que.c \
+		v_pack.c v_pack.h v_pack_method.c v_prime.c v_randgen.c v_util.c
+
+LIBVERSE_OBJ = $(patsubst %h,, $(LIBVERSE_SRC:%.c=%.o))
+
+# The server is a simple 1:1 mapping, so just use wildcards.
+VERSE_SRC = $(wildcard vs_*.c)
+VERSE_OBJ = $(VERSE_SRC:%.c=%.o)
+
+# -----------------------------------------------------
+
+all:		$(TARGETS)
+
+verse:		$(VERSE_OBJ) libverse.a
+		$(CC) $(LDFLAGS) -o $@ $^
+
+libverse.a:	libverse.a($(LIBVERSE_OBJ))
+
+examples-dir:
+	cd examples && $(MAKE)
+
+# -----------------------------------------------------
+
+# Here are the automatically generated pieces of the puzzle.
+# Basically, we generate v_gen_pack_X_node.c files by compiling
+# the v_cmd_def_X.c files together with some driver glue and
+# running the result.
+#
+
+# The autogen outputs all depend on the tool.
+$(PROT_OUT):	mkprot
+		./mkprot
+
+# Build the protocol maker, from the definitions themselves.
+mkprot:		$(PROT_TOOL) verse_header.h
+		$(CC) -DV_GENERATE_FUNC_MODE -o $@ $(PROT_TOOL)
+
+# Clean away all the generated parts of the protocol implementation.
+cleanprot:	clean
+		rm -f mkprot $(PROT_OUT)
+
+# -----------------------------------------------------
+
+clean:
+	rm -f *.o $(TARGETS) && (cd examples && $(MAKE) clean)
+
+# -----------------------------------------------------
+
+# Utter ugliness to create release archives. Needs to improve, but should work for a while.
+dist:	clean
+	rm -f mkprot
+	RELEASE=$$( \
+	R=`grep V_RELEASE_NUMBER verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; \
+	P=`grep V_RELEASE_PATCH verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; \
+	L=`grep V_RELEASE_LABEL verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; echo r$${R}p$$P$$L ) ; \
+	if [ $$RELEASE ]; then ( \
+	 rm -rf  /tmp/verse; \
+	 mkdir -p /tmp/verse; \
+	 cp -a * /tmp/verse; \
+	 cd /tmp && zip verse-$$RELEASE.zip -r verse -x 'verse/*CVS*' -x 'verse/.*' ; \
+	 ); mv /tmp/verse-$$RELEASE.zip . \
+	;else \
+	  echo "Couldn't auto-set RELEASE from verse.h, something is fishy" \
+	;fi
+
+# More creative bashing, to create binary release archive for Linux.
+distb:	$(TARGETS)
+	RELEASE=$$( \
+	R=`grep V_RELEASE_NUMBER verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; \
+	P=`grep V_RELEASE_PATCH verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; \
+	L=`grep V_RELEASE_LABEL verse.h | tr -s ' \t' | tr -d '"\r' | cut -d'	' -f3` ; echo r$${R}p$$P$$L ) ; \
+	S=`uname -s | tr -d ' ' | tr [A-Z] [a-z]`-`uname -m | tr -d ' '`; \
+	H=`pwd`;\
+	if [ $$RELEASE ]; then ( \
+	 A=verse-$$RELEASE-$$S.tar.gz; \
+	 rm -rf /tmp/verse; \
+	 mkdir -p /tmp/verse; \
+	 cp verse libverse.a verse.h /tmp/verse; \
+	 strip /tmp/verse/verse; \
+	 cd /tmp; \
+	 mv verse verse-$$RELEASE; \
+	 tar czf $$A verse-$$RELEASE ; \
+	 mv $$A $$H;\
+	 ); \
+	else \
+	  echo "Couldn't auto-set RELEASE from verse.h, something is out of whack." \
+	; fi
+
+				Verse
+
+This is the Verse protocol and sample server implementations.
+
+For more information, see <http://www.blender.org/modules/verse/>.
+
+Running "make" here will build the API library, "libverse.a" (and its
+header file, "verse.h"). These two will then be used to build the
+reference Verse server binary, called "verse".
+
+
+RELEASE LABELING
+Verse uses a simple two-level numbering scheme to identify releases.
+There is a "release number", and a "patch level" on each release. The
+intent is that within a release, the API does not change and neither
+should the network protocol. Between releases, we might improve the
+API which will require application programmers to update their code
+to stay in sync. We can do non-API-altering changes within a release
+by increasing the patch level, for bug fixing and other things.
+	The symbols V_RELEASE_NUMBER and V_RELEASE_PATCH are integer
+literals that hold the values for the API you have, and can be used
+(and displayed) in application source code as you see fit.

verse/config.opts

+#Configuration file for verse SCons user definable options.
+BUILD_BINARY = 'release'
+REGEN_PROTO = 'yes'
+
+# Compiler information.
+HOST_CC = 'gcc'
+HOST_CXX = 'g++'
+TARGET_CC = 'gcc'
+TARGET_CXX = 'g++'
+TARGET_AR = 'ar'
+PATH = '/bin:/usr/bin:/usr/local/bin:/opt/bin:/usr/i686-pc-linux-gnu/gcc-bin/3.3.5-20050130:/opt/blackdown-jdk-1.4.2.02/bin:/opt/blackdown-jdk-1.4.2.02/jre/bin:/opt/blackdown-jdk-1.4.2.01/bin:/home/emil/bin:/opt/blackdown-jdk-1.4.2.01/bin:/home/emil/bin'

verse/examples/Makefile

+#
+# Simplistic Makefile to build the sole example program. Should
+# help avoid accidentally breaking it (regressing).
+#
+
+ALL=list-nodes
+
+ALL:	$(ALL)
+.PHONY: clean
+
+CFLAGS+= -I.. -L..
+LDLIBS+= -lverse
+
+# ---------------------------------------------------------------------------
+
+clean:
+	rm -f $(ALL)

verse/examples/list-nodes.c

+/* A minimalist Verse example. Ask server for nodes, print information. */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "verse.h"      /* Bring in the Verse API. */
+
+/* A callback for connection acception: will be called when server accepts this client. */
+static void callback_accept_connect(void *user, uint32 avatar, void *address, void *connection, uint8 *host_id)
+{
+    uint32 i, mask = 0;
+
+    printf("Connected to a Verse host!\n\nListing nodes:\n");
+
+    /* Build node subscription mask. */
+    for(i = 0; i < V_NT_NUM_TYPES; i++)
+        mask |= 1 << i;
+    verse_send_node_index_subscribe(mask);     /* Request listing of all nodes. */
+}
+
+/* A callback for node creation: is called to report information about existing nodes, too. */
+static void callback_node_create(void *user, VNodeID node_id, VNodeType type, VNodeOwner ownership)
+{
+    printf(" Node #%u has type %u\n", node_id, type);
+}
+
+int main(void)
+{
+    /* Register callbacks for interesting commands. */
+    verse_callback_set(verse_send_connect_accept, callback_accept_connect, NULL);
+    verse_callback_set(verse_send_node_create,	  callback_node_create, NULL);
+
+    /* Kick off program by connecting to Verse host on local machine. */
+    verse_send_connect("list-nodes", "<secret>", "localhost", NULL);
+    while(TRUE)
+        verse_callback_update(10000);   /* Listen to network, get callbacks. */
+
+    return EXIT_SUCCESS;    /* This is never reached. */
+}