Author: dylan Date: 2005-12-18 21:02:05 -0500 (Sun, 18 Dec 2005) New Revision: 958
Added: trunk/ocaml/ trunk/ocaml/server/ trunk/ocaml/server/Makefile trunk/ocaml/server/OCamlMakefile trunk/ocaml/server/client.ml trunk/ocaml/server/entity.ml trunk/ocaml/server/entity.mli trunk/ocaml/server/listener.ml trunk/ocaml/server/net.ml trunk/ocaml/server/ocaml.sql trunk/ocaml/server/protocol.ml trunk/ocaml/server/reader.ml Modified: trunk/ Log: Added ocaml haver server. Property changes on: trunk ___________________________________________________________________ Name: svk:merge - 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192 27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212 e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1699 edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238 + 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192 27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212 e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1708 edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238 Added: trunk/ocaml/server/Makefile =================================================================== --- trunk/ocaml/server/Makefile 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/Makefile 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,47 @@ +OCAMLMAKEFILE = OCamlMakefile + +INTERFACES = entity.mli + +SOURCES = $(INTERFACES) \ + net.ml protocol.ml client.ml entity.ml reader.ml listener.ml + +#TESTS = t/test_Util.ml t/test_Path.ml \ + t/test_Graph.ml t/test_Recipe.ml \ + t/test_suite.ml + +RESULT = havermld +#PROFILING = yes +THREADS = yes +LIBS = str +#INCDIRS = +lablgtk2 +#CLIBS = ncurses +#PACKS = getopt +TRASH = map.png map.dot \ + $(wildcard t/*.cmx) \ + $(wildcard t/*.cmi) \ + $(wildcard t/*.o) \ + $(RESULT).test + +#ifdef TEST +#RESULT = $(RESULT).test +#PACKS += oUnit +#LIBS := $(filter-out unix, $(LIBS)) +#SOURCES := $(filter-out bake.ml, $(SOURCES)) $(TESTS) +#endif + +all: nc +docs: htdoc +test: all + make TEST=1 > /dev/null + ./$(RESULT).test -verbose + +graph.png: $(SOURCES) + ocamldep $(SOURCES) | ocamldot | dot -Tpng > $@ + +map.png: map.dot + dot $< -Tpng > $@ + +map.dot: $(SOURCES) map.pl + perl map.pl $(SOURCES) +include $(OCAMLMAKEFILE) + Added: trunk/ocaml/server/OCamlMakefile =================================================================== --- trunk/ocaml/server/OCamlMakefile 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/OCamlMakefile 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,959 @@ +########################################################################### +# OCamlMakefile +# Copyright (C) 1999-2002 Markus Mottl +# +# For updates see: +# http://www.oefai.at/~markus/ocaml_sources +# +# $Id: OCamlMakefile,v 1.27 2003/02/24 11:23:34 markus Exp $ +# +########################################################################### + +# Set these variables to the names of the sources to be processed and +# the result variable. Order matters during linkage! + +ifndef SOURCES + SOURCES := foo.ml +endif +export SOURCES + +ifndef RES_CLIB_SUF + RES_CLIB_SUF := _stubs +endif +export RES_CLIB_SUF + +ifndef RESULT + RESULT := foo +endif +export RESULT + +ifndef DOC_FILES + DOC_FILES := $(filter %.mli, $(SOURCES)) +endif +export DOC_FILES + +export BCSUFFIX +export NCSUFFIX + +ifndef TOPSUFFIX + TOPSUFFIX := .top +endif + +export TOPSUFFIX + +# Eventually set include- and library-paths, libraries to link, +# additional compilation-, link- and ocamlyacc-flags +# Path- and library information needs not be written with "-I" and such... +# Define THREADS if you need it, otherwise leave it unset (same for +# USE_CAMLP4)! + +export THREADS +export USE_CAMLP4 + +export INCDIRS +export LIBDIRS +export EXTLIBDIRS +export OCAML_DEFAULT_DIRS + +export LIBS +export CLIBS + +export OCAMLFLAGS +export OCAMLNCFLAGS +export OCAMLBCFLAGS + +export OCAMLLDFLAGS +export OCAMLNLDFLAGS +export OCAMLBLDFLAGS + +ifndef OCAMLCPFLAGS + OCAMLCPFLAGS := a +endif + +export OCAMLCPFLAGS + +export YFLAGS +export IDLFLAGS + +export OCAMLDOCFLAGS + +export DVIPSFLAGS + +export STATIC + +# Add a list of optional trash files that should be deleted by "make clean" +export TRASH + +#################### variables depending on your OCaml-installation + +ifdef MINGW + export MINGW + WIN32 := 1 + EXT_DLL := dll + DLL_ADDITIONAL_CLIBS := $(OCAMLLIBPATH)/ocamlrun.a + OCAMLDEP_FILTER := | sed -e 's/\\\(.\)/\/\1/g' +endif +ifdef MSVC + export MSVC + WIN32 := 1 + EXT_OBJ := obj + EXT_LIB := lib + EXT_DLL := dll + ifeq ($(CC),gcc) + # work around GNU Make default value +# ifdef THREADS + CC := cl /MT +# else +# CC := cl +# endif + endif + ifeq ($(CXX),g++) + # work around GNU Make default value + CXX := $(CC) + endif + CFLAG_O := -Fo +endif +ifdef WIN32 + EXT_CXX := cpp + EXE := .exe +endif + +ifndef EXT_OBJ + EXT_OBJ := o +endif +ifndef EXT_LIB + EXT_LIB := a +endif +ifndef EXT_DLL + EXT_DLL := so +endif +ifndef EXT_CXX + EXT_CXX := cc +endif +ifndef EXE + EXE := # empty +endif +ifndef CFLAG_O + CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! +endif + +export CC +export CXX +export CFLAGS +export CXXFLAGS +export LDFLAGS + +BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) +NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) + +ifndef OCAMLFIND + ifndef PACKS + OCAMLFIND := ocamlfind + endif +endif + +export OCAMLFIND + +ifndef OCAMLC + OCAMLC := ocamlc +endif + +export OCAMLC + +ifndef OCAMLOPT + OCAMLOPT := ocamlopt +endif + +export OCAMLOPT + +ifndef OCAMLMKTOP + OCAMLMKTOP := ocamlmktop +endif + +export OCAMLMKTOP + +ifndef OCAMLCP + OCAMLCP := ocamlcp +endif + +export OCAMLCP + +ifndef OCAMLDEP + OCAMLDEP := ocamldep +endif + +export OCAMLDEP + +ifndef OCAMLLEX + OCAMLLEX := ocamllex +endif + +export OCAMLLEX + +ifndef OCAMLYACC + OCAMLYACC := ocamlyacc +endif + +export OCAMLYACC + +ifndef CAMELEON_REPORT + CAMELEON_REPORT := report +endif + +ifndef CAMELEON_REPORT_FLAGS + CAMELEON_REPORT_FLAGS := +endif + +ifndef CAMELEON_ZOGGY + CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo +endif + +ifndef CAMELEON_ZOGGY_FLAGS + CAMELEON_ZOGGY_FLAGS := +endif + +ifndef CAMLIDL + CAMLIDL := camlidl +endif + +export CAMLIDL + +ifndef CAMLIDLDLL + CAMLIDLDLL := camlidldll +endif + +export CAMLIDLDLL + +ifndef NOIDLHEADER + MAYBE_IDL_HEADER := -header +endif + +export NOIDLHEADER + +ifndef CAMLP4 + CAMLP4 := camlp4 +endif + +export CAMLP4 + +ifdef PACKS + empty := + space := $(empty) $(empty) + comma := , + OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) + OCAML_FIND_LINKPKG := -linkpkg +endif + +export OCAML_FIND_PACKAGES +export OCAML_FIND_LINKPKG + +ifndef OCAMLDOC + OCAMLDOC := ocamldoc +endif + +export OCAMLDOC + +ifndef LATEX + LATEX := latex +endif + +export LATEX + +ifndef DVIPS + DVIPS := dvips +endif + +export DVIPS + +ifndef PS2PDF + PS2PDF := ps2pdf +endif + +export PS2PDF + +ifndef OCAMLMAKEFILE + OCAMLMAKEFILE := OCamlMakefile +endif + +export OCAMLMAKEFILE + +ifndef OCAMLLIBPATH + OCAMLLIBPATH := \ + $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) +endif + +export OCAMLLIBPATH + +########################################################################### + +#################### change following sections only if +#################### you know what you are doing! + +# delete target files when a build command fails +.PHONY: .DELETE_ON_ERROR +.DELETE_ON_ERROR: + +# for pedants using "--warn-undefined-variables" +export MAYBE_IDL +export REAL_RESULT +export CAMLIDLFLAGS +export THREAD_FLAG +export RES_CLIB +export MAKEDLL + +SHELL := /bin/sh + +MLDEPDIR := ._d +BCDIDIR := ._bcdi +NCDIDIR := ._ncdi + +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.c %.$(EXT_CXX) %.rep %.zog + +FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) +SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) + +FILTERED_REP := $(filter %.rep, $(FILTERED)) +DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) +AUTO_REP := $(FILTERED_REP:.rep=.ml) + +FILTERED_ZOG := $(filter %.zog, $(FILTERED)) +DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) +AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) + +FILTERED_ML := $(filter %.ml, $(FILTERED)) +DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) + +FILTERED_MLI := $(filter %.mli, $(FILTERED)) +DEP_MLI := $(FILTERED_MLI:.mli=.di) + +FILTERED_MLL := $(filter %.mll, $(FILTERED)) +DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) +AUTO_MLL := $(FILTERED_MLL:.mll=.ml) + +FILTERED_MLY := $(filter %.mly, $(FILTERED)) +DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) +AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) + +FILTERED_IDL := $(filter %.idl, $(FILTERED)) +DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) +C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) $(FILTERED_IDL:.idl=.h) +OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) +AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) + +FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) +OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) + +PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_ZOG) $(AUTO_REP) + +ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_ZOG) $(DEP_REP) + +MLDEPS := $(filter %.d, $(ALL_DEPS)) +MLIDEPS := $(filter %.di, $(ALL_DEPS)) +BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) +NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) + +ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.rep %.zog, $(FILTERED)) + +IMPLO_INTF := $(ALLML:%.mli=%.mli.__) +IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ + $(basename $(file)).cmi $(basename $(file)).cmo) +IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) +IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) + +IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) + +INTF := $(filter %.cmi, $(IMPLO_INTF)) +IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) +IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) + +OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) +OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) + +EXECS := $(addsuffix $(EXE), \ + $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) +ifdef WIN32 + EXECS += $(BCRESULT).dll $(NCRESULT).dll +endif + +CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) +ifneq ($(strip $(OBJ_LINK)),) + RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) +endif + +ifndef MSVC + DLLSONAME := dll$(CLIB_BASE).$(EXT_DLL) +endif + +NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(OBJ_FILES) $(PRE_TARGETS) \ + $(BCRESULT).cma $(NCRESULT).cmxa $(NCRESULT).$(EXT_LIB) \ + $(BCRESULT).cmi $(BCRESULT).cmo \ + $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ + $(RES_CLIB) + +ifndef MSVC + ifndef STATIC + NONEXECS += $(DLLSONAME) + endif +endif + +ifndef LIBINSTALL_FILES + LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ + $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) + ifndef MSVC + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + LIBINSTALL_FILES += $(DLLSONAME) + endif + endif + endif +endif + +export LIBINSTALL_FILES + +ifdef WIN32 + # some extra stuff is created while linking DLLs + NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp +endif + +TARGETS := $(EXECS) $(NONEXECS) + +# handle ocamlfind +ifdef OCAMLFIND + PACKOPT := -passopt "-pack" +else + PACKOPT := -pack +endif + +# If there are IDL-files +ifneq ($(strip $(FILTERED_IDL)),) + MAYBE_IDL := -cclib -lcamlidl +endif + +ifdef USE_CAMLP4 + CAMLP4PATH := \ + $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) + INCFLAGS := -I $(CAMLP4PATH) + CINCFLAGS := -I$(CAMLP4PATH) +endif + +INCFLAGS += $(SOURCE_DIRS:%=-I %) $(INCDIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) +CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ + $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-R%) \ + $(OCAML_DEFAULT_DIRS:%=-L%) + +ifndef PROFILING + INTF_OCAMLC := $(OCAMLC) +else + ifndef THREADS + INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) + else + # OCaml does not support profiling byte code + # with threads (yet), therefore we force an error. + ifndef REAL_OCAMLC + $(error Profiling of multithreaded byte code not yet supported by OCaml) + endif + endif +endif + +ifndef MSVC + COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ + $(LIBDIRS:%=-ccopt -L%) \ + $(EXTLIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -R%) \ + $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) +else + # currenly MSVC-build ocamlc/ocamlopt cannot pass any option to C linker :-( + COMMON_LDFLAGS := +endif + +ifndef MSVC + CLIBS_OPTS := $(CLIBS:%=-cclib -l%) +else + # MSVC libraries do not have 'lib' prefix + CLIBS_OPTS := $(CLIBS:%=-ccopt %.lib) +endif +ifneq ($(strip $(OBJ_LINK)),) + ifdef CREATE_LIB + OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) + else + OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) + endif +else + OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) +endif + +# If we have to make byte-code +ifndef REAL_OCAMLC + # EXTRADEPS is added dependencies we have to insert for all + # executable files we generate. Ideally it should be all of the + # libraries we use, but it's hard to find the ones that get searched on + # the path since I don't know the paths built into the compiler, so + # just include the ones with slashes in their names. + EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) + + REAL_OCAMLC := $(INTF_OCAMLC) + + REAL_IMPL := $(IMPL_CMO) + REAL_IMPL_INTF := $(IMPLO_INTF) + IMPL_SUF := .cmo + + DEPFLAGS := + MAKE_DEPS := $(MLDEPS) $(BCDEPIS) + + ifdef CREATE_LIB + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + MAKEDLL := $(DLLSONAME) + ALL_LDFLAGS := -dllib -l$(CLIB_BASE) + endif + endif + endif + + ifndef NO_CUSTOM + ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" + ALL_LDFLAGS += -custom + endif + endif + + ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ + $(COMMON_LDFLAGS) $(LIBS:%=%.cma) + CAMLIDLDLLFLAGS := + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif + +# we have to make native-code +else + EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + ifndef PROFILING + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + PLDFLAGS := + else + SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) + PLDFLAGS := -p + endif + + REAL_IMPL := $(IMPL_CMX) + REAL_IMPL_INTF := $(IMPLX_INTF) + IMPL_SUF := .cmx + + CFLAGS := -DNATIVE_CODE $(CFLAGS) + + DEPFLAGS := -native + MAKE_DEPS := $(MLDEPS) $(NCDEPIS) + + ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ + $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) + CAMLIDLDLLFLAGS := -opt + + ifndef CREATE_LIB + ALL_LDFLAGS += $(LIBS:%=%.cmxa) + endif + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif +endif + +export MAKE_DEPS + +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) + +ifdef make_deps + -include $(MAKE_DEPS) + PRE_TARGETS := +endif + +########################################################################### +# USER RULES + +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. +QUIET=@ + +# generates byte-code (default) +byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bc: byte-code + +byte-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bcnl: byte-code-nolink + +top: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes + +# generates native-code + +native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +nc: native-code + +native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncnl: native-code-nolink + +# generates byte-code libraries +byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" \ + CREATE_LIB=yes \ + make_deps=yes +bcl: byte-code-library + +# generates native-code libraries +native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +ncl: native-code-library + +ifdef WIN32 +# generates byte-code dll +byte-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).dll \ + REAL_RESULT="$(BCRESULT)" \ + make_deps=yes +bcd: byte-code-dll + +# generates native-code dll +native-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).dll \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncd: native-code-dll +endif + +# generates byte-code with debugging information +debug-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dc: debug-code + +# generates byte-code libraries with debugging information +debug-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcl: debug-code-library + +# generates byte-code for profiling +profiling-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + make_deps=yes +pbc: profiling-byte-code + +# generates native-code + +profiling-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PROFILING="y" \ + make_deps=yes +pnc: profiling-native-code + +# generates byte-code libraries +profiling-byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + CREATE_LIB=yes \ + make_deps=yes +pbcl: profiling-byte-code-library + +# generates native-code libraries +profiling-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" PROFILING="y" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +pncl: profiling-native-code-library + +# packs byte-code objects +pack-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ + REAL_RESULT="$(BCRESULT)" \ + PACK_LIB=yes make_deps=yes +pabc: pack-byte-code + +# packs native-code objects +pack-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(NCRESULT).cmx $(NCRESULT).o \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PACK_LIB=yes make_deps=yes +panc: pack-native-code + +# generates HTML-documentation +htdoc: doc/html + +# generates Latex-documentation +ladoc: doc/latex + +# generates PostScript-documentation +psdoc: doc/latex/doc.ps + +# generates PDF-documentation +pdfdoc: doc/latex/doc.pdf + +infodoc: doc/info + +mandoc: doc/man + +# generates all supported forms of documentation +doc: htdoc ladoc psdoc pdfdoc infodoc mandoc + +########################################################################### +# LOW LEVEL RULES + +$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(OCAMLFIND) $(REAL_OCAMLC) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o [EMAIL PROTECTED](EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamlc -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) + +ifdef WIN32 +$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) + $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ + -o $@ $(REAL_IMPL) +endif + +%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(OCAMLFIND) $(OCAMLMKTOP) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o [EMAIL PROTECTED](EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamltop -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ + .mly .di .d .$(EXT_LIB) .idl .c .$(EXT_CXX) .h .so \ + .rep .zog +ifndef MSVC +$(DLLSONAME): $(OBJ_LINK) + $(CC) -shared $(CINCFLAGS) $(CLIBFLAGS) \ + -o $@ $(OBJ_LINK) $(CLIBS:%=-l%) $(DLL_ADDITIONAL_CLIBS) +endif + +$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) + $(OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) + $(OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ + $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) + +$(RES_CLIB): $(OBJ_LINK) +ifndef MSVC + ifneq ($(strip $(OBJ_LINK)),) + ar rc $@ $(OBJ_LINK) + ranlib $@ + endif +else + ifneq ($(strip $(OBJ_LINK)),) + lib /nologo /debugtype:cv /out:$(RES_CLIB) $(OBJ_LINK) + endif +endif + +.mli.cmi: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(OCAMLFLAGS) $(INCFLAGS) $<; \ + else \ + echo $(OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp\" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + fi + +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + $(OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + else \ + echo $(OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp\" $(ALL_OCAMLCFLAGS) $<; \ + $(OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp" $(ALL_OCAMLCFLAGS) $<; \ + fi + +ifdef PACK_LIB +$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(OCAMLFIND) $(REAL_OCAMLC) $(PACKOPT) $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(REAL_IMPL) +endif + +.PRECIOUS: %.ml +%.ml: %.mll + $(OCAMLLEX) $< + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.mly + $(OCAMLYACC) $(YFLAGS) $< + +.PRECIOUS: %.ml +%.ml : %.rep + $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< + +.PRECIOUS: %.ml +%.ml : %.zog + $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ + +.PRECIOUS: %.ml %.mli %_stubs.c %.h +%.ml %.mli %_stubs.c %.h: %.idl + $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ + $(CAMLIDLFLAGS) $< + $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi + +.c.$(EXT_OBJ): + $(CC) -c $(CFLAGS) $(CINCFLAGS) -I'$(OCAMLLIBPATH)' \ + $< $(CFLAG_O)$@ + +.$(EXT_CXX).$(EXT_OBJ): + $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I'$(OCAMLLIBPATH)' \ + $< $(CFLAG_O)$@ + +$(MLDEPDIR)/%.d: %.ml + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLFIND) $(OCAMLDEP) $(OCAML_FIND_PACKAGES) \ + $(INCFLAGS) $< $(OCAMLDEP_FILTER) > $@; \ + else \ + $(OCAMLFIND) $(OCAMLDEP) $(OCAML_FIND_PACKAGES) \ + -pp "$$pp" $(INCFLAGS) $< $(OCAMLDEP_FILTER) > $@; \ + fi + +$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ + $(INCFLAGS) $< $(OCAMLDEP_FILTER) > $@; \ + else \ + $(OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ + -pp "$$pp" $(INCFLAGS) $< $(OCAMLDEP_FILTER) > $@; \ + fi + +doc/html: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) + +doc/latex: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + +doc/latex/doc.tex: doc/latex + $(OCAMLDOC) -latex -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) -o doc/latex/doc.tex + +doc/latex/doc.ps: doc/latex/doc.tex + cd doc/latex && \ + $(LATEX) doc.tex && \ + $(LATEX) doc.tex && \ + $(LATEX) doc.tex && \ + $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) + +doc/latex/doc.pdf: doc/latex/doc.ps + cd doc/latex && $(PS2PDF) $(<F) + +doc/man: $(DOC_FILES) + mkdir -p doc/man + $(OCAMLDOC) -man -d doc/man $(OCAMLDOCFLAGS) $(DOC_FILES) + +doc/info: $(DOC_FILES) + mkdir -p doc/info + $(OCAMLDOC) -texi -d doc/info $(OCAMLDOCFLAGS) $(DOC_FILES) -o bake.texi + cd doc/info && makeinfo bake.texi + +########################################################################### +# (UN)INSTALL RULES FOR LIBRARIES + +.PHONY: libinstall +libinstall: all + $(QUIET)printf "\nInstalling library with ocamlfind\n" + $(OCAMLFIND) install $(RESULT) META $(LIBINSTALL_FILES) + $(QUIET)printf "\nInstallation successful.\n" + +.PHONY: libuninstall +libuninstall: + $(QUIET)printf "\nUninstalling library with ocamlfind\n" + $(OCAMLFIND) remove $(RESULT) + $(QUIET)printf "\nUninstallation successful.\n" + +########################################################################### +# MAINTAINANCE RULES + +.PHONY: clean +clean: + rm -f $(TARGETS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: cleanup +cleanup: + rm -f $(NONEXECS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: clean-doc +clean-doc: + rm -rf doc + +.PHONY: nobackup +nobackup: + rm -f *.bak *~ *.dup Added: trunk/ocaml/server/client.ml =================================================================== --- trunk/ocaml/server/client.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/client.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,44 @@ +open Protocol + +type t = { + fd : Unix.file_descr; + input : in_channel; + output : out_channel; + address : string; + port : int; +} + + +let create (fd, ip, port) = { + fd = fd; + input = Unix.in_channel_of_descr fd; + output = Unix.out_channel_of_descr fd; + address = ip; + port = port; +} + +let int_of_file_descr fd = (Obj.magic (fd:Unix.file_descr) : int) + +let id c = int_of_file_descr c.fd + +let chomp s = + let last = (String.length s) - 1 in + if s.[last] = '\r' then + String.sub s 0 last + else s + +let read c = + let line = chomp (input_line c.input) in + Printf.printf "READ: %s\n" line; + flush stdout; + decode line + +let write c msg = + let line = ((encode msg) ^ "\r\n") in + Printf.printf "WRITE: %s" line; + flush stdout; + output_string c.output line; + flush c.output + + +let shutdown c = Net.shutdown c.fd Added: trunk/ocaml/server/entity.ml =================================================================== --- trunk/ocaml/server/entity.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/entity.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,290 @@ + +module StringNocase = +struct + type t = string + let compare a b = + String.compare (String.lowercase a) (String.lowercase b) +end + +module Int = +struct + type t = int + let compare = Pervasives.compare +end + +module StrSet = Set.Make(StringNocase) +module StrMap = Map.Make(StringNocase) +module IntMap = Map.Make(Int) + + +exception Exists +exception Missing of string + +let atomic mutex f = + Mutex.lock mutex; + let rv = try + f () + with e -> + Mutex.unlock mutex; + raise e + in + Mutex.unlock mutex; + rv + +module User = +struct + + type t = { + name: string; + version: string; + features: string list; + client: Client.t; + idle: int; + channels: StrSet.t; + } + + let id u = Client.id u.client + + let parse_features = function + Some s -> Str.split (Str.regexp ",") s + | None -> [] + + let create ?features ~version ~client name = + { + name = name; + version = version; + features = parse_features features; + client = client; + idle = 0; + channels = StrSet.empty; + } + + let name u = u.name + + let replace_channel name user = + { user with channels = StrSet.add name user.channels } + + let add_channel name user = + if StrSet.mem name user.channels then + raise Exists + else + replace_channel name user + + let remove_channel name user = + { user with channels = StrSet.remove name user.channels } + + let channels user = StrSet.elements user.channels + + let send msg user = Client.write user.client msg + + let shutdown user = Client.shutdown user.client +end + +module Channel = +struct + + type t = { + name: string; + owner: string; + users: StrSet.t; + } + let create ?(owner="") name = + { + name = name; + owner = owner; + users = StrSet.empty; + } + + let name u = u.name + + let replace_user name chan = + { chan with users = StrSet.add name chan.users } + + let add_user name chan = + if StrSet.mem name chan.users then + raise Exists + else + replace_user name chan + + let remove_user name chan = + { chan with users = StrSet.remove name chan.users } + + let users chan = StrSet.elements chan.users +end + + +module Lobby = +struct + type t = { + channels: Channel.t StrMap.t; + users: User.t StrMap.t; + clients: string IntMap.t; + } + + let create () = { + users = StrMap.empty; + channels = StrMap.empty; + clients = IntMap.empty; + } + + let find_user name lobby = + try + StrMap.find name lobby.users + with Not_found -> raise (Missing name) + + let find_user_by_id id lobby = + find_user (IntMap.find id lobby.clients) lobby + + let remove_user name lobby = + let id = User.id (find_user name lobby) in + { + lobby with + users = StrMap.remove name lobby.users; + clients = IntMap.remove id lobby.clients; + } + + let replace_user user lobby = + { + lobby with + users = StrMap.add (User.name user) user lobby.users; + clients = IntMap.add (User.id user) (User.name user) lobby.clients; + } + + let add_user user lobby = + if StrMap.mem (User.name user) lobby.users then + raise Exists + else + replace_user user lobby + + + let users lobby = + let f _ v accu = + v :: accu + in + StrMap.fold f lobby.users [] + + + let find_channel name lobby = + try + StrMap.find name lobby.channels + with Not_found -> raise (Missing name) + + let remove_channel name lobby = + { lobby with channels = StrMap.remove name lobby.channels } + + let replace_channel channel lobby = + { lobby with channels = StrMap.add (Channel.name channel) channel lobby.channels } + + let add_channel channel lobby = + if StrMap.mem (Channel.name channel) lobby.channels then + raise Exists + else + replace_channel channel lobby + + let channels lobby = + let f _ v accu = + v :: accu + in StrMap.fold f lobby.channels [] + + + let login ~version ~name ~features ~client lobby = + let user = + User.create + name + ~version: version + ~features: features + ~client: client + in + User.send ["HELLO"; name] user; + add_user user lobby + + let sendto uid msg lobby = + User.send msg (find_user uid lobby) + + let sendin cid msg lobby = + let chan = find_channel cid lobby in + let uids = Channel.users chan in + let users = List.map (fun uid -> find_user uid lobby) uids in + List.iter (User.send msg) users + + + let open_channel cid uid lobby = + let chan = Channel.create ~owner: uid cid in + let lobby' = add_channel chan lobby in + sendto uid ["OPEN"; cid] lobby'; + lobby' + + let join_channel cid uid lobby = + let chan = find_channel cid lobby in + let user = find_user uid lobby in + let user' = User.add_channel cid user in + let chan' = Channel.add_user uid chan in + let lobby' = replace_channel chan' lobby in + let lobby' = replace_user user' lobby' in + sendin cid ["JOIN"; cid; uid] lobby'; + lobby' + + let part_channel cid uid lobby = + let chan = find_channel cid lobby in + let user = find_user uid lobby in + let user' = User.remove_channel cid user in + let chan' = Channel.remove_user uid chan in + let lobby' = replace_channel chan' lobby in + let lobby' = replace_user user' lobby' in + sendin cid ["PART"; cid; uid] lobby'; + sendto uid ["PART"; cid; uid] lobby'; + lobby' + + let quit_channel cid uid lobby = + let chan = find_channel cid lobby in + let user = find_user uid lobby in + let user' = User.remove_channel cid user in + let chan' = Channel.remove_user uid chan in + let lobby' = replace_channel chan' lobby in + let lobby' = replace_user user' lobby' in + sendin cid ["QUIT"; cid; uid] lobby'; + lobby' + + let close_channel cid lobby = + let chan = find_channel cid lobby in + let uids = Channel.users chan in + let lobby' = + List.fold_left (fun lobby uid -> part_channel cid uid lobby) lobby uids + in + let lobby' = remove_channel cid lobby' in + List.iter (fun uid -> sendto uid ["CLOSE"; cid] lobby') uids; + lobby' + + + let quit' f uid msg lobby = + let user = find_user uid lobby in + let cids = User.channels user in + let part l cid = + quit_channel cid uid l + in + let lobby' = List.fold_left part lobby cids in + let lobby' = remove_user uid lobby' in + f user; + lobby' + + let quit uid msg lobby = + let f user = + User.send ("BYE" :: msg) user; + User.shutdown user + in + quit' f uid msg lobby + + + let quit_after_eof = quit' (User.shutdown) + + let lookup_client client lobby = + IntMap.find (Client.id client) lobby.clients + + let shutdown uid lobby = + quit_after_eof uid ["shutdown"] lobby + + +end + + + Added: trunk/ocaml/server/entity.mli =================================================================== --- trunk/ocaml/server/entity.mli 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/entity.mli 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,39 @@ + +exception Exists +exception Missing of string + +val atomic : Mutex.t -> (unit -> 'a) -> 'a + +module User : +sig + type t + val create : ?features:string -> version:string -> client:Client.t -> string -> t + val name : t -> string + val send : string list -> t -> unit + val channels : t -> string list +end + +module Channel : + sig + type t + val create : ?owner:string -> string -> t + val name : t -> string + end + +module Lobby : +sig + type t + val create : unit -> t + val login : version:string -> name:string -> features:string -> client:Client.t -> t -> t + val sendto : string -> string list -> t -> unit + val sendin : string -> string list -> t -> unit + val find_user : string -> t -> User.t + val open_channel : string -> string -> t -> t + val join_channel : string -> string -> t -> t + val part_channel : string -> string -> t -> t + val close_channel : string -> t -> t + val quit : string -> string list -> t -> t + val quit_after_eof : string -> string list -> t -> t + val lookup_client : Client.t -> t -> string + val shutdown : string -> t -> t +end Added: trunk/ocaml/server/listener.ml =================================================================== --- trunk/ocaml/server/listener.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/listener.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,14 @@ + + +let rec main sock = + let info = Net.accept sock in + let client = Client.create info in + Reader.start client; + main sock + +let start port = + Printf.printf "Listening for connection on port %d\n" port; + flush stdout; + Thread.create main (Net.listen port) + +let _ = Thread.join (start 7000) Added: trunk/ocaml/server/net.ml =================================================================== --- trunk/ocaml/server/net.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/net.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,41 @@ +open Unix + +let somaxcon = 3 + +let resolve name = + let host = gethostbyname name in + host.h_addr_list.(0) + +let connect host port = + let addr = resolve host in + let sockaddr = ADDR_INET (addr, port) in + open_connection sockaddr + +(* TODO: Use PF_INET when iface is an IPv6 IP *) +let listen ?(reuse=true) ?iface port = + let sock = socket PF_INET SOCK_STREAM 0 in + let addr = match iface with + None -> inet_addr_any + | Some ip -> inet_addr_of_string ip + in + let sockaddr = ADDR_INET(addr, port) in + setsockopt sock SO_REUSEADDR reuse; + bind sock sockaddr; + Unix.listen sock somaxcon; + sock + +let accept ssock = + let sock, sockaddr = Unix.accept ssock in + let ip, port = + match sockaddr with + ADDR_INET (addr, port) -> + string_of_inet_addr addr, port + | _ -> assert false + in + sock, ip, port + + + +let shutdown fd = + Unix.shutdown fd Unix.SHUTDOWN_ALL; + Unix.close fd Added: trunk/ocaml/server/ocaml.sql =================================================================== --- trunk/ocaml/server/ocaml.sql 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/ocaml.sql 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,55 @@ + + +CREATE TABLE ( + id SERIAL NOT NULL PRIMARY KEY, + namespace VARCHAR(20) NOT NULL, + name VARCHAR(20) NOT NULL, + + created TIMESTAMP DEFAULT now(), + active BOOLEAN NOT NULL DEFAULT FALSE, + persist BOOLEAN NOT NULL DEFAULT FALSE, + + + UNIQUE (namespace, name) +); + +CREATE TABLE avatar ( + address INET NOT NULL, + version TEXT NOT NULL, + authed BOOLEAN NOT NULL, + passcode VARCHAR(255), + email VARCHAR(255), + CHECK (namespace = 'user' OR namespace = 'service'), + PRIMARY KEY (id) +) INHERITS (entity); + + +CREATE TABLE channel ( + owner INTEGER NOT NULL REFERENCES avatar (id), + PRIMARY KEY (id) +) INHERITS (entity); + +CREATE TABLE registry ( + id SERIAL PRIMARY KEY, + entity INTEGER UNIQUE REFERENCES entity, + passcode VARCHAR(255) NOT NULL, + email VARCHAR(255) NOT NULL +); + +CREATE TABLE attr ( + id SERIAL PRIMARY KEY, + entity INTEGER REFERENCES entity, + key VARCHAR(20), + value TEXT, + UNIQUE (entity, key) +); + +CREATE TABLE perm ( + id SERIAL PRIMARY KEY, + location INTEGER REFERENCES entity DEFAULT 1, + entity INTEGER REFERENCES entity, + name VARCHAR(20) NOT NULL, + value INTEGER +); + +INSERT INTO entity (namespace, name, active) VALUES ('channel', '&lobby', TRUE); Added: trunk/ocaml/server/protocol.ml =================================================================== --- trunk/ocaml/server/protocol.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/protocol.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,44 @@ +open Str + +type t = string list + +let escape_re = regexp "[\r\027\n\t]" + +let escape s = + let esc c = Printf.sprintf "\027%c" c in + let sub s = + match matched_string s with + "\r" -> esc 'r' + | "\027" -> esc 'e' + | "\n" -> esc 'n' + | "\t" -> esc 't' + | s -> s + in + global_substitute escape_re sub s + +let unescape_re = regexp "\027\\([rent]\\)" +let unescape s = + let sub s = + match matched_group 1 s with + "r" -> "\r" + | "e" -> "\027" + | "n" -> "\n" + | "t" -> "\t" + | s -> s + in + global_substitute unescape_re sub s + + +let encode msg = + String.concat "\t" (List.map escape msg) + +let rec decode s = + try + let len = String.length s in + let pivot = String.index s '\t' in + let before = String.sub s 0 pivot in + let after = String.sub s (pivot + 1) (len - pivot - 1) in + (unescape before) :: (decode after) + with Not_found -> [ s ] + + Added: trunk/ocaml/server/reader.ml =================================================================== --- trunk/ocaml/server/reader.ml 2005-12-12 06:46:59 UTC (rev 957) +++ trunk/ocaml/server/reader.ml 2005-12-19 02:02:05 UTC (rev 958) @@ -0,0 +1,176 @@ +open Entity + +type state = + New of Client.t + | Login of string * string * Client.t + | Normal of string + +exception Shutdown of string list + +let shutdown x = raise (Shutdown x) + +let lobby = ref (Lobby.create ()) +let mutex = Mutex.create () + +let lobby_do f = f !lobby + +let lobby_update f = + atomic mutex begin + fun () -> + lobby := f !lobby + end + + +let fail uid msg = + lobby_do (Lobby.sendto uid ("FAIL" :: msg)) + +let process_new c msg = + let ver, sup = match msg with + "HAVER" :: version :: supports :: _ -> + (version, supports) + | "HAVER" :: version :: [] -> + (version, "") + | _ -> shutdown [] + in + Client.write c ["HAVER"; "hardison.net"; "HaverMLd/0.00"]; + Login (ver, sup, c) + +let process_login (ver, sup, client) msg = + match msg with + "IDENT" :: name :: _ -> + begin try + lobby_update ( + Lobby.login + ~name: name + ~version: ver + ~features: sup + ~client: client + ); + Normal name + with + Exists -> + Client.write client ["FAIL"; "IDENT"; "exists.user"; name]; + Login (ver, sup, client) + end + | _ -> shutdown ["bork"; "IDENT tastes better"] + +let process_normal self msg = + let norm = Normal self in + match msg with + "POKE" :: l -> + lobby_do (Lobby.sendto self ("OUCH" :: l)); + norm + | "TO" :: uid :: msg -> + begin try + lobby_do (Lobby.sendto uid ("FROM" :: self :: msg)); + with Missing uid -> + fail self ["unknown.user"; uid] + end; + norm + | "IN" :: cid :: msg -> + begin try + lobby_do (Lobby.sendin cid ("IN" :: cid :: self :: msg)) + with Missing cid -> + fail self ["IN"; "unknown.channel"; cid] + end; + norm + | "OPEN" :: cid :: _ -> + begin try + lobby_update (Lobby.open_channel cid self); + with Exists -> + fail self ["OPEN"; "exists.channel"; cid] + end; + norm + | "JOIN" :: cid :: _ -> + begin try + lobby_update (Lobby.join_channel cid self); + with + Exists -> + fail self ["JOIN"; "already.joined"; cid] + | Missing cid -> + fail self ["JOIN"; "unknown.channel"; cid] + end; + norm + | "BYE" :: msg :: [] -> + shutdown ["active"; msg] + | "BYE" :: [] -> + shutdown ["active"] + | "CHANS" :: l -> + let cids = User.channels (lobby_do (Lobby.find_user self)) in + lobby_do (Lobby.sendto self ("CHANS" :: cids)); + norm + | cmd :: _ -> + fail self [cmd; "unknown.cmd"]; + norm + | [] -> + shutdown ["bork"; "Your line is empty"] + +let process state msg = + match state with + New c -> process_new c msg + | Login (a,b,c) -> process_login (a,b,c) msg + | Normal name -> process_normal name msg + + +let rec loop state client = + let msg = Client.read client in + let state' = process state msg in + loop state' client + + + +let main client = + let exc = ref None in + Printf.printf "Connection from %s:%d (fd: %d)\n" + client.Client.address + client.Client.port + (Client.id client); + flush stdout; + + let ldo f x = lobby_do (f x) in + let wrap f = + try + let uid = ldo Lobby.lookup_client client in + f uid + with + Not_found -> Client.shutdown client + in + + begin try + loop (New client) client + with + End_of_file -> + wrap begin fun uid -> + lobby_update ( Lobby.quit_after_eof uid ["disconnect"; "EOF"] ) + end + | Shutdown [] -> + wrap begin fun uid -> + lobby_update ( Lobby.shutdown uid ) + end + | Shutdown msg -> + wrap begin fun uid -> + lobby_update ( Lobby.quit uid msg ) + end + | e -> + wrap begin fun uid -> + lobby_update ( Lobby.quit uid ["error"] ); + exc := Some e + end + end; + + Printf.printf "Connection lost from %s:%d\n" + client.Client.address + client.Client.port; + flush stdout; + + match !exc with + Some e -> + Printf.printf "Caught exception. Re-raising\n"; + flush stdout; + raise e + | None -> () + + +let start client = + ignore (Thread.create main client) +
