Permalink
Browse files

Merge branch 'sqlite'

  • Loading branch information...
2 parents fef36b6 + be34d96 commit 225f236907deacfff66f6946f7762e76e05e6678 @mfp committed Nov 16, 2010
Showing with 659 additions and 349 deletions.
  1. +3 −0 .gitmodules
  2. +20 −11 OMakefile
  3. +62 −59 README
  4. +114 −0 binlog.ml
  5. +8 −0 binlog.mli
  6. +33 −18 build.sh
  7. +0 −21 generate_prepared_statements.rb
  8. +0 −146 mq_pg_persistence.ml
  9. +0 −7 mq_pg_persistence.mli
  10. +6 −4 mq_server.ml
  11. +349 −0 mq_sqlite_persistence.ml
  12. +9 −0 mq_sqlite_persistence.mli
  13. +1 −0 ocaml-sqlexpr
  14. +32 −42 ocamlmq.ml
  15. +0 −23 pGOCaml_lwt.ml
  16. +0 −18 schema.sql
  17. +22 −0 test.ml
View
@@ -0,0 +1,3 @@
+[submodule "ocaml-sqlexpr"]
+ path = ocaml-sqlexpr
+ url = git://github.com/mfp/ocaml-sqlexpr.git
View
@@ -4,37 +4,46 @@ BYTE_ENABLED = true
OCAMLOPTFLAGS = -S -inline 100
USE_OCAMLFIND = true
+.SUBDIRS: ocaml-sqlexpr
+
OCAMLCFLAGS += -g -annot
-OCAMLFLAGS += -syntax camlp4o
-OCAMLDEPFLAGS += -syntax camlp4o
+OCAMLFINDFLAGS += -syntax camlp4o
+OCAMLINCLUDES += ocaml-sqlexpr
+OCAML_LIBS[] += ocaml-sqlexpr/sqlexpr
OCAMLPACKS[] =
+ csv
lwt
lwt.unix
lwt.syntax
+ estring
extlib
unix
str
- pgocaml
- pgocaml.syntax
+ sqlite3
camlp4.macro
OBJECTS[] =
+ binlog
extSet
mq_types
mq_stomp
- pGOCaml_lwt
- mq_pg_persistence
mq_server
+ mq_sqlite_persistence
ternary
- ocamlmq
-mq_schema.ml: schema.sql generate_prepared_statements.rb
- ruby generate_prepared_statements.rb create_db $< > $@
+section
+ OCAMLFINDFLAGS += -ppopt ocaml-sqlexpr/pa_sql.cmo
+ .SCANNER: scan-ocaml-%.ml: %.ml ocaml-sqlexpr/pa_sql.cmo
+ $(addsuffixes .cmi .cmx .cmo .o, mq_sqlite_persistence):
-.SCANNER: scan-ocaml-mq_pg_persistence.ml: mq_pg_persistence.ml mq_schema.ml
+OCamlProgram(ocamlmq, $(OBJECTS) ocamlmq)
-OCamlProgram(ocamlmq, $(OBJECTS))
+section
+ OCAMLPACKS[] += oUnit
+ TEST_FILES[] = $(removesuffix $(ls test*ml))
+ OCamlProgram(test, $(OBJECTS) $(TEST_FILES) test)
+ $(addsuffixes .cmi .cmo .cmx .o, $(TEST_FILES) test):
.DEFAULT: ocamlmq$(EXE)
View
121 README
@@ -4,8 +4,9 @@ suitable for implementing task queues and communication between subsystems:
* persistent queues, scaling over arbitrarily large numbers of queues with
constant memory usage (i.e. supports millions of queues)
-* strong durability guarantees: messages are guaranteed to have been saved to
- disk by the time the sender gets a message receipt
+* queued messages need not fit in memory
+* strong durability guarantees: messages can be guaranteed to have been saved
+ to disk (and fsync'ed) by the time the sender gets a message receipt
* message priorities
* per-subscription prefetch limit for queue messages
* error handling and ACK timeout: if a subscriber doesn't ACK a message
@@ -19,9 +20,11 @@ suitable for implementing task queues and communication between subsystems:
* simple extensions within the STOMP protocol to report the number of messages
in a queue and the number of subscribers to a queue or topic
-ocamlmq is written in OCaml, in less than 1200 lines of code. It is easy to
-extend and fairly efficient. The server is abstracted over a storage backend;
-currently only PostgreSQL's is implemented (< 150 lines of code).
+ocamlmq is written in OCaml, in ~1500 lines of code. It is easy to extend and
+fairly efficient. The server is abstracted over a storage backend; there are
+currently two backends:
+* PostgreSQL's (150 LoC)
+* sqlite with in-mem caching (350 LoC)
Scalability
===========
@@ -53,11 +56,8 @@ some limitations which preclude its use in other domains:
* there is no flow control for topic messages (in the intended use case, topic
messages are assumed to be relatively small and processed fast)
* messages are limited to 16 MB on 32-bit platforms
-* the PostgreSQL storage backend can only persist a few thousand
- messages per second (note that ocamlmq allows >50K/s persistent message
- bursts in async mode)
* ocamlmq does not support very high message rates (ocamlmq delivers only
- ~40K messages/second on a 3GHz AMD64 box)
+ ~60K messages/second on a 3GHz AMD64 box)
If you need complex routing rules, scalability to many thousand simultaneous
connections or other _enterprise_ messaging features, you'll be better served
@@ -71,75 +71,78 @@ Building
You'll need a working OCaml environment plus the following libraries:
* Lwt
* extlib
-* PGOCaml
+* ocaml-sqlite3
+* csv
+* estring
Additionally, ocamlmq requires PostgreSQL both at compile- and run-time.
-If you have omake, just do
+If you have omake, Just do
$ omake
-Otherwise, run
+otherwise, run
$ sh build.sh
-If the compilation fails with the following error
+Installing
+==========
- File "./mq_schema.ml", line 3, characters 21-327 (end at line 11, character 3):
- Camlp4: Uncaught exception: Unix.Unix_error (20 | CstTag21, "connect", "")
+The ocamlmq executable is self-contained and can be copied to any directory in
+your PATH if desired.
-you will have to provide some information using env. variables so that PGOCaml
-can connect to the PostgreSQL server (PGOCaml does this to check statically
-that all the SQL statements are valid), e.g.:
-
- PGHOST=localhost PGUSER=myself PGPASSWORD=myself omake --verbose
+Running
+=======
- or
+ocamlmq's configuration is given via the command line:
- PGHOST=localhost PGUSER=myself PGPASSWORD=myself sh build.sh
+Usage: ocamlmq [options] [sqlite3 database (default: ocamlmq.db)]
+ -port PORT Port to listen at (default: 61613)
+ -login LOGIN Login expected in CONNECT
+ -passcode PASSCODE Passcode expected in CONNECT
+ -maxmsgs N Keep at most N msgs in mem before hard flush (default: 100000)
+ -flush-period DT Hard flush period in seconds (default: 1.0)
+ -binlog FILE Use FILE as the binlog for msgs in mem (default: none)
+ -sync-binlog fsync the binlog on each write (default: no)
+ -debug Write debug info to stderr
+ -help Display this list of options
+ --help Display this list of options
+
+ocamlmq stores the messages in memory (and optionally in the binlog) and
+flushes to the permanent store (with full fsync) when either:
+* more than [maxmsgs] messages have been received since the last flush or
+* it's been [flush-period] seconds since the last flush
+
+With the -binlog option, the messages kept in mem will also be written to a
+binary log before they are flushed (and fsync'ed) to the permanent store.
+This way, in-mem (not yet flushed) messages can be recovered if ocamlmq were
+killed or crashed. You can moreover ensure that the binlog is fsync'ed after
+each write with -sync-binlog. This brings you the strongest durability
+guarantees, for every single message is fsync'ed before the broker
+acknowledges its reception.
+
+Performance
+===========
-This is the full list of options recognized by PGOcaml:
+Here follow some figures, taken on an oldish dual core AMD Athlon 64 X2 with a
+7200 RPM SATA disk.
- PGHOST
- PGPORT
- PGUSER
- PGPASSWORD
- PGDATABASE
- UNIX_DOMAIN_SOCKET_DIR
+Queueing (synchronously, with receipt)
-A temporary table will be created in the database while ocamlmq is compiled;
-no permanent changes will be made.
+ maxmsgs throughput throughput (-binlog)
+ ----------------------------------------------------
+ 1000 >11000 msg/s >9000 msg/s
+ 5000 >12000 msg/s >9000 msg/s
+ "infty" >17000 msg/s >14000 msg/s
-Running
-=======
+ If the binlog is enabled and -sync-binlog in use, the maximum throughput is
+ around 4000 msg/s.
-ocamlmq's configuration is given via the command line:
+Delivering:
- $ ./ocamlmq -help
- Usage: ocamlmq [options]
- -dbhost HOST Database server host.
- -dbport HOST Database server port.
- -dbdatabase DATABASE Database name.
- -dbsockdir DIR Database UNIX domain socket dir.
- -dbuser USER Database user.
- -dbpassword PASSWORD Database password.
- -dbmaxconns NUM Maximum size of DB connection pool.
- -port PORT Port to listen at (default: 61613).
- -login LOGIN Login expected in CONNECT.
- -passcode PASSCODE Passcode expected in CONNECT.
- -initdb Initialize the database (create required tables).
- -debug Write debug info to stderr.
- -help Display this list of options
- --help Display this list of options
-
-ocamlmq can create the required tables (currently, only one, named
-"ocamlmq_msgs") in the PostgreSQL table indicated with -dbdatabase (defaulting
-to one with the same name as the user) with the -initdb option, so you can try
-it with
-
- $ ./ocamlmq -dbdatabase mydatabase -initdb
-
-which will listen on port 61613 by default.
+Topic messages: >40000 msg/s.
+Queue messages in memory: >12000 msg/s
+Queue messages on disk: >2000 msg/s
STOMP protocol specifics
========================
View
114 binlog.ml
@@ -0,0 +1,114 @@
+open Lwt
+open Mq_types
+open Printf
+
+type t = { fd : Unix.file_descr; och : Lwt_io.output_channel }
+
+type record =
+ Add of message
+ | Del of string
+ | Nothing
+
+let truncate t =
+ Unix.ftruncate t.fd 0;
+ ignore (Unix.lseek t.fd 0 Unix.SEEK_SET)
+
+module LE = Lwt_io.LE
+
+let read_exactly ch n =
+ if n < 0 then fail End_of_file else
+ let s = String.create n in
+ Lwt_io.read_into_exactly ch s 0 n >>
+ return s
+
+let read_string ich =
+ lwt len = LE.read_int ich in
+ read_exactly ich len
+
+let read_record ich =
+ try_lwt
+ lwt kind = Lwt_io.read_char ich in
+ begin match kind with
+ 'A' ->
+ lwt id = read_string ich in
+ lwt dest = read_string ich in
+ lwt prio = LE.read_int ich in
+ lwt timestamp = LE.read_float64 ich in
+ lwt body = read_string ich in
+ lwt timeout = LE.read_float64 ich in
+ let r =
+ Add
+ {
+ msg_id = id; msg_destination = Queue dest;
+ msg_priority = prio; msg_timestamp = timestamp;
+ msg_body = body; msg_ack_timeout = timeout
+ }
+ in return r
+ | 'B' ->
+ lwt id = read_string ich in return (Del id)
+ | _ -> raise End_of_file
+ end
+ with End_of_file -> return Nothing
+
+let write_string och s =
+ LE.write_int och (String.length s) >>
+ Lwt_io.write och s
+
+let write_record och = function
+ Nothing -> return ()
+ | Del msg_id ->
+ Lwt_io.write_char och 'D' >> write_string och msg_id
+ | Add msg ->
+ Lwt_io.write_char och 'A' >>
+ write_string och msg.msg_id >>
+ write_string och (destination_name msg.msg_destination) >>
+ LE.write_int och msg.msg_priority >>
+ LE.write_float64 och msg.msg_timestamp >>
+ write_string och msg.msg_body >>
+ LE.write_float64 och msg.msg_ack_timeout
+
+let write_record ?(flush = true) och r =
+ Lwt_io.atomic (fun och -> write_record och r) och >>
+ if flush then Lwt_io.flush och else return ()
+
+let cancel t msg = write_record t.och (Del msg.msg_id)
+let add t msg = write_record t.och (Add msg)
+
+(* Creates [dst] even if [src] cannot be read *)
+let copy src dst =
+ Lwt_io.with_file
+ ~flags:[Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC]
+ ~mode:Lwt_io.output dst (fun _ -> return ()) >>
+ Lwt_io.with_file ~mode:Lwt_io.input src
+ (fun ich ->
+ Lwt_io.with_file
+ ~flags:[Unix.O_SYNC; Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC]
+ ~buffer_size:(1024 * 1024)
+ ~mode:Lwt_io.output dst
+ (fun och ->
+ let h = Hashtbl.create 13 in
+ let rec copy_loop () =
+ read_record ich >>= function
+ Add msg as x ->
+ Hashtbl.add h msg.msg_id msg;
+ write_record ~flush:false och x >> copy_loop ()
+ | Del msg_id as x ->
+ Hashtbl.remove h msg_id;
+ write_record ~flush:false och x >> copy_loop ()
+ | Nothing -> return ()
+ in copy_loop () >>
+ return (Hashtbl.fold (fun _ msg l -> msg :: l) h [])))
+
+let copy src dst =
+ try_lwt
+ copy src dst
+ with Unix.Unix_error (Unix.ENOENT, _, _) -> return []
+
+let make ?(sync = false) file =
+ let tmp = sprintf "%s.%d.%d" file (Unix.getpid ()) (Random.int 0x3FFFFFFF) in
+ lwt msgs = copy file tmp in
+ Sys.rename tmp file;
+ let sync = if sync then [ Unix.O_SYNC ] else [] in
+ let fd = Unix.openfile file ([ Unix.O_WRONLY; ] @ sync) 0o640 in
+ let och = Lwt_io.of_unix_fd ~mode:Lwt_io.output fd in
+ return ({ fd = fd; och = och; }, msgs)
View
@@ -0,0 +1,8 @@
+
+type t
+
+val make : ?sync:bool -> string -> (t * Mq_types.message list) Lwt.t
+val truncate : t -> unit
+val add : t -> Mq_types.message -> unit Lwt.t
+val cancel : t -> Mq_types.message -> unit Lwt.t
+
Oops, something went wrong.

0 comments on commit 225f236

Please sign in to comment.