├── .gitignore ├── .merlin ├── .ocp-indent ├── .travis.yml ├── COMPILING.md ├── LICENSE ├── Makefile ├── README.md ├── _tags ├── docker ├── docker-entrypoint.sh ├── opam.switch ├── run.sh └── ubuntu-18.04 │ └── Dockerfile ├── install_rocksdb.sh ├── myocamlbuild.ml ├── opam ├── rocks.ml ├── rocks.mli ├── rocks_common.ml ├── rocks_intf.ml ├── rocks_options.ml ├── rocks_test.ml ├── travis.sh └── which_g++.sh /.gitignore: -------------------------------------------------------------------------------- 1 | /_build/ 2 | /aname/ 3 | /*.native 4 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PRJ rocksdb 2 | 3 | S . 4 | B _build 5 | 6 | PKG ctypes 7 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=2,strict_else=never 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | language: c 3 | 4 | sudo: required 5 | 6 | install: ./travis.sh install 7 | script: ./travis.sh script 8 | 9 | git: 10 | submodules: false 11 | 12 | services: 13 | - docker 14 | 15 | env: 16 | - USE_CACHE=0 # set to 1 to enable 17 | -------------------------------------------------------------------------------- /COMPILING.md: -------------------------------------------------------------------------------- 1 | You need some opam packages 2 | ``` 3 | opam install ctypes.0.4.0 ctypes-foreign 4 | ``` 5 | 6 | 7 | You'll also need to install rocksdb. There's a script that can do this for you, see [install_rocksdb.sh]. 8 | [install_rocksdb.sh]: install_rocksdb.sh 9 | 10 | Afterwards run `make` in the root dir of this repository. 11 | The package can be installed with `make install`. 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Jan Doms 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OCAML_LIBDIR?=`ocamlfind printconf destdir` 2 | OCAML_FIND ?= ocamlfind 3 | 4 | ROCKS_LIBDIR ?= /usr/local/lib 5 | ROCKS_LIB ?= rocksdb 6 | export ROCKS_LIB ROCKS_LIBDIR 7 | 8 | ROCKS_LINKFLAGS = \ 9 | -lflag -cclib -lflag -Wl,-rpath,$(ROCKS_LIBDIR) \ 10 | -lflags -cclib,-L$(ROCKS_LIBDIR),-cclib,-l$(ROCKS_LIB) 11 | 12 | build: 13 | ocamlbuild -use-ocamlfind $(ROCKS_LINKFLAGS) rocks.inferred.mli rocks.cma rocks.cmxa rocks.cmxs rocks_options.inferred.mli 14 | 15 | test: 16 | ocamlbuild -use-ocamlfind $(ROCKS_LINKFLAGS) rocks_test.native rocks.inferred.mli rocks.cma rocks.cmxa rocks.cmxs 17 | ./rocks_test.native 18 | 19 | clean: 20 | ocamlbuild -clean 21 | rm -rf aname 22 | 23 | install: 24 | mkdir -p $(OCAML_LIBDIR) 25 | $(OCAML_FIND) install rocks -destdir $(OCAML_LIBDIR) _build/META \ 26 | _build/rocks.a \ 27 | _build/rocks.cma \ 28 | _build/rocks.cmi \ 29 | _build/rocks.cmx \ 30 | _build/rocks.cmxa \ 31 | _build/rocks.cmxs \ 32 | _build/rocks_intf.cmi \ 33 | _build/rocks_intf.cmx 34 | 35 | uninstall: 36 | $(OCAML_FIND) remove rocks -destdir $(OCAML_LIBDIR) 37 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ORocksDb 2 | ======== 3 | [![Build Status](https://travis-ci.org/domsj/orocksdb.svg?branch=master)](https://travis-ci.org/domsj/orocksdb) 4 | 5 | This repository contains some ocaml bindings to the C api of [rocksdb](http://github.com/facebook/rocksdb/). 6 | It is most certainly not complete. Not all available/implemented options have been tested. 7 | Additions and fixes are always welcome. 8 | 9 | The binding is used as part of https://github.com/openvstorage/alba. 10 | 11 | In case this library is not sufficient for your needs, then feel free to extend it, or to have a look at one of the alternatives: https://github.com/ahrefs/ocaml-ahrocksdb and https://github.com/chetmurthy/ocaml-rocksdb. 12 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true: annot, bin_annot, debug 2 | 3 | true: package(ctypes), package(ctypes.foreign) 4 | 5 | : -traverse 6 | -------------------------------------------------------------------------------- /docker/docker-entrypoint.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -l 2 | # this script is executed at each startup of the container 3 | 4 | trap 'rc=$?; echo "ERR at line ${LINENO} (rc: $rc)"; exit $rc' ERR 5 | set -e 6 | 7 | #if [ $HOST_UID -ne $UID ]; then 8 | # echo "UID mismatch; please build and run container under same UID" 2>&1 9 | # exit 1 10 | #fi 11 | 12 | cd /home/jenkins/orocksdb 13 | 14 | export OPAMROOT=/home/jenkins/OPAM 15 | 16 | eval $(opam config env --root=${OPAMROOT}) 17 | 18 | echo $PATH 19 | 20 | # finally execute the command the user requested 21 | cmd=${1-bash} 22 | echo "cmd=$cmd" 23 | 24 | case "$cmd" in 25 | bash|sh) 26 | shift || true 27 | exec $cmd "$@" 28 | ;; 29 | clean) 30 | make clean 31 | ;; 32 | build) 33 | make build 34 | ;; 35 | test) 36 | make test 37 | ;; 38 | esac 39 | -------------------------------------------------------------------------------- /docker/opam.switch: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | compiler: [ 3 | "base-bigarray.base" 4 | "base-threads.base" 5 | "base-unix.base" 6 | "ocaml.4.07.1" 7 | "ocaml-base-compiler.4.07.1" 8 | "ocaml-config.1" 9 | ] 10 | roots: ["ocaml-base-compiler.4.07.1"] 11 | installed: [ 12 | "base.v0.11.1" 13 | "base-bigarray.base" 14 | "base-bytes.base" 15 | "base-threads.base" 16 | "base-unix.base" 17 | "conf-libpcre.1" 18 | "conf-m4.1" 19 | "conf-pkg-config.1.1" 20 | "ctypes.0.14.0" 21 | "ctypes-foreign.0.4.0" 22 | "dune.1.10.0" 23 | "integers.0.2.2" 24 | "jbuilder.transition" 25 | "ocaml.4.07.1" 26 | "ocaml-base-compiler.4.07.1" 27 | "ocaml-compiler-libs.v0.11.0" 28 | "ocaml-config.1" 29 | "ocaml-inifiles.1.2" 30 | "ocaml-migrate-parsetree.1.2.0" 31 | "ocamlbuild.0.14.0" 32 | "ocamlfind.1.8.0" 33 | "pcre.7.4.1" 34 | "ppx_derivers.1.2.1" 35 | "result.1.4" 36 | "sexplib0.v0.11.0" 37 | "topkg.1.0.0" 38 | ] 39 | -------------------------------------------------------------------------------- /docker/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -ue 3 | [[ ${JENKINS_PARAM-} =~ shell_trace ]] && set -x 4 | 5 | IMAGE=$1 6 | shift 7 | 8 | docker build --rm=true \ 9 | --tag=orocksdb_$IMAGE \ 10 | --build-arg HOST_UID=$UID \ 11 | -f docker/$IMAGE/Dockerfile ./docker/ \ 12 | 13 | 14 | if [ -t 1 ]; 15 | then TTY="-t"; 16 | else TTY=""; 17 | fi 18 | 19 | docker run -i $TTY --privileged=true \ 20 | --env HOST_UID=$UID \ 21 | --env JENKINS_PARAM="${JENKINS_PARAM-}" \ 22 | --env TRAVIS \ 23 | --ulimit core=-1 \ 24 | -v ${PWD}:/home/jenkins/orocksdb \ 25 | orocksdb_$IMAGE \ 26 | "$@" 27 | -------------------------------------------------------------------------------- /docker/ubuntu-18.04/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:bionic-20190307 2 | 3 | ENV release_name=bionic 4 | ENV rocksdb_version=5.11.3 5 | ENV ocaml_version=4.07.1 6 | 7 | # force our apt to use look at mirrors (by prepending a mirrors line) 8 | # RUN sed 's@archive.ubuntu.com@ubuntu.mirror.atratoip.net@' -i /etc/apt/sources.list 9 | RUN sed -i "1s;^;deb mirror://mirrors.ubuntu.com/mirrors.txt ${release_name}-updates main restricted universe multiverse\n;" /etc/apt/sources.list 10 | RUN sed -i "1s;^;deb mirror://mirrors.ubuntu.com/mirrors.txt ${release_name} main restricted universe multiverse\n;" /etc/apt/sources.list 11 | 12 | RUN apt-get update && DEBIAN_FRONTEND=noninteractive apt-get install -y \ 13 | build-essential m4 apt-utils \ 14 | lcov \ 15 | libffi-dev libssl-dev \ 16 | libbz2-dev \ 17 | libgmp3-dev \ 18 | libev-dev \ 19 | libsnappy-dev \ 20 | libxen-dev \ 21 | help2man \ 22 | pkg-config \ 23 | time \ 24 | aspcud \ 25 | wget \ 26 | rsync \ 27 | darcs \ 28 | git \ 29 | unzip \ 30 | yasm \ 31 | automake \ 32 | debhelper \ 33 | psmisc \ 34 | strace \ 35 | curl \ 36 | g++ \ 37 | libgflags-dev \ 38 | sudo \ 39 | libtool \ 40 | fuse \ 41 | sysstat \ 42 | ncurses-dev \ 43 | liburiparser1 \ 44 | tzdata \ 45 | binutils-dev \ 46 | libpcre3-dev \ 47 | patchelf \ 48 | socat \ 49 | libcurl4-openssl-dev \ 50 | equivs \ 51 | libgtest-dev \ 52 | help2man \ 53 | zlib1g-dev \ 54 | cmake 55 | 56 | RUN cd /usr/src/gtest \ 57 | && cmake . \ 58 | && make \ 59 | && mv libg* /usr/lib/ 60 | 61 | ARG HOST_UID 62 | RUN useradd jenkins -u $HOST_UID -g root --create-home 63 | #RUN echo "jenkins ALL=NOPASSWD: ALL" >/etc/sudoers.d/jenkins 64 | 65 | # Install rocksdb: 66 | RUN wget -q \ 67 | https://github.com/facebook/rocksdb/archive/v${rocksdb_version}.tar.gz -O - \ 68 | | tar zxf - \ 69 | && PORTABLE=1 make -j$(nproc 2>/dev/null || echo 1) -C rocksdb-${rocksdb_version} shared_lib \ 70 | && sudo make -C rocksdb-${rocksdb_version} install-shared \ 71 | && rm -rf rocksdb-${rocksdb_version} 72 | 73 | RUN wget https://github.com/ocaml/opam/releases/download/2.0.3/opam-2.0.3-x86_64-linux \ 74 | && mv opam-2.0.3-x86_64-linux /usr/bin/opam \ 75 | && chmod a+x /usr/bin/opam 76 | 77 | ENV OPAMROOT=/home/jenkins/OPAM 78 | 79 | env opam_env="opam config env --root=${OPAMROOT}" 80 | 81 | RUN opam init --root ${OPAMROOT} --compiler=${ocaml_version} --disable-sandboxing 82 | ADD opam.switch opam.switch 83 | RUN eval `${opam_env}` && export OPAMROOT=${OPAMROOT} && \ 84 | opam switch import opam.switch -y --strict 85 | 86 | RUN eval ${opam_env} && export OPAMROOT=${OPAMROOT} && \ 87 | opam list && \ 88 | opam switch export opam.switch.out && \ 89 | cat opam.switch.out 90 | 91 | RUN diff -u opam.switch opam.switch.out 92 | 93 | RUN su - -c "echo 'eval `${opam_env}`' >> /home/jenkins/.profile" 94 | RUN su - -c "echo 'LD_LIBRARY_PATH=/usr/local/lib; export LD_LIBRARY_PATH;' >> /home/jenkins/.profile" 95 | RUN echo "jenkins ALL=NOPASSWD: ALL" >/etc/sudoers.d/jenkins 96 | 97 | ENTRYPOINT ["/home/jenkins/orocksdb/docker/docker-entrypoint.sh"] 98 | -------------------------------------------------------------------------------- /install_rocksdb.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -xue 2 | 3 | echo $(gcc --version) 4 | 5 | VERSION=5.11.3 6 | shared_lib_file="/usr/local/lib/librocksdb.so.${VERSION}" 7 | if [ -e $shared_lib_file ]; then 8 | echo "$shared_lib_file exists" 9 | else 10 | echo "cloning, building, installing rocksdb" 11 | git clone https://github.com/facebook/rocksdb/ 12 | cd rocksdb 13 | git checkout tags/rocksdb-${VERSION} 14 | PORTABLE=1 make shared_lib 15 | sudo make uninstall 16 | sudo make install-shared 17 | sudo ldconfig 18 | fi 19 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin 2 | open Unix 3 | 4 | let run_cmd cmd = 5 | try 6 | let ch = Unix.open_process_in cmd in 7 | let line = input_line ch in 8 | let () = close_in ch in 9 | line 10 | with | End_of_file -> "Not available" 11 | 12 | let from_env_or_cmd envvar cmd = 13 | try Unix.getenv envvar 14 | with Not_found -> run_cmd cmd 15 | 16 | let make_version_and_meta _ _ = 17 | let (major,minor,patch) = 18 | try 19 | let tag_version = 20 | from_env_or_cmd 21 | "OROCKSDB_TAG_VERSION" 22 | "git describe --tags --exact-match --dirty" 23 | in 24 | Scanf.sscanf tag_version "%i.%i.%i" (fun ma mi p -> (ma,mi,p)) 25 | with _ -> 26 | let branch_version = run_cmd "git describe --all" in 27 | try Scanf.sscanf branch_version "heads/%i.%i" (fun ma mi -> (ma,mi,-1)) 28 | with _ -> (-1,-1,-1) 29 | in 30 | let git_revision = 31 | from_env_or_cmd 32 | "OROCKSDB_GIT_REVISION" 33 | "git describe --all --long --always --dirty" 34 | in 35 | let lines = [ 36 | Printf.sprintf "let major = %i\n" major; 37 | Printf.sprintf "let minor = %i\n" minor; 38 | Printf.sprintf "let patch = %i\n" patch; 39 | Printf.sprintf "let git_revision = %S\n" git_revision; 40 | "let summary = (major, minor , patch , git_revision)\n" 41 | ] 42 | in 43 | let write_version = Echo (lines, "rocks_version.ml") in 44 | let clean_version = 45 | match patch with 46 | | -1 -> git_revision 47 | | _ -> Printf.sprintf "%i.%i.%i" major minor patch 48 | in 49 | let rocks_libdir = 50 | try Unix.getenv "ROCKS_LIBDIR" 51 | with Not_found -> 52 | failwith "MUST set ROCKS_LIBDIR to build" in 53 | let rocks_lib = 54 | try Unix.getenv "ROCKS_LIB" 55 | with Not_found -> 56 | failwith "MUST set ROCKS_LIB to build" in 57 | let linkopts = 58 | Printf.sprintf "-cclib -Wl,-rpath=%s -cclib -L%s -cclib -l%s" 59 | rocks_libdir rocks_libdir rocks_lib in 60 | let meta_lines = [ 61 | "description = \"Rocksdb binding\"\n"; 62 | Printf.sprintf "version = %S\n" clean_version; 63 | "exists_if = \"rocks.cma,rocks.cmxa,rocks.cmxs\"\n"; 64 | "requires = \"ctypes ctypes.foreign\"\n"; 65 | "archive(native) = \"rocks.cmxa\"\n"; 66 | "archive(byte) = \"rocks.cma\"\n"; 67 | Printf.sprintf "linkopts = \"%s\"" linkopts ; 68 | ] 69 | in 70 | let write_meta = Echo (meta_lines, "META") in 71 | Seq [write_version;write_meta] 72 | 73 | 74 | let _ = 75 | dispatch 76 | & function 77 | | After_rules -> 78 | rule "rocks_version.ml" ~prod:"rocks_version.ml" make_version_and_meta; 79 | | _ -> () 80 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "orocksdb" 3 | version: "0.3.0" 4 | maintainer: "Jan Doms " 5 | authors: "Jan Doms " 6 | homepage: "https://github.com/domsj/orocksdb" 7 | bug-reports: "https://github.com/domsj/orocksdb" 8 | license: "MIT" 9 | dev-repo: "https://github.com/domsj/orocksdb.git" 10 | env: [ OROCKSDB_TAG_VERSION = "0.3.0" 11 | OROCKSDB_GIT_REVISION = "none" 12 | ] 13 | build: [ [ make ] ] 14 | install: [ make "install" ] 15 | remove: [ "ocamlfind" "remove" "rocks" ] 16 | depends: [ 17 | "ocamlfind" {build} 18 | "ocamlbuild" {build} 19 | "ctypes" {>= "0.4.0"} 20 | "ctypes-foreign" {>= "0.4.0"} 21 | ] 22 | depopts:[ 23 | [[ "debian" ] [ "g++-4.8" ]] 24 | [[ "ubuntu" ] [ "g++-4.8" ]] 25 | ] 26 | depexts:[ 27 | [[ "debian" ] [ "libgflags-dev" "libsnappy-dev" "libbz2-dev" ]] 28 | [[ "ubuntu" ] [ "libgflags-dev" "libsnappy-dev" "libbz2-dev" ]] 29 | [[ "source" "linux" ] [ "https://gist.githubusercontent.com/domsj/a801de01d33233229357413e9816e513/raw/ff3a93775134d8063a955ca8e10860af69687e7f/execute-local-install-rocksdb-script.sh" ]] 30 | ] 31 | -------------------------------------------------------------------------------- /rocks.ml: -------------------------------------------------------------------------------- 1 | open Ctypes 2 | open Foreign 3 | open Rocks_common 4 | 5 | type bigarray = Rocks_intf.bigarray 6 | 7 | module Views = Views 8 | 9 | exception OperationOnInvalidObject = Rocks_common.OperationOnInvalidObject 10 | 11 | module WriteBatch = struct 12 | module C = CreateConstructors_(struct let name = "writebatch" end) 13 | include C 14 | 15 | let clear = 16 | foreign 17 | "rocksdb_writebatch_clear" 18 | (t @-> returning void) 19 | 20 | let count = 21 | foreign 22 | "rocksdb_writebatch_count" 23 | (t @-> returning int) 24 | 25 | let put_raw = 26 | foreign 27 | "rocksdb_writebatch_put" 28 | (t @-> 29 | ptr char @-> Views.int_to_size_t @-> 30 | ptr char @-> Views.int_to_size_t @-> returning void) 31 | 32 | let put_raw_string = 33 | foreign 34 | "rocksdb_writebatch_put" 35 | (t @-> 36 | ocaml_string @-> Views.int_to_size_t @-> 37 | ocaml_string @-> Views.int_to_size_t @-> returning void) 38 | 39 | let put ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len batch key value = 40 | let open Bigarray.Array1 in 41 | let key_len = match key_len with None -> dim key - key_pos | Some len -> len in 42 | let value_len = match value_len with None -> dim value - value_pos | Some len -> len in 43 | put_raw 44 | batch 45 | (bigarray_start array1 key +@ key_pos) key_len 46 | (bigarray_start array1 value +@ value_pos) value_len 47 | 48 | let put_string ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len batch key value = 49 | let key_len = match key_len with None -> String.length key - key_pos | Some len -> len in 50 | let value_len = match value_len with None -> String.length value - value_pos | Some len -> len in 51 | put_raw_string batch 52 | (ocaml_string_start key +@ key_pos) key_len 53 | (ocaml_string_start value +@ value_pos) value_len 54 | 55 | let delete_raw = 56 | foreign 57 | "rocksdb_writebatch_delete" 58 | (t @-> ptr char @-> Views.int_to_size_t @-> returning void) 59 | 60 | let delete_raw_string = 61 | foreign 62 | "rocksdb_writebatch_delete" 63 | (t @-> ocaml_string @-> Views.int_to_size_t @-> returning void) 64 | 65 | let delete ?(pos=0) ?len batch key = 66 | let open Bigarray.Array1 in 67 | let len = match len with None -> dim key - pos | Some len -> len in 68 | delete_raw batch (bigarray_start array1 key +@ pos) len 69 | 70 | let delete_string ?(pos=0) ?len batch key = 71 | let len = match len with None -> String.length key - pos | Some len -> len in 72 | delete_raw_string batch (ocaml_string_start key +@ pos) len 73 | end 74 | 75 | module Version = Rocks_version 76 | 77 | let returning_error typ = ptr string_opt @-> returning typ 78 | 79 | let with_err_pointer f = 80 | let err_pointer = allocate string_opt None in 81 | let res = f err_pointer in 82 | match !@ err_pointer with 83 | | None -> res 84 | | Some err -> failwith err 85 | 86 | module rec Iterator : Rocks_intf.ITERATOR with type db := RocksDb.t = struct 87 | module ReadOptions = Rocks_options.ReadOptions 88 | type nonrec t = t 89 | let t = t 90 | 91 | type db 92 | let db = t 93 | 94 | let get_pointer = get_pointer 95 | 96 | exception InvalidIterator 97 | 98 | let create_no_gc = 99 | foreign 100 | "rocksdb_create_iterator" 101 | (db @-> ReadOptions.t @-> returning t) 102 | 103 | let destroy = 104 | let inner = 105 | foreign 106 | "rocksdb_iter_destroy" 107 | (t @-> returning void) 108 | in 109 | fun t -> 110 | inner t; 111 | t.valid <- false 112 | 113 | let create ?opts db = 114 | let inner opts = 115 | let t = create_no_gc db opts in 116 | Gc.finalise destroy t; 117 | t 118 | in 119 | match opts with 120 | | None -> ReadOptions.with_t inner 121 | | Some opts -> inner opts 122 | 123 | let with_t ?opts db ~f = 124 | let inner opts = 125 | let t = create_no_gc db opts in 126 | finalize (fun () -> f t) (fun () -> destroy t) 127 | in 128 | match opts with 129 | | None -> ReadOptions.with_t inner 130 | | Some opts -> inner opts 131 | 132 | let is_valid = 133 | foreign 134 | "rocksdb_iter_valid" 135 | (t @-> returning Views.bool_to_uchar) 136 | 137 | let seek_to_first = 138 | foreign 139 | "rocksdb_iter_seek_to_first" 140 | (t @-> returning void) 141 | 142 | let seek_to_last = 143 | foreign 144 | "rocksdb_iter_seek_to_last" 145 | (t @-> returning void) 146 | 147 | let seek_raw = 148 | foreign 149 | "rocksdb_iter_seek" 150 | (t @-> ptr char @-> Views.int_to_size_t @-> returning void) 151 | 152 | let seek_raw_string = 153 | foreign 154 | "rocksdb_iter_seek" 155 | (t @-> ocaml_string @-> Views.int_to_size_t @-> returning void) 156 | 157 | let seek ?(pos=0) ?len t key = 158 | let open Bigarray.Array1 in 159 | let len = match len with None -> dim key - pos | Some len -> len in 160 | seek_raw t (bigarray_start array1 key +@ pos) len 161 | 162 | let seek_string ?(pos=0) ?len t key = 163 | let len = match len with None -> String.length key - pos | Some len -> len in 164 | seek_raw_string t (ocaml_string_start key +@ pos) len 165 | 166 | let next = 167 | foreign 168 | "rocksdb_iter_next" 169 | (t @-> returning void) 170 | 171 | let prev = 172 | foreign 173 | "rocksdb_iter_prev" 174 | (t @-> returning void) 175 | 176 | let get_key_raw = 177 | let inner = 178 | foreign "rocksdb_iter_key" (t @-> ptr Views.int_to_size_t @-> returning (ptr char)) 179 | in 180 | fun t size -> if is_valid t then inner t size else raise InvalidIterator 181 | 182 | let get_key t = 183 | let res_size = allocate Views.int_to_size_t 0 in 184 | let res = get_key_raw t res_size in 185 | if (to_voidp res) = null 186 | then failwith (Printf.sprintf "could not get key, is_valid=%b" (is_valid t)) 187 | else bigarray_of_ptr array1 (!@res_size) Bigarray.char res 188 | 189 | let get_key_string t = 190 | let res_size = allocate Views.int_to_size_t 0 in 191 | let res = get_key_raw t res_size in 192 | if (to_voidp res) = null 193 | then failwith (Printf.sprintf "could not get key, is_valid=%b" (is_valid t)) 194 | else string_from_ptr res (!@ res_size) 195 | 196 | let get_value_raw = 197 | let inner = 198 | foreign "rocksdb_iter_value" (t @-> ptr Views.int_to_size_t @-> returning (ptr char)) 199 | in 200 | fun t size -> if is_valid t then inner t size else raise InvalidIterator 201 | 202 | let get_value t = 203 | let res_size = allocate Views.int_to_size_t 0 in 204 | let res = get_value_raw t res_size in 205 | if (to_voidp res) = null 206 | then failwith (Printf.sprintf "could not get value, is_valid=%b" (is_valid t)) 207 | else bigarray_of_ptr array1 (!@res_size) Bigarray.char res 208 | 209 | let get_value_string t = 210 | let res_size = allocate Views.int_to_size_t 0 in 211 | let res = get_value_raw t res_size in 212 | if (to_voidp res) = null 213 | then failwith (Printf.sprintf "could not get value, is_valid=%b" (is_valid t)) 214 | else string_from_ptr res (!@ res_size) 215 | 216 | let get_error_raw = 217 | foreign 218 | "rocksdb_iter_get_error" 219 | (t @-> ptr string_opt @-> returning void) 220 | 221 | let get_error t = 222 | let err_pointer = allocate string_opt None in 223 | get_error_raw t err_pointer; 224 | !@err_pointer 225 | end 226 | 227 | and Transaction : Rocks_intf.TRANSACTION with type db := RocksDb.t and type iter := Iterator.t = struct 228 | module ReadOptions = Rocks_options.ReadOptions 229 | module WriteOptions = Rocks_options.WriteOptions 230 | module TransactionOptions = Rocks_options.TransactionOptions 231 | module Snapshot = Rocks_options.Snapshot 232 | 233 | let name = "transaction" 234 | let destructor = "rocksdb_" ^ name ^ "_destroy" 235 | 236 | type db = t 237 | let db = t 238 | 239 | type nonrec t = t 240 | let t = t 241 | 242 | let txnbegin_raw = 243 | foreign 244 | "rocksdb_transaction_begin" 245 | (db @-> WriteOptions.t @-> TransactionOptions.t @-> ptr void @-> 246 | returning t) 247 | 248 | let destroy = make_destroy t destructor 249 | 250 | let txnbegin_no_gc ?wopts ?txnopts db = 251 | let inner wopts txnopts = 252 | txnbegin_raw db wopts txnopts null in 253 | match wopts, txnopts with 254 | None, None -> TransactionOptions.with_t (fun txnopts -> 255 | (WriteOptions.with_t (fun wopts -> 256 | inner wopts txnopts))) 257 | | Some wopts, None -> TransactionOptions.with_t (inner wopts) 258 | | None, Some txnopts -> (WriteOptions.with_t (fun wopts -> 259 | inner wopts txnopts)) 260 | | Some wopts, Some txnopts -> inner wopts txnopts 261 | 262 | let txnbegin ?wopts ?txnopts db = 263 | let t = txnbegin_no_gc ?wopts ?txnopts db in 264 | Gc.finalise destroy t; 265 | t 266 | 267 | let commit_raw = 268 | foreign "rocksdb_transaction_commit" 269 | (t @-> returning_error void) 270 | 271 | let commit t = 272 | with_err_pointer (commit_raw t) 273 | 274 | let rollback_raw = 275 | foreign "rocksdb_transaction_rollback" 276 | (t @-> returning_error void) 277 | 278 | let rollback t = 279 | with_err_pointer (rollback_raw t) 280 | 281 | let with_t db f = 282 | let t = txnbegin_no_gc db in 283 | finalize 284 | (fun () -> f t) 285 | (fun () -> destroy t) 286 | 287 | let put_raw = 288 | foreign 289 | "rocksdb_transaction_put" 290 | (t @-> 291 | ptr char @-> Views.int_to_size_t @-> 292 | ptr char @-> Views.int_to_size_t @-> 293 | returning_error void) 294 | 295 | let put_raw_string = 296 | foreign 297 | "rocksdb_transaction_put" 298 | (t @-> 299 | ocaml_string @-> Views.int_to_size_t @-> 300 | ocaml_string @-> Views.int_to_size_t @-> 301 | returning_error void) 302 | 303 | let put ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len ?opts t key value = 304 | let open Bigarray.Array1 in 305 | let key_len = match key_len with None -> dim key - key_pos | Some len -> len in 306 | let value_len = match value_len with None -> dim value - value_pos | Some len -> len in 307 | with_err_pointer begin 308 | put_raw t 309 | (bigarray_start array1 key +@ key_pos) key_len 310 | (bigarray_start array1 value +@ value_pos) value_len 311 | end 312 | 313 | let put_string ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len ?opts t key value = 314 | let key_len = match key_len with None -> String.length key - key_pos | Some len -> len in 315 | let value_len = match value_len with None -> String.length value - value_pos | Some len -> len in 316 | with_err_pointer begin 317 | put_raw_string t 318 | (ocaml_string_start key +@ key_pos) key_len 319 | (ocaml_string_start value +@ value_pos) value_len 320 | end 321 | 322 | let delete_raw = 323 | foreign 324 | "rocksdb_transaction_delete" 325 | (t @-> 326 | ptr char @-> Views.int_to_size_t @-> 327 | returning_error void) 328 | 329 | let delete_raw_string = 330 | foreign 331 | "rocksdb_transaction_delete" 332 | (t @-> 333 | ocaml_string @-> Views.int_to_size_t @-> 334 | returning_error void) 335 | 336 | let delete ?(pos=0) ?len ?opts t key = 337 | let open Bigarray.Array1 in 338 | let len = match len with None -> dim key - pos | Some len -> len in 339 | with_err_pointer (delete_raw t (bigarray_start array1 key +@ pos) len) 340 | 341 | let delete_string ?(pos=0) ?len ?opts t key = 342 | let len = match len with None -> String.length key - pos | Some len -> len in 343 | with_err_pointer (delete_raw_string t (ocaml_string_start key +@ pos) len) 344 | 345 | let get_raw = 346 | foreign 347 | "rocksdb_transaction_get" 348 | (t @-> ReadOptions.t @-> 349 | ptr char @-> Views.int_to_size_t @-> ptr Views.int_to_size_t @-> 350 | returning_error (ptr char)) 351 | 352 | let get_raw_string = 353 | foreign 354 | "rocksdb_transaction_get" 355 | (t @-> ReadOptions.t @-> 356 | ocaml_string @-> Views.int_to_size_t @-> ptr Views.int_to_size_t @-> 357 | returning_error (ptr char)) 358 | 359 | let get ?(pos=0) ?len ?opts t key = 360 | let open Bigarray.Array1 in 361 | let len = match len with None -> dim key - pos | Some len -> len in 362 | let inner opts = 363 | let res_size = allocate Views.int_to_size_t 0 in 364 | let res = with_err_pointer 365 | (get_raw t opts (bigarray_start array1 key +@ pos) len res_size) 366 | in 367 | if (to_voidp res) = null 368 | then None 369 | else begin 370 | let res' = bigarray_of_ptr array1 (!@res_size) Bigarray.char res in 371 | Gc.finalise_last (fun () -> free (to_voidp res)) res'; 372 | Some res' 373 | end 374 | in 375 | match opts with 376 | | Some opts -> inner opts 377 | | None -> ReadOptions.with_t inner 378 | 379 | let get_string ?(pos=0) ?len ?opts t key = 380 | let len = match len with None -> String.length key - pos | Some len -> len in 381 | let inner opts = 382 | let res_size = allocate Views.int_to_size_t 0 in 383 | let res = with_err_pointer 384 | (get_raw_string t opts (ocaml_string_start key +@ pos) len res_size) 385 | in 386 | if (to_voidp res) = null 387 | then None 388 | else begin 389 | let res' = string_from_ptr res (!@ res_size) in 390 | Gc.finalise_last (fun () -> free (to_voidp res)) res'; 391 | Some res' 392 | end 393 | in 394 | match opts with 395 | | Some opts -> inner opts 396 | | None -> ReadOptions.with_t inner 397 | 398 | let get_snapshot = 399 | foreign "rocksdb_transaction_get_snapshot" 400 | (t @-> returning Snapshot.t) 401 | 402 | let free_snapshot = 403 | foreign "rocksdb_free" 404 | (Snapshot.t @-> returning void) 405 | 406 | let create_iterator_no_gc = 407 | foreign 408 | "rocksdb_transaction_create_iterator" 409 | (t @-> ReadOptions.t @-> returning t) 410 | 411 | let destroy_iterator = 412 | let inner = 413 | foreign 414 | "rocksdb_iter_destroy" 415 | (t @-> returning void) 416 | in 417 | fun t -> inner t; 418 | t.valid <- false 419 | 420 | let create_iterator ?opts txn = 421 | let inner opts = 422 | let t = create_iterator_no_gc txn opts in 423 | Gc.finalise destroy_iterator t; 424 | t 425 | in 426 | match opts with 427 | | None -> ReadOptions.with_t inner 428 | | Some opts -> inner opts 429 | 430 | let with_iterator ?opts txn ~f = 431 | let inner opts = 432 | let t = create_iterator_no_gc txn opts in 433 | finalize 434 | (fun () -> f t) 435 | (fun () -> destroy_iterator t) 436 | in 437 | match opts with 438 | | None -> ReadOptions.with_t inner 439 | | Some opts -> inner opts 440 | end 441 | 442 | and RocksDb : Rocks_intf.ROCKS with type batch := WriteBatch.t = struct 443 | module ReadOptions = Rocks_options.ReadOptions 444 | module WriteOptions = Rocks_options.WriteOptions 445 | module FlushOptions = Rocks_options.FlushOptions 446 | module Options = Rocks_options.Options 447 | module Cache = Rocks_options.Cache 448 | module Snapshot = Rocks_options.Snapshot 449 | module BlockBasedTableOptions = Rocks_options.BlockBasedTableOptions 450 | module TransactionDbOptions = Rocks_options.TransactionDbOptions 451 | 452 | type nonrec t = t 453 | type batch 454 | 455 | let t = t 456 | 457 | let get_pointer = get_pointer 458 | 459 | let open_db_raw = 460 | foreign 461 | "rocksdb_open" 462 | (Options.t @-> string @-> ptr string_opt @-> returning t) 463 | 464 | let open_db_for_read_only_raw = 465 | foreign 466 | "rocksdb_open_for_read_only" 467 | (Options.t @-> string @-> Views.bool_to_uchar @-> ptr string_opt @-> returning t) 468 | 469 | let open_transactiondb_raw = 470 | foreign 471 | "rocksdb_transactiondb_open" 472 | (Options.t @-> TransactionDbOptions.t @-> string @-> ptr string_opt @-> returning t) 473 | 474 | let open_transactiondb ?opts ?txnopts name = 475 | let inner opts txndbopts = with_err_pointer (open_transactiondb_raw opts txndbopts name) in 476 | match opts, txnopts with 477 | None, None -> TransactionDbOptions.with_t (fun txndbopts -> 478 | (Options.with_t (fun opts -> 479 | inner opts txndbopts))) 480 | | Some opts, None -> TransactionDbOptions.with_t (inner opts) 481 | | None, Some txndbopts -> Options.with_t (fun opts -> 482 | inner opts txndbopts) 483 | | Some opts, Some txndbopts -> inner opts txndbopts 484 | 485 | let open_db ?opts name = 486 | match opts with 487 | | None -> Options.with_t (fun options -> with_err_pointer (open_db_raw options name)) 488 | | Some opts -> with_err_pointer (open_db_raw opts name) 489 | 490 | let open_db_for_read_only ?opts name error_if_log_file_exists = 491 | match opts with 492 | | None -> Options.with_t (fun options -> with_err_pointer (open_db_for_read_only_raw options name error_if_log_file_exists)) 493 | | Some opts -> with_err_pointer (open_db_for_read_only_raw opts name error_if_log_file_exists) 494 | 495 | let close = 496 | let inner = 497 | foreign 498 | "rocksdb_close" 499 | (t @-> returning void) 500 | in 501 | fun t -> 502 | inner t; 503 | t.valid <- false 504 | 505 | let with_db ?opts name ~f = 506 | let db = open_db ?opts name in 507 | finalize (fun () -> f db) (fun () -> close db) 508 | 509 | let put_raw = 510 | foreign 511 | "rocksdb_put" 512 | (t @-> WriteOptions.t @-> 513 | ptr char @-> Views.int_to_size_t @-> 514 | ptr char @-> Views.int_to_size_t @-> 515 | returning_error void) 516 | 517 | let put_raw_string = 518 | foreign 519 | "rocksdb_put" 520 | (t @-> WriteOptions.t @-> 521 | ocaml_string @-> Views.int_to_size_t @-> 522 | ocaml_string @-> Views.int_to_size_t @-> 523 | returning_error void) 524 | 525 | let put ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len ?opts t key value = 526 | let open Bigarray.Array1 in 527 | let key_len = match key_len with None -> dim key - key_pos | Some len -> len in 528 | let value_len = match value_len with None -> dim value - value_pos | Some len -> len in 529 | let inner opts = with_err_pointer begin 530 | put_raw t opts 531 | (bigarray_start array1 key +@ key_pos) key_len 532 | (bigarray_start array1 value +@ value_pos) value_len 533 | end 534 | in 535 | match opts with 536 | | None -> WriteOptions.with_t inner 537 | | Some opts -> inner opts 538 | 539 | let put_string ?(key_pos=0) ?key_len ?(value_pos=0) ?value_len ?opts t key value = 540 | let key_len = match key_len with None -> String.length key - key_pos | Some len -> len in 541 | let value_len = match value_len with None -> String.length value - value_pos | Some len -> len in 542 | let inner opts = with_err_pointer begin 543 | put_raw_string t opts 544 | (ocaml_string_start key +@ key_pos) key_len 545 | (ocaml_string_start value +@ value_pos) value_len 546 | end 547 | in 548 | match opts with 549 | | None -> WriteOptions.with_t inner 550 | | Some opts -> inner opts 551 | 552 | let delete_raw = 553 | foreign 554 | "rocksdb_delete" 555 | (t @-> WriteOptions.t @-> 556 | ptr char @-> Views.int_to_size_t @-> 557 | returning_error void) 558 | 559 | let delete_raw_string = 560 | foreign 561 | "rocksdb_delete" 562 | (t @-> WriteOptions.t @-> 563 | ocaml_string @-> Views.int_to_size_t @-> 564 | returning_error void) 565 | 566 | let delete ?(pos=0) ?len ?opts t key = 567 | let open Bigarray.Array1 in 568 | let len = match len with None -> dim key - pos | Some len -> len in 569 | let inner opts = 570 | with_err_pointer (delete_raw t opts (bigarray_start array1 key +@ pos) len) in 571 | match opts with 572 | | None -> WriteOptions.with_t inner 573 | | Some opts -> inner opts 574 | 575 | let delete_string ?(pos=0) ?len ?opts t key = 576 | let len = match len with None -> String.length key - pos | Some len -> len in 577 | let inner opts = 578 | with_err_pointer (delete_raw_string t opts (ocaml_string_start key +@ pos) len) in 579 | match opts with 580 | | None -> WriteOptions.with_t inner 581 | | Some opts -> inner opts 582 | 583 | let write_raw = 584 | foreign 585 | "rocksdb_write" 586 | (t @-> WriteOptions.t @-> WriteBatch.t @-> 587 | returning_error void) 588 | 589 | let write ?opts t wb = 590 | let inner opts = with_err_pointer (write_raw t opts wb) in 591 | match opts with 592 | | None -> WriteOptions.with_t inner 593 | | Some opts -> with_err_pointer (write_raw t opts wb) 594 | 595 | let get_raw = 596 | foreign 597 | "rocksdb_get" 598 | (t @-> ReadOptions.t @-> 599 | ptr char @-> Views.int_to_size_t @-> ptr Views.int_to_size_t @-> 600 | returning_error (ptr char)) 601 | 602 | let get_raw_string = 603 | foreign 604 | "rocksdb_get" 605 | (t @-> ReadOptions.t @-> 606 | ocaml_string @-> Views.int_to_size_t @-> ptr Views.int_to_size_t @-> 607 | returning_error (ptr char)) 608 | 609 | let get ?(pos=0) ?len ?opts t key = 610 | let open Bigarray.Array1 in 611 | let len = match len with None -> dim key - pos | Some len -> len in 612 | let inner opts = 613 | let res_size = allocate Views.int_to_size_t 0 in 614 | let res = with_err_pointer 615 | (get_raw t opts (bigarray_start array1 key +@ pos) len res_size) 616 | in 617 | if (to_voidp res) = null 618 | then None 619 | else begin 620 | let res' = bigarray_of_ptr array1 (!@res_size) Bigarray.char res in 621 | Gc.finalise_last (fun () -> free (to_voidp res)) res'; 622 | Some res' 623 | end 624 | in 625 | match opts with 626 | | Some opts -> inner opts 627 | | None -> ReadOptions.with_t inner 628 | 629 | let get_string ?(pos=0) ?len ?opts t key = 630 | let len = match len with None -> String.length key - pos | Some len -> len in 631 | let inner opts = 632 | let res_size = allocate Views.int_to_size_t 0 in 633 | let res = with_err_pointer 634 | (get_raw_string t opts (ocaml_string_start key +@ pos) len res_size) 635 | in 636 | if (to_voidp res) = null 637 | then None 638 | else begin 639 | let res' = string_from_ptr res (!@ res_size) in 640 | Gc.finalise_last (fun () -> free (to_voidp res)) res'; 641 | Some res' 642 | end 643 | in 644 | match opts with 645 | | Some opts -> inner opts 646 | | None -> ReadOptions.with_t inner 647 | 648 | let flush_raw = 649 | foreign 650 | "rocksdb_flush" 651 | (t @-> FlushOptions.t @-> returning_error void) 652 | 653 | let flush ?opts t = 654 | let inner opts = with_err_pointer (flush_raw t opts) in 655 | match opts with 656 | | None -> FlushOptions.with_t inner 657 | | Some opts -> inner opts 658 | 659 | let create_snapshot = 660 | foreign "rocksdb_create_snapshot" 661 | (t @-> returning Snapshot.t) 662 | 663 | let release_snapshot = 664 | foreign "rocksdb_release_snapshot" 665 | (t @-> Snapshot.t @-> returning void) 666 | 667 | module CheckpointObject = struct 668 | let name = "checkpoint_object" 669 | let constructor = "rocksdb_" ^ name ^ "_create" 670 | let destructor = "rocksdb_" ^ name ^ "_destroy" 671 | 672 | type db = t 673 | let db = t 674 | 675 | type nonrec t = t 676 | let t = t 677 | 678 | let create_no_gc = 679 | foreign 680 | constructor 681 | (db @-> returning t) 682 | 683 | let destroy = make_destroy t destructor 684 | 685 | let create db = 686 | let t = create_no_gc db in 687 | Gc.finalise destroy t; 688 | t 689 | 690 | let with_t db f = 691 | let t = create_no_gc db in 692 | finalize 693 | (fun () -> f t) 694 | (fun () -> destroy t) 695 | end 696 | 697 | let checkpoint_create db dir log_size_for_flush = 698 | let checkpoint_create_raw = 699 | foreign "rocksdb_checkpoint_create" 700 | (CheckpointObject.t @-> string @-> 701 | Views.int_to_uint64_t @-> ptr string_opt @-> returning void) in 702 | CheckpointObject.with_t db (fun checkpoint_object -> 703 | with_err_pointer (checkpoint_create_raw checkpoint_object dir 704 | log_size_for_flush)) 705 | 706 | let property_value db name = 707 | (* Ugly hack. Is there a better way to retrieve string from C? *) 708 | let get = foreign "rocksdb_property_value" 709 | (t @-> string @-> returning (ptr_opt char)) in 710 | let free = foreign "free" ((ptr char) @-> returning void) in 711 | let strlen = foreign "strlen" ((ptr char) @-> returning int) in 712 | match get db name with 713 | Some p -> let value = string_from_ptr p ~length:(strlen p) in 714 | free p; 715 | Some value 716 | | None -> None 717 | end 718 | 719 | include RocksDb 720 | -------------------------------------------------------------------------------- /rocks.mli: -------------------------------------------------------------------------------- 1 | exception OperationOnInvalidObject 2 | 3 | type bigarray = Rocks_intf.bigarray 4 | 5 | module Views : sig 6 | val bool_to_int : bool Ctypes.typ 7 | val bool_to_uchar : bool Ctypes.typ 8 | val int_to_size_t : int Ctypes.typ 9 | end 10 | 11 | module WriteBatch : sig 12 | include Rocks_common.S 13 | 14 | val clear : t -> unit 15 | val count : t -> int 16 | 17 | val put : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> t -> bigarray -> bigarray -> unit 18 | val put_string : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> t -> string -> string -> unit 19 | 20 | val delete : ?pos:int -> ?len:int -> t -> bigarray -> unit 21 | val delete_string : ?pos:int -> ?len:int -> t -> string -> unit 22 | end 23 | 24 | module Version : sig 25 | val major : int 26 | val minor : int 27 | val patch : int 28 | val git_revision : string 29 | val summary : int * int * int * string 30 | end 31 | 32 | include Rocks_intf.ROCKS with type batch := WriteBatch.t 33 | 34 | module Iterator : Rocks_intf.ITERATOR with type db := t 35 | module Transaction : Rocks_intf.TRANSACTION with type db := t and type iter := Iterator.t 36 | 37 | -------------------------------------------------------------------------------- /rocks_common.ml: -------------------------------------------------------------------------------- 1 | open Ctypes 2 | open Foreign 3 | 4 | module Views = struct 5 | open Unsigned 6 | 7 | let bool_to_int = 8 | view 9 | ~read:(fun i -> i <> 0) 10 | ~write:(function true -> 1 | false -> 0) 11 | int 12 | 13 | let bool_to_uchar = 14 | view 15 | ~read:(fun u -> u <> UChar.zero) 16 | ~write:(function true -> UChar.one | false -> UChar.zero) 17 | uchar 18 | 19 | let int_to_size_t = 20 | view 21 | ~read:Size_t.to_int 22 | ~write:Size_t.of_int 23 | size_t 24 | 25 | let int_to_uint_t = 26 | view 27 | ~read:UInt.to_int 28 | ~write:UInt.of_int 29 | uint 30 | 31 | let int_to_uint32_t = 32 | view 33 | ~read:UInt32.to_int 34 | ~write:UInt32.of_int 35 | uint32_t 36 | 37 | let int_to_uint64_t = 38 | view 39 | ~read:UInt64.to_int 40 | ~write:UInt64.of_int 41 | uint64_t 42 | end 43 | 44 | let free = 45 | foreign 46 | "free" 47 | (ptr void @-> returning void) 48 | 49 | module type RocksType = 50 | sig 51 | val name : string 52 | val constructor : string 53 | val destructor : string 54 | val setter_prefix : string 55 | end 56 | 57 | module type RocksType' = 58 | sig 59 | val name : string 60 | end 61 | 62 | type t = { 63 | ptr : unit ptr; 64 | mutable valid : bool; 65 | } 66 | 67 | let get_pointer t = t.ptr 68 | 69 | exception OperationOnInvalidObject 70 | 71 | let t : t typ = 72 | view 73 | ~read:(fun ptr -> { ptr; valid = true; }) 74 | ~write:( 75 | fun { ptr; valid; } -> 76 | if valid 77 | then ptr 78 | else raise OperationOnInvalidObject) 79 | (ptr void) 80 | 81 | let make_destroy t destructor = 82 | let inner = 83 | foreign 84 | destructor 85 | (t @-> returning void) in 86 | fun t -> 87 | inner t; 88 | t.valid <- false 89 | 90 | let finalize f finalizer = 91 | match f () with 92 | | a -> finalizer (); 93 | a 94 | | exception exn -> finalizer (); 95 | raise exn 96 | 97 | module type S = sig 98 | type t 99 | 100 | val t : t Ctypes.typ 101 | val get_pointer : t -> unit Ctypes.ptr 102 | val type_name : string 103 | 104 | val create : unit -> t 105 | val create_no_gc : unit -> t 106 | val destroy : t -> unit 107 | val with_t : (t -> 'a) -> 'a 108 | 109 | val create_setter : string -> 'a Ctypes.typ -> t -> 'a -> unit 110 | end 111 | 112 | module CreateConstructors(T : RocksType) = struct 113 | 114 | type nonrec t = t 115 | let t = t 116 | 117 | let get_pointer = get_pointer 118 | 119 | let type_name = T.name 120 | 121 | let create_no_gc = 122 | foreign 123 | T.constructor 124 | (void @-> returning t) 125 | 126 | let destroy = make_destroy t T.destructor 127 | 128 | let create () = 129 | let t = create_no_gc () in 130 | Gc.finalise destroy t; 131 | t 132 | 133 | let with_t f = 134 | let t = create_no_gc () in 135 | finalize 136 | (fun () -> f t) 137 | (fun () -> destroy t) 138 | 139 | let create_setter property_name property_typ = 140 | foreign 141 | (T.setter_prefix ^ property_name) 142 | (t @-> property_typ @-> returning void) 143 | end 144 | 145 | module CreateConstructors_(T : RocksType') = struct 146 | include CreateConstructors(struct 147 | let name = T.name 148 | let constructor = "rocksdb_" ^ T.name ^ "_create" 149 | let destructor = "rocksdb_" ^ T.name ^ "_destroy" 150 | let setter_prefix = "rocksdb_" ^ T.name ^ "_" 151 | end) 152 | end 153 | -------------------------------------------------------------------------------- /rocks_intf.ml: -------------------------------------------------------------------------------- 1 | open Rocks_options 2 | 3 | type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t 4 | 5 | module type ITERATOR = sig 6 | module ReadOptions : module type of ReadOptions 7 | 8 | exception InvalidIterator 9 | 10 | type db 11 | type t 12 | 13 | val get_pointer : t -> unit Ctypes.ptr 14 | 15 | val create : ?opts:ReadOptions.t -> db -> t 16 | val with_t : ?opts:ReadOptions.t -> db -> f:(t -> 'a) -> 'a 17 | 18 | val is_valid : t -> bool 19 | 20 | val seek_to_first : t -> unit 21 | val seek_to_last : t -> unit 22 | 23 | val seek : ?pos:int -> ?len:int -> t -> bigarray -> unit 24 | val seek_string : ?pos:int -> ?len:int -> t -> string -> unit 25 | 26 | val next : t -> unit 27 | val prev : t -> unit 28 | 29 | val get_key_string : t -> string 30 | (** returned buffer is only valid as long as [t] is not modified *) 31 | val get_key : t -> bigarray 32 | 33 | val get_value_string : t -> string 34 | (** returned buffer is only valid as long as [t] is not modified *) 35 | val get_value : t -> bigarray 36 | 37 | val get_error : t -> string option 38 | end 39 | 40 | module type TRANSACTION = sig 41 | type t 42 | type db 43 | type iter 44 | module ReadOptions : module type of ReadOptions 45 | module WriteOptions : module type of WriteOptions 46 | module TransactionOptions : module type of TransactionOptions 47 | module Snapshot : module type of Snapshot 48 | 49 | val txnbegin : ?wopts:WriteOptions.t -> 50 | ?txnopts:TransactionOptions.t -> db -> t 51 | val txnbegin_no_gc : ?wopts:WriteOptions.t -> 52 | ?txnopts:TransactionOptions.t -> db -> t 53 | val commit : t -> unit 54 | val rollback : t -> unit 55 | val destroy : t -> unit 56 | val with_t : db -> (t -> unit) -> unit 57 | 58 | val get : ?pos:int -> ?len:int -> ?opts:ReadOptions.t -> t -> bigarray -> bigarray option 59 | val get_string : ?pos:int -> ?len:int -> ?opts:ReadOptions.t -> t -> string -> string option 60 | 61 | val put : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> ?opts:WriteOptions.t -> t -> bigarray -> bigarray -> unit 62 | val put_string : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> ?opts:WriteOptions.t -> t -> string -> string -> unit 63 | 64 | val delete : ?pos:int -> ?len:int -> ?opts:WriteOptions.t -> t -> bigarray -> unit 65 | val delete_string : ?pos:int -> ?len:int -> ?opts:WriteOptions.t -> t -> string -> unit 66 | 67 | val get_snapshot : t -> Snapshot.t 68 | val free_snapshot : Snapshot.t -> unit 69 | 70 | val create_iterator: ?opts:ReadOptions.t -> t -> iter 71 | val with_iterator: ?opts:ReadOptions.t -> t -> f:(iter -> 'a) -> 'a 72 | end 73 | 74 | module type ROCKS = sig 75 | module Options : module type of Options 76 | module ReadOptions : module type of ReadOptions 77 | module WriteOptions : module type of WriteOptions 78 | module FlushOptions : module type of FlushOptions 79 | module Cache : module type of Cache 80 | module BlockBasedTableOptions : module type of BlockBasedTableOptions 81 | module Snapshot : module type of Snapshot 82 | module TransactionDbOptions : module type of TransactionDbOptions 83 | 84 | type t 85 | type batch 86 | 87 | val get_pointer : t -> unit Ctypes.ptr 88 | 89 | val open_db : ?opts:Options.t -> string -> t 90 | val open_db_for_read_only : ?opts:Options.t -> string -> bool -> t 91 | val open_transactiondb : ?opts:Options.t -> ?txnopts:TransactionDbOptions.t -> string -> t 92 | val with_db : ?opts:Options.t -> string -> f:(t -> 'a) -> 'a 93 | val close : t -> unit 94 | 95 | val get : ?pos:int -> ?len:int -> ?opts:ReadOptions.t -> t -> bigarray -> bigarray option 96 | val get_string : ?pos:int -> ?len:int -> ?opts:ReadOptions.t -> t -> string -> string option 97 | 98 | val put : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> ?opts:WriteOptions.t -> t -> bigarray -> bigarray -> unit 99 | val put_string : ?key_pos:int -> ?key_len:int -> ?value_pos:int -> ?value_len:int -> ?opts:WriteOptions.t -> t -> string -> string -> unit 100 | 101 | val delete : ?pos:int -> ?len:int -> ?opts:WriteOptions.t -> t -> bigarray -> unit 102 | val delete_string : ?pos:int -> ?len:int -> ?opts:WriteOptions.t -> t -> string -> unit 103 | 104 | val write : ?opts:WriteOptions.t -> t -> batch -> unit 105 | 106 | val flush : ?opts:FlushOptions.t -> t -> unit 107 | 108 | val create_snapshot : t -> Snapshot.t 109 | val release_snapshot : t -> Snapshot.t -> unit 110 | 111 | val checkpoint_create : t -> string -> int -> unit 112 | val property_value : t -> string -> string option 113 | end 114 | -------------------------------------------------------------------------------- /rocks_options.ml: -------------------------------------------------------------------------------- 1 | open Ctypes 2 | open Foreign 3 | open Rocks_common 4 | 5 | module Cache = 6 | struct 7 | type nonrec t = t 8 | let t = t 9 | 10 | let get_pointer = get_pointer 11 | 12 | let create_no_gc = 13 | (* extern rocksdb_cache_t* rocksdb_cache_create_lru(size_t capacity); *) 14 | foreign 15 | "rocksdb_cache_create_lru" 16 | (Views.int_to_size_t @-> returning t) 17 | 18 | let destroy = 19 | (* extern void rocksdb_cache_destroy(rocksdb_cache_t* cache); *) 20 | make_destroy t "rocksdb_cache_destroy" 21 | 22 | let create capacity = 23 | let t = create_no_gc capacity in 24 | Gc.finalise destroy t; 25 | t 26 | 27 | let with_t capacity f = 28 | let t = create_no_gc capacity in 29 | finalize 30 | (fun () -> f t) 31 | (fun () -> destroy t) 32 | 33 | let create_setter property_name property_typ = 34 | foreign 35 | ("rocksdb_cache_" ^ property_name) 36 | (t @-> property_typ @-> returning void) 37 | 38 | let set_capacity = create_setter "set_capacity" int 39 | end 40 | 41 | module Snapshot = 42 | struct 43 | type nonrec t = t 44 | let t = t 45 | end 46 | 47 | module BlockBasedTableOptions = 48 | struct 49 | include CreateConstructors(struct 50 | let name = "block_based_table_options" 51 | let constructor = "rocksdb_block_based_options_create" 52 | let destructor = "rocksdb_block_based_options_destroy" 53 | let setter_prefix = "rocksdb_block_based_options_" 54 | end) 55 | 56 | (* extern void rocksdb_block_based_options_set_block_size( *) 57 | (* rocksdb_block_based_table_options_t* options, size_t block_size); *) 58 | let set_block_size = 59 | create_setter "set_block_size" Views.int_to_size_t 60 | 61 | (* extern void rocksdb_block_based_options_set_block_size_deviation( *) 62 | (* rocksdb_block_based_table_options_t* options, int block_size_deviation); *) 63 | let set_block_size_deviation = 64 | create_setter "set_block_size_deviation" int 65 | 66 | (* extern void rocksdb_block_based_options_set_block_restart_interval( *) 67 | (* rocksdb_block_based_table_options_t* options, int block_restart_interval); *) 68 | let set_block_restart_interval = 69 | create_setter "set_block_restart_interval" int 70 | 71 | (* extern void rocksdb_block_based_options_set_filter_policy( *) 72 | (* rocksdb_block_based_table_options_t* options, *) 73 | (* rocksdb_filterpolicy_t* filter_policy); *) 74 | (* let set_filter_policy = *) 75 | (* create_setter "set_filter_policy" TODO *) 76 | 77 | (* extern void rocksdb_block_based_options_set_no_block_cache( *) 78 | (* rocksdb_block_based_table_options_t* options, *) 79 | (* unsigned char no_block_cache); *) 80 | let set_no_block_cache = 81 | create_setter "set_no_block_cache" Views.bool_to_uchar 82 | 83 | (* extern void rocksdb_block_based_options_set_block_cache( *) 84 | (* rocksdb_block_based_table_options_t* options, rocksdb_cache_t* block_cache); *) 85 | let set_block_cache = 86 | create_setter "set_block_cache" Cache.t 87 | 88 | (* extern void rocksdb_block_based_options_set_block_cache_compressed( *) 89 | (* rocksdb_block_based_table_options_t* options, *) 90 | (* rocksdb_cache_t* block_cache_compressed); *) 91 | let set_block_cache_compressed = 92 | create_setter "set_block_cache_compressed" Cache.t 93 | 94 | (* extern void rocksdb_block_based_options_set_whole_key_filtering( *) 95 | (* rocksdb_block_based_table_options_t*, unsigned char); *) 96 | let set_whole_key_filtering = 97 | create_setter "set_whole_key_filtering" Views.bool_to_uchar 98 | 99 | (* extern void rocksdb_block_based_options_set_format_version( *) 100 | (* rocksdb_block_based_table_options_t*, int); *) 101 | let set_format_version = 102 | create_setter "set_format_version" int 103 | 104 | module IndexType = 105 | struct 106 | type t = int 107 | let binary_search = 0 108 | let hash_search = 1 109 | end 110 | (* enum { *) 111 | (* rocksdb_block_based_table_index_type_binary_search = 0, *) 112 | (* rocksdb_block_based_table_index_type_hash_search = 1, *) 113 | (* }; *) 114 | (* extern void rocksdb_block_based_options_set_index_type( *) 115 | (* rocksdb_block_based_table_options_t*, int); // uses one of the above enums *) 116 | let set_index_type = 117 | create_setter "set_index_type" int 118 | 119 | (* extern void rocksdb_block_based_options_set_hash_index_allow_collision( *) 120 | (* rocksdb_block_based_table_options_t*, unsigned char); *) 121 | let set_hash_index_allow_collision = 122 | create_setter "set_hash_index_allow_collision" Views.bool_to_uchar 123 | 124 | (* extern void rocksdb_block_based_options_set_cache_index_and_filter_blocks( *) 125 | (* rocksdb_block_based_table_options_t*, unsigned char); *) 126 | let set_cache_index_and_filter_blocks = 127 | create_setter "set_cache_index_and_filter_blocks" Views.bool_to_uchar 128 | end 129 | 130 | module Options = struct 131 | (* extern rocksdb_options_t* rocksdb_options_create(); *) 132 | (* extern void rocksdb_options_destroy(rocksdb_options_t*\); *) 133 | module C = CreateConstructors_(struct let name = "options" end) 134 | include C 135 | 136 | (* extern void rocksdb_options_increase_parallelism( *) 137 | (* rocksdb_options_t* opt, int total_threads); *) 138 | let increase_parallelism = create_setter "increase_parallelism" int 139 | 140 | (* extern void rocksdb_options_optimize_for_point_lookup( *) 141 | (* rocksdb_options_t* opt, uint64_t block_cache_size_mb); *) 142 | let optimize_for_point_lookup = 143 | create_setter "optimize_for_point_lookup" Views.int_to_uint64_t 144 | 145 | (* extern void rocksdb_options_optimize_level_style_compaction( *) 146 | (* rocksdb_options_t* opt, uint64_t memtable_memory_budget); *) 147 | let optimize_level_style_compaction = 148 | create_setter "optimize_level_style_compaction" Views.int_to_uint64_t 149 | 150 | (* extern void rocksdb_options_optimize_universal_style_compaction( *) 151 | (* rocksdb_options_t* opt, uint64_t memtable_memory_budget); *) 152 | let optimize_universal_style_compaction = 153 | create_setter "optimize_universal_style_compaction" Views.int_to_uint64_t 154 | 155 | (* extern void rocksdb_options_set_compaction_filter( *) 156 | (* rocksdb_options_t*, *) 157 | (* rocksdb_compactionfilter_t*\); *) 158 | (* extern void rocksdb_options_set_compaction_filter_factory( *) 159 | (* rocksdb_options_t*, rocksdb_compactionfilterfactory_t*\); *) 160 | (* extern void rocksdb_options_set_compaction_filter_factory_v2( *) 161 | (* rocksdb_options_t*, *) 162 | (* rocksdb_compactionfilterfactoryv2_t*\); *) 163 | (* extern void rocksdb_options_set_comparator( *) 164 | (* rocksdb_options_t*, *) 165 | (* rocksdb_comparator_t*\); *) 166 | (* extern void rocksdb_options_set_merge_operator( *) 167 | (* rocksdb_options_t*, *) 168 | (* rocksdb_mergeoperator_t*\); *) 169 | (* extern void rocksdb_options_set_uint64add_merge_operator(rocksdb_options_t*\); *) 170 | 171 | (* extern void rocksdb_options_set_compression_per_level( *) 172 | (* rocksdb_options_t* opt, *) 173 | (* int* level_values, *) 174 | (* size_t num_levels); *) 175 | 176 | (* extern void rocksdb_options_set_create_if_missing( *) 177 | (* rocksdb_options_t*, unsigned char); *) 178 | let set_create_if_missing = create_setter "set_create_if_missing" Views.bool_to_uchar 179 | 180 | (* extern void rocksdb_options_set_create_missing_column_families( *) 181 | (* rocksdb_options_t*, unsigned char); *) 182 | let set_create_missing_column_families = 183 | create_setter "set_create_missing_column_families" Views.bool_to_uchar 184 | 185 | (* extern void rocksdb_options_set_error_if_exists( *) 186 | (* rocksdb_options_t*, unsigned char); *) 187 | let set_error_if_exists = 188 | create_setter "set_error_if_exists" Views.bool_to_uchar 189 | 190 | (* extern void rocksdb_options_set_paranoid_checks( *) 191 | (* rocksdb_options_t*, unsigned char); *) 192 | let set_paranoid_checks = 193 | create_setter "set_paranoid_checks" Views.bool_to_uchar 194 | 195 | (* extern void rocksdb_options_set_env(rocksdb_options_t*, rocksdb_env_t*\); *) 196 | (* extern void rocksdb_options_set_info_log(rocksdb_options_t*, rocksdb_logger_t*\); *) 197 | (* extern void rocksdb_options_set_info_log_level(rocksdb_options_t*, int); *) 198 | 199 | (* extern void rocksdb_options_set_write_buffer_size(rocksdb_options_t*, size_t); *) 200 | let set_write_buffer_size = 201 | create_setter "set_write_buffer_size" Views.int_to_size_t 202 | 203 | (* extern void rocksdb_options_set_max_open_files(rocksdb_options_t*, int); *) 204 | let set_max_open_files = 205 | create_setter "set_max_open_files" int 206 | 207 | (* extern void rocksdb_options_set_max_total_wal_size(rocksdb_options_t* opt, uint64_t n); *) 208 | let set_max_total_wal_size = 209 | create_setter "set_max_total_wal_size" Views.int_to_uint64_t 210 | 211 | (* extern void rocksdb_options_set_compression_options( *) 212 | (* rocksdb_options_t*, int, int, int); *) 213 | (* extern void rocksdb_options_set_prefix_extractor( *) 214 | (* rocksdb_options_t*, rocksdb_slicetransform_t*\); *) 215 | (* extern void rocksdb_options_set_num_levels(rocksdb_options_t*, int); *) 216 | (* extern void rocksdb_options_set_level0_file_num_compaction_trigger( *) 217 | (* rocksdb_options_t*, int); *) 218 | (* extern void rocksdb_options_set_level0_slowdown_writes_trigger( *) 219 | (* rocksdb_options_t*, int); *) 220 | (* extern void rocksdb_options_set_level0_stop_writes_trigger( *) 221 | (* rocksdb_options_t*, int); *) 222 | (* extern void rocksdb_options_set_max_mem_compaction_level( *) 223 | (* rocksdb_options_t*, int); *) 224 | (* extern void rocksdb_options_set_target_file_size_base( *) 225 | (* rocksdb_options_t*, uint64_t); *) 226 | (* extern void rocksdb_options_set_target_file_size_multiplier( *) 227 | (* rocksdb_options_t*, int); *) 228 | (* extern void rocksdb_options_set_max_bytes_for_level_base( *) 229 | (* rocksdb_options_t*, uint64_t); *) 230 | (* extern void rocksdb_options_set_max_bytes_for_level_multiplier( *) 231 | (* rocksdb_options_t*, int); *) 232 | (* extern void rocksdb_options_set_expanded_compaction_factor( *) 233 | (* rocksdb_options_t*, int); *) 234 | (* extern void rocksdb_options_set_max_grandparent_overlap_factor( *) 235 | (* rocksdb_options_t*, int); *) 236 | (* extern void rocksdb_options_set_max_bytes_for_level_multiplier_additional( *) 237 | (* rocksdb_options_t*, int* level_values, size_t num_levels); *) 238 | (* extern void rocksdb_options_enable_statistics(rocksdb_options_t*\); *) 239 | 240 | (* /* returns a pointer to a malloc()-ed, null terminated string */ *) 241 | (* extern char *rocksdb_options_statistics_get_string(rocksdb_options_t *opt); *) 242 | 243 | (* extern void rocksdb_options_set_max_write_buffer_number(rocksdb_options_t*, int); *) 244 | let set_max_write_buffer_number = 245 | create_setter "set_max_write_buffer_number" int 246 | 247 | (* extern void rocksdb_options_set_min_write_buffer_number_to_merge(rocksdb_options_t*, int); *) 248 | let set_min_write_buffer_number_to_merge = 249 | create_setter "set_min_write_buffer_number_to_merge" int 250 | 251 | (* extern void rocksdb_options_set_max_write_buffer_number_to_maintain( *) 252 | (* rocksdb_options_t*, int); *) 253 | let set_max_write_buffer_number_to_maintain = 254 | create_setter "set_max_write_buffer_number_to_maintain" int 255 | 256 | (* extern void rocksdb_options_set_max_background_compactions(rocksdb_options_t*, int); *) 257 | let set_max_background_compactions = 258 | create_setter "set_max_background_compactions" int 259 | 260 | (* extern void rocksdb_options_set_max_background_flushes(rocksdb_options_t*, int); *) 261 | let set_max_background_flushes = 262 | create_setter "set_max_background_flushes" int 263 | 264 | (* extern void rocksdb_options_set_max_log_file_size(rocksdb_options_t*, size_t); *) 265 | let set_max_log_file_size = 266 | create_setter "set_max_log_file_size" Views.int_to_size_t 267 | 268 | (* extern void rocksdb_options_set_log_file_time_to_roll(rocksdb_options_t*, size_t); *) 269 | let set_log_file_time_to_roll = 270 | create_setter "set_log_file_time_to_roll" Views.int_to_size_t 271 | 272 | (* extern void rocksdb_options_set_keep_log_file_num(rocksdb_options_t*, size_t); *) 273 | let set_keep_log_file_num = 274 | create_setter "set_keep_log_file_num" Views.int_to_size_t 275 | 276 | (* extern ROCKSDB_LIBRARY_API void rocksdb_options_set_recycle_log_file_num( *) 277 | (* rocksdb_options_t*, size_t); *) 278 | let set_recycle_log_file_num = 279 | create_setter "set_recycle_log_file_num" Views.int_to_size_t 280 | 281 | (* extern void rocksdb_options_set_soft_rate_limit(rocksdb_options_t*, double); *) 282 | let set_soft_rate_limit = 283 | create_setter "set_soft_rate_limit" float 284 | 285 | (* extern void rocksdb_options_set_hard_rate_limit(rocksdb_options_t*, double); *) 286 | let set_hard_rate_limit = 287 | create_setter "set_hard_rate_limit" float 288 | 289 | (* extern void rocksdb_options_set_rate_limit_delay_max_milliseconds( *) 290 | (* rocksdb_options_t*, unsigned int); *) 291 | let set_rate_limit_delay_max_milliseconds = 292 | create_setter "set_rate_limit_delay_max_milliseconds" Views.int_to_uint_t 293 | 294 | (* extern void rocksdb_options_set_max_manifest_file_size( *) 295 | (* rocksdb_options_t*, size_t); *) 296 | let set_max_manifest_file_size = 297 | create_setter "set_max_manifest_file_size" Views.int_to_size_t 298 | 299 | (* extern void rocksdb_options_set_table_cache_numshardbits( *) 300 | (* rocksdb_options_t*, int); *) 301 | let set_table_cache_numshardbits = 302 | create_setter "set_table_cache_numshardbits" int 303 | 304 | (* extern void rocksdb_options_set_table_cache_remove_scan_count_limit( *) 305 | (* rocksdb_options_t*, int); *) 306 | let set_table_cache_remove_scan_count_limit = 307 | create_setter "set_table_cache_remove_scan_count_limit" int 308 | 309 | (* extern void rocksdb_options_set_arena_block_size( *) 310 | (* rocksdb_options_t*, size_t); *) 311 | let set_arena_block_size = 312 | create_setter "set_arena_block_size" Views.int_to_size_t 313 | 314 | (* extern void rocksdb_options_set_use_fsync( *) 315 | (* rocksdb_options_t*, int); *) 316 | let set_use_fsync = 317 | create_setter "set_use_fsync" Views.bool_to_int 318 | 319 | (* extern void rocksdb_options_set_db_log_dir( *) 320 | (* rocksdb_options_t*, const char*\); *) 321 | (* extern void rocksdb_options_set_wal_dir( *) 322 | (* rocksdb_options_t*, const char*\); *) 323 | 324 | (* extern void rocksdb_options_set_WAL_ttl_seconds( *) 325 | (* rocksdb_options_t*, uint64_t); *) 326 | let set_WAL_ttl_seconds = 327 | create_setter "set_WAL_ttl_seconds" Views.int_to_uint64_t 328 | 329 | (* extern void rocksdb_options_set_WAL_size_limit_MB( *) 330 | (* rocksdb_options_t*, uint64_t); *) 331 | let set_WAL_size_limit_MB = 332 | create_setter "set_WAL_size_limit_MB" Views.int_to_uint64_t 333 | 334 | (* extern void rocksdb_options_set_manifest_preallocation_size( *) 335 | (* rocksdb_options_t*, size_t); *) 336 | let set_manifest_preallocation_size = 337 | create_setter "set_manifest_preallocation_size" Views.int_to_size_t 338 | 339 | (* extern void rocksdb_options_set_purge_redundant_kvs_while_flush( *) 340 | (* rocksdb_options_t*, unsigned char); *) 341 | let set_purge_redundant_kvs_while_flush = 342 | create_setter "set_purge_redundant_kvs_while_flush" Views.bool_to_uchar 343 | 344 | (* extern void rocksdb_options_set_use_direct_reads( *) 345 | (* rocksdb_options_t*, unsigned char); *) 346 | let set_use_direct_reads = 347 | create_setter "set_use_direct_reads" Views.bool_to_uchar 348 | 349 | (* extern void rocksdb_options_set_allow_mmap_reads( *) 350 | (* rocksdb_options_t*, unsigned char); *) 351 | let set_allow_mmap_reads = 352 | create_setter "set_allow_mmap_reads" Views.bool_to_uchar 353 | 354 | (* extern void rocksdb_options_set_allow_mmap_writes( *) 355 | (* rocksdb_options_t*, unsigned char); *) 356 | let set_allow_mmap_writes = 357 | create_setter "set_allow_mmap_writes" Views.bool_to_uchar 358 | 359 | (* extern void rocksdb_options_set_is_fd_close_on_exec( *) 360 | (* rocksdb_options_t*, unsigned char); *) 361 | let set_is_fd_close_on_exec = 362 | create_setter "set_is_fd_close_on_exec" Views.bool_to_uchar 363 | 364 | (* extern void rocksdb_options_set_skip_log_error_on_recovery( *) 365 | (* rocksdb_options_t*, unsigned char); *) 366 | let set_skip_log_error_on_recovery = 367 | create_setter "set_skip_log_error_on_recovery" Views.bool_to_uchar 368 | 369 | (* extern void rocksdb_options_set_stats_dump_period_sec( *) 370 | (* rocksdb_options_t*, unsigned int); *) 371 | let set_stats_dump_period_sec = 372 | create_setter "set_stats_dump_period_sec" Views.int_to_uint_t 373 | 374 | (* extern void rocksdb_options_set_advise_random_on_open( *) 375 | (* rocksdb_options_t*, unsigned char); *) 376 | let set_advise_random_on_open = 377 | create_setter "set_advise_random_on_open" Views.bool_to_uchar 378 | 379 | (* extern void rocksdb_options_set_access_hint_on_compaction_start( *) 380 | (* rocksdb_options_t*, int); *) 381 | let set_access_hint_on_compaction_start = 382 | create_setter "set_access_hint_on_compaction_start" int 383 | 384 | (* extern void rocksdb_options_set_use_adaptive_mutex( *) 385 | (* rocksdb_options_t*, unsigned char); *) 386 | let set_use_adaptive_mutex = 387 | create_setter "set_use_adaptive_mutex" Views.bool_to_uchar 388 | 389 | (* extern void rocksdb_options_set_bytes_per_sync( *) 390 | (* rocksdb_options_t*, uint64_t); *) 391 | let set_bytes_per_sync = 392 | create_setter "set_bytes_per_sync" Views.int_to_uint64_t 393 | 394 | (* extern void rocksdb_options_set_max_sequential_skip_in_iterations( *) 395 | (* rocksdb_options_t*, uint64_t); *) 396 | let set_max_sequential_skip_in_iterations = 397 | create_setter "set_max_sequential_skip_in_iterations" Views.int_to_uint64_t 398 | 399 | (* extern void rocksdb_options_set_disable_auto_compactions(rocksdb_options_t*, int); *) 400 | let set_disable_auto_compactions = 401 | create_setter "set_disable_auto_compactions" int 402 | 403 | (* extern void rocksdb_options_set_delete_obsolete_files_period_micros( *) 404 | (* rocksdb_options_t*, uint64_t); *) 405 | let set_delete_obsolete_files_period_micros = 406 | create_setter "set_delete_obsolete_files_period_micros" Views.int_to_uint64_t 407 | 408 | (* extern void rocksdb_options_set_max_compaction_bytes( 409 | rocksdb_options_t*, uint64_t); *) 410 | let set_max_compaction_bytes = 411 | create_setter "set_max_compaction_bytes" int 412 | 413 | (* extern void rocksdb_options_prepare_for_bulk_load(rocksdb_options_t*\); *) 414 | (* extern void rocksdb_options_set_memtable_vector_rep(rocksdb_options_t*\); *) 415 | (* extern void rocksdb_options_set_hash_skip_list_rep(rocksdb_options_t*, size_t, int32_t, int32_t); *) 416 | (* extern void rocksdb_options_set_hash_link_list_rep(rocksdb_options_t*, size_t); *) 417 | (* extern void rocksdb_options_set_plain_table_factory(rocksdb_options_t*, uint32_t, int, double, size_t); *) 418 | 419 | (* extern void rocksdb_options_set_min_level_to_compress(rocksdb_options_t* opt, int level); *) 420 | let set_min_level_to_compress = 421 | create_setter "set_min_level_to_compress" int 422 | 423 | (* extern void rocksdb_options_set_max_successive_merges( *) 424 | (* rocksdb_options_t*, size_t); *) 425 | let set_max_successive_merges = 426 | create_setter "set_max_successive_merges" Views.int_to_size_t 427 | 428 | (* extern void rocksdb_options_set_bloom_locality( *) 429 | (* rocksdb_options_t*, uint32_t); *) 430 | let set_bloom_locality = 431 | create_setter "set_bloom_locality" Views.int_to_uint32_t 432 | 433 | (* extern void rocksdb_options_set_inplace_update_support( *) 434 | (* rocksdb_options_t*, unsigned char); *) 435 | let set_inplace_update_support = 436 | create_setter "set_inplace_update_support" Views.bool_to_uchar 437 | 438 | (* extern void rocksdb_options_set_inplace_update_num_locks( *) 439 | (* rocksdb_options_t*, size_t); *) 440 | let set_inplace_update_num_locks = 441 | create_setter "set_inplace_update_num_locks" Views.int_to_size_t 442 | 443 | (* enum { *) 444 | (* rocksdb_no_compression = 0, *) 445 | (* rocksdb_snappy_compression = 1, *) 446 | (* rocksdb_zlib_compression = 2, *) 447 | (* rocksdb_bz2_compression = 3, *) 448 | (* rocksdb_lz4_compression = 4, *) 449 | (* rocksdb_lz4hc_compression = 5 *) 450 | (* }; *) 451 | (* extern void rocksdb_options_set_compression(rocksdb_options_t*, int); *) 452 | 453 | (* enum { *) 454 | (* rocksdb_level_compaction = 0, *) 455 | (* rocksdb_universal_compaction = 1, *) 456 | (* rocksdb_fifo_compaction = 2 *) 457 | (* }; *) 458 | (* extern void rocksdb_options_set_compaction_style(rocksdb_options_t*, int); *) 459 | (* extern void rocksdb_options_set_universal_compaction_options(rocksdb_options_t*, rocksdb_universal_compaction_options_t*\); *) 460 | (* extern void rocksdb_options_set_fifo_compaction_options(rocksdb_options_t* opt, *) 461 | (* rocksdb_fifo_compaction_options_t* fifo); *) 462 | 463 | (* extern void rocksdb_options_set_block_based_table_factory( *) 464 | (* rocksdb_options_t *opt, rocksdb_block_based_table_options_t* table_options); *) 465 | let set_block_based_table_factory = 466 | create_setter "set_block_based_table_factory" BlockBasedTableOptions.t 467 | end 468 | 469 | module WriteOptions = struct 470 | module C = CreateConstructors_(struct let name = "writeoptions" end) 471 | include C 472 | 473 | let set_disable_WAL = create_setter "disable_WAL" Views.bool_to_int 474 | let set_sync = create_setter "set_sync" Views.bool_to_uchar 475 | end 476 | 477 | module ReadOptions = struct 478 | module C = CreateConstructors_(struct let name = "readoptions" end) 479 | include C 480 | 481 | let set_snapshot = create_setter "set_snapshot" Snapshot.t 482 | end 483 | 484 | module FlushOptions = struct 485 | module C = CreateConstructors_(struct let name = "flushoptions" end) 486 | include C 487 | 488 | let set_wait = create_setter "set_wait" Views.bool_to_uchar 489 | end 490 | 491 | module TransactionOptions = struct 492 | module C = CreateConstructors_(struct let name = "transaction_options" end) 493 | include C 494 | 495 | let set_set_snapshot = create_setter "set_set_snapshot" Views.bool_to_uchar 496 | end 497 | 498 | module TransactionDbOptions = struct 499 | module C = CreateConstructors_(struct let name = "transactiondb_options" end) 500 | include C 501 | end 502 | -------------------------------------------------------------------------------- /rocks_test.ml: -------------------------------------------------------------------------------- 1 | open Rocks 2 | 3 | let main () = 4 | let () = 5 | let open Version in 6 | Printf.printf "version (%i,%i,%i,%S)\n%!" major minor patch git_revision 7 | in 8 | let open_opts = Options.create () in 9 | Options.set_create_if_missing open_opts true; 10 | 11 | let db = open_db ~opts:open_opts "aname" in 12 | 13 | let () = 14 | try let _ = open_db ~opts:open_opts "/dev/jvioxidsod" in 15 | () 16 | with _ -> () 17 | in 18 | 19 | let write_opts = WriteOptions.create () in 20 | put_string ~opts:write_opts db "mykey" "avalue"; 21 | let read_opts = ReadOptions.create () in 22 | let read key = get_string ~opts:read_opts db key in 23 | let print_string_option x = 24 | print_endline 25 | (match x with 26 | | Some v -> "Some(" ^ v ^ ")" 27 | | None -> "None") in 28 | print_string_option (read "mykey"); 29 | print_string_option (read "mykey2"); 30 | close db 31 | 32 | let () = 33 | try main (); 34 | Gc.full_major () 35 | with exn -> 36 | Gc.full_major (); 37 | raise exn 38 | -------------------------------------------------------------------------------- /travis.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -xue 2 | OUTPUT=temp_file.txt 3 | DISTRO=ubuntu-18.04 4 | 5 | timeout_with_progress () ( 6 | set +x 7 | 8 | timeout "$@" > $OUTPUT 2>&1 & 9 | PID=$! 10 | 11 | echo $PID 12 | 13 | while kill -0 $PID 2>/dev/null 14 | do 15 | echo -ne . 16 | sleep 1 17 | done 18 | 19 | wait $PID 20 | RESULT=$? 21 | 22 | tail -n512 $OUTPUT 23 | 24 | return $RESULT 25 | ) 26 | 27 | install () { 28 | echo "Running 'install' phase" 29 | 30 | date 31 | 32 | START_BUILD=$(date +%s.%N) 33 | echo $START_BUILD 34 | 35 | timeout_with_progress 9000 ./docker/run.sh ${DISTRO} clean 36 | 37 | END_BUILD=$(date +%s.%N) 38 | echo "build stopped after $END_BUILD" 39 | 40 | } 41 | 42 | script () { 43 | echo "Running 'script' phase" 44 | 45 | date 46 | 47 | timeout_with_progress 9000 ./docker/run.sh ${DISTRO} test 48 | 49 | date 50 | } 51 | 52 | 53 | after_failure () { 54 | echo "Something went wrong" 55 | url= `cat temp_file.txt | nc termbin.com 9999` 56 | echo $url 57 | } 58 | 59 | case "${1-undefined}" in 60 | install) 61 | install 62 | ;; 63 | script) 64 | script 65 | ;; 66 | after_failure) 67 | after_failure 68 | ;; 69 | *) 70 | echo "Usage: $0 {install|script}" 71 | exit 1 72 | esac 73 | -------------------------------------------------------------------------------- /which_g++.sh: -------------------------------------------------------------------------------- 1 | for version in 5.2 4.9 4.8; 2 | do 3 | g++-$version --version > /dev/null 2> /dev/null 4 | if [[ $? -eq 0 ]]; 5 | then echo g++-$version ; exit 0 6 | fi 7 | 8 | done 9 | --------------------------------------------------------------------------------