balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Vendors: import ocaml-lmdb

Browse Source
This commit is contained in:
Vincent Bernardoff 2018-05-24 13:32:15 +02:00 committed by Benjamin Canou
parent 6d7fe70c44
commit cbef4c4d0c
15 changed files with 15293 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

283
.gitlab-ci.yml
View File

@ -310,202 +310,207 @@ opam:13:tezos-micheline:
variables:
package: tezos-micheline
opam:14:tezos-base:
<<: *opam_definition
variables:
package: tezos-base
opam:15:pbkdf:
opam:14:pbkdf:
<<: *opam_definition
variables:
package: pbkdf
opam:16:ocplib-resto-cohttp:
opam:15:ocplib-resto-cohttp:
<<: *opam_definition
variables:
package: ocplib-resto-cohttp
opam:16:tezos-base:
<<: *opam_definition
variables:
package: tezos-base
opam:17:irmin-leveldb:
<<: *opam_definition
variables:
package: irmin-leveldb
opam:18:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-environment-sigs
opam:19:tezos-stdlib-unix:
<<: *opam_definition
variables:
package: tezos-stdlib-unix
opam:20:bip39:
opam:18:bip39:
<<: *opam_definition
variables:
package: bip39
opam:21:tezos-rpc-http:
opam:19:tezos-rpc-http:
<<: *opam_definition
variables:
package: tezos-rpc-http
opam:22:tezos-shell-services:
opam:20:tezos-shell-services:
<<: *opam_definition
variables:
package: tezos-shell-services
opam:23:tezos-storage:
opam:21:tezos-stdlib-unix:
<<: *opam_definition
variables:
package: tezos-stdlib-unix
opam:22:tezos-storage:
<<: *opam_definition
variables:
package: tezos-storage
opam:24:tezos-protocol-compiler:
opam:23:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-compiler
package: tezos-protocol-environment-sigs
opam:25:tezos-client-base:
opam:24:tezos-client-base:
<<: *opam_definition
variables:
package: tezos-client-base
opam:26:tezos-protocol-alpha:
opam:25:tezos-protocol-compiler:
<<: *opam_definition
variables:
package: tezos-protocol-alpha
package: tezos-protocol-compiler
opam:27:tezos-protocol-environment:
<<: *opam_definition
variables:
package: tezos-protocol-environment
opam:28:tezos-client-alpha:
<<: *opam_definition
variables:
package: tezos-client-alpha
opam:29:tezos-client-commands:
<<: *opam_definition
variables:
package: tezos-client-commands
opam:30:tezos-protocol-environment-shell:
<<: *opam_definition
variables:
package: tezos-protocol-environment-shell
opam:31:tezos-baking-alpha:
<<: *opam_definition
variables:
package: tezos-baking-alpha
opam:32:tezos-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-protocol-genesis
opam:33:ocplib-resto-json:
<<: *opam_definition
variables:
package: ocplib-resto-json
opam:34:tezos-protocol-updater:
<<: *opam_definition
variables:
package: tezos-protocol-updater
opam:35:tezos-p2p:
<<: *opam_definition
variables:
package: tezos-p2p
opam:36:tezos-baking-alpha-commands:
<<: *opam_definition
variables:
package: tezos-baking-alpha-commands
opam:37:tezos-client-alpha-commands:
<<: *opam_definition
variables:
package: tezos-client-alpha-commands
opam:38:tezos-client-base-unix:
<<: *opam_definition
variables:
package: tezos-client-base-unix
opam:39:tezos-client-genesis:
<<: *opam_definition
variables:
package: tezos-client-genesis
opam:40:ocplib-ezresto:
<<: *opam_definition
variables:
package: ocplib-ezresto
opam:41:tezos-embedded-protocol-alpha:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-alpha
opam:42:tezos-embedded-protocol-demo:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-demo
opam:43:tezos-embedded-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-genesis
opam:44:tezos-shell:
<<: *opam_definition
variables:
package: tezos-shell
opam:45:tezos-client:
<<: *opam_definition
variables:
package: tezos-client
opam:46:tezos-signer-services:
opam:26:tezos-signer-services:
<<: *opam_definition
variables:
package: tezos-signer-services
opam:47:ocplib-ezresto-directory:
opam:27:tezos-protocol-alpha:
<<: *opam_definition
variables:
package: ocplib-ezresto-directory
package: tezos-protocol-alpha
opam:48:tezos-baker-alpha:
opam:28:tezos-protocol-environment:
<<: *opam_definition
variables:
package: tezos-baker-alpha
package: tezos-protocol-environment
opam:49:tezos-protocol-demo:
<<: *opam_definition
variables:
package: tezos-protocol-demo
opam:50:tezos-signer:
<<: *opam_definition
variables:
package: tezos-signer
opam:51:tezos-signer-backends:
opam:29:tezos-signer-backends:
<<: *opam_definition
variables:
package: tezos-signer-backends
opam:52:tezos-node:
opam:30:tezos-client-alpha:
<<: *opam_definition
variables:
package: tezos-client-alpha
opam:31:tezos-client-commands:
<<: *opam_definition
variables:
package: tezos-client-commands
opam:32:tezos-protocol-environment-shell:
<<: *opam_definition
variables:
package: tezos-protocol-environment-shell
opam:33:tezos-baking-alpha:
<<: *opam_definition
variables:
package: tezos-baking-alpha
opam:34:tezos-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-protocol-genesis
opam:35:ocplib-resto-json:
<<: *opam_definition
variables:
package: ocplib-resto-json
opam:36:tezos-protocol-updater:
<<: *opam_definition
variables:
package: tezos-protocol-updater
opam:37:tezos-p2p:
<<: *opam_definition
variables:
package: tezos-p2p
opam:38:tezos-baking-alpha-commands:
<<: *opam_definition
variables:
package: tezos-baking-alpha-commands
opam:39:tezos-client-alpha-commands:
<<: *opam_definition
variables:
package: tezos-client-alpha-commands
opam:40:tezos-client-base-unix:
<<: *opam_definition
variables:
package: tezos-client-base-unix
opam:41:tezos-client-genesis:
<<: *opam_definition
variables:
package: tezos-client-genesis
opam:42:ocplib-ezresto:
<<: *opam_definition
variables:
package: ocplib-ezresto
opam:43:lmdb:
<<: *opam_definition
variables:
package: lmdb
opam:44:tezos-embedded-protocol-alpha:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-alpha
opam:45:tezos-embedded-protocol-demo:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-demo
opam:46:tezos-embedded-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-genesis
opam:47:tezos-shell:
<<: *opam_definition
variables:
package: tezos-shell
opam:48:tezos-client:
<<: *opam_definition
variables:
package: tezos-client
opam:49:ocplib-ezresto-directory:
<<: *opam_definition
variables:
package: ocplib-ezresto-directory
opam:50:tezos-baker-alpha:
<<: *opam_definition
variables:
package: tezos-baker-alpha
opam:51:tezos-protocol-demo:
<<: *opam_definition
variables:
package: tezos-protocol-demo
opam:52:tezos-signer:
<<: *opam_definition
variables:
package: tezos-signer
opam:53:tezos-node:
<<: *opam_definition
variables:
package: tezos-node
opam:53:ocplib-json-typed-browser:
opam:54:ocplib-json-typed-browser:
<<: *opam_definition
variables:
package: ocplib-json-typed-browser

47
vendors/ocaml-lmdb/LICENSE vendored Normal file
View File

@ -0,0 +1,47 @@
The OpenLDAP Public License
Version 2.8, 17 August 2003
Redistribution and use of this software and associated documentation
("Software"), with or without modification, are permitted provided
that the following conditions are met:
1. Redistributions in source form must retain copyright statements
and notices,
2. Redistributions in binary form must reproduce applicable copyright
statements and notices, this list of conditions, and the following
disclaimer in the documentation and/or other materials provided
with the distribution, and
3. Redistributions must contain a verbatim copy of this document.
The OpenLDAP Foundation may revise this license from time to time.
Each revision is distinguished by a version number. You may use
this Software under terms of this license revision or under the
terms of any subsequent revision of the license.
THIS SOFTWARE IS PROVIDED BY THE OPENLDAP FOUNDATION AND ITS
CONTRIBUTORS ``AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
SHALL THE OPENLDAP FOUNDATION, ITS CONTRIBUTORS, OR THE AUTHOR(S)
OR OWNER(S) OF THE SOFTWARE BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
The names of the authors and copyright holders must not be used in
advertising or otherwise to promote the sale, use or other dealing
in this Software without specific, written prior permission. Title
to copyright in this Software shall at all times remain with copyright
holders.
OpenLDAP is a registered trademark of the OpenLDAP Foundation.
Copyright 1999-2003 The OpenLDAP Foundation, Redwood City,
California, USA. All Rights Reserved. Permission to copy and
distribute verbatim copies of this document is granted.

4
vendors/ocaml-lmdb/config/discover.ml vendored Normal file
View File

@ -0,0 +1,4 @@
let () =
let oc = open_out "c_flags.sexp" in
output_string oc (if Sys.word_size = 32 then "(-DMDB_VL32)" else "()") ;
close_out oc

4
vendors/ocaml-lmdb/config/jbuild vendored Normal file
View File

@ -0,0 +1,4 @@
(jbuild_version 1)
(executable
((name discover)))

21
vendors/ocaml-lmdb/lmdb.opam vendored Normal file
View File

@ -0,0 +1,21 @@
opam-version: "1.2"
name: "lmdb"
version: "0.1"
authors: "Vincent Bernardoff <vb@luminar.eu.org>"
maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
license: "ISC"
homepage: "https://github.com/vbmithr/ocaml-lmdb"
bug-reports: "https://github.com/vbmithr/ocaml-lmdb/issues"
dev-repo: "git://github.com/vbmithr/ocaml-lmdb"
available: [
ocaml-version >= "4.02.0"
]
build: [ "jbuilder" "build" "-j" jobs "-p" name "@install" ]
depends: [
"jbuilder" {build & >= "1.0+beta18"}
"rresult" {>= "0.5.0"}
"cstruct" {test & >= "3.2.1"}
"alcotest" {test & >= "0.8.1"}
]

14
vendors/ocaml-lmdb/src/jbuild vendored Normal file
View File

@ -0,0 +1,14 @@
(jbuild_version 1)
(library
((name lmdb)
(public_name lmdb)
(libraries (rresult))
(c_names (mdb midl lmdb_stubs))
(c_flags (:include c_flags.sexp))
(c_library_flags (-lpthread))))
(rule
((targets (c_flags.sexp))
(deps (../config/discover.exe))
(action (run ${<} -ocamlc ${OCAMLC}))))

1647
vendors/ocaml-lmdb/src/lmdb.h vendored Normal file
View File

File diff suppressed because it is too large Load Diff

648
vendors/ocaml-lmdb/src/lmdb.ml vendored Normal file
View File

@ -0,0 +1,648 @@
(*---------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
module Option = struct
let map ~f = function
| None -> None
| Some v -> Some (f v)
end
let finalize ~final ~f =
try
let res = f () in
final () ;
res
with exn ->
final () ;
raise exn
open Rresult
type error =
| NoSuchFileOrDir
| IOError
| EnvironmentLocked
| OutOfMemory
| PermissionDenied
| InvalidArgument
| NoSpaceLeftOnDevice
| KeyExist
| KeyNotFound
| PageNotFound
| Corrupted
| Panic
| VersionMismatch
| InvalidFile
| MapFull
| DbsFull
| ReadersFull
| TLSFull
| TxnFull
| CursorFull
| PageFull
| MapResized
| Incompatible
| BadRslot
| BadTxn
| BadValSize
| BadDbi
| TxnProblem
let int_of_error = function
| NoSuchFileOrDir -> 2
| IOError -> 5
| EnvironmentLocked -> 11
| OutOfMemory -> 12
| PermissionDenied -> 13
| InvalidArgument -> 22
| NoSpaceLeftOnDevice -> 28
| KeyExist -> -30799
| KeyNotFound -> -30798
| PageNotFound -> -30797
| Corrupted -> -30796
| Panic -> -30795
| VersionMismatch -> -30794
| InvalidFile -> -30793
| MapFull -> -30792
| DbsFull -> -30791
| ReadersFull -> -30790
| TLSFull -> -30789
| TxnFull -> -30788
| CursorFull -> -30787
| PageFull -> -30786
| MapResized -> -30785
| Incompatible -> -30784
| BadRslot -> -30783
| BadTxn -> -30782
| BadValSize -> -30781
| BadDbi -> -30780
| TxnProblem -> -30779
let error_of_int = function
| 2 -> NoSuchFileOrDir
| 5 -> IOError
| 11 -> EnvironmentLocked
| 12 -> OutOfMemory
| 13 -> PermissionDenied
| 22 -> InvalidArgument
| 28 -> NoSpaceLeftOnDevice
| -30799 -> KeyExist
| -30798 -> KeyNotFound
| -30797 -> PageNotFound
| -30796 -> Corrupted
| -30795 -> Panic
| -30794 -> VersionMismatch
| -30793 -> InvalidFile
| -30792 -> MapFull
| -30791 -> DbsFull
| -30790 -> ReadersFull
| -30789 -> TLSFull
| -30788 -> TxnFull
| -30787 -> CursorFull
| -30786 -> PageFull
| -30785 -> MapResized
| -30784 -> Incompatible
| -30783 -> BadRslot
| -30782 -> BadTxn
| -30781 -> BadValSize
| -30780 -> BadDbi
| -30779 -> TxnProblem
| i -> invalid_arg (Printf.sprintf "error_of_int: %d" i)
type version = {
major : int ;
minor : int ;
patch : int ;
}
external version : unit -> version = "stub_mdb_version"
external strerror : int -> string = "stub_mdb_strerror"
let string_of_error error =
strerror (int_of_error error)
let pp_error ppf err =
Format.fprintf ppf "%s" (string_of_error err)
let to_msg t = R.error_to_msg ~pp_error t
type t
external create : unit -> (t, int) result = "stub_mdb_env_create"
type flag_env =
| FixedMap
| NoSubdir
| NoSync
| RdOnly
| NoMetaSync
| WriteMap
| MapAsync
| NoTLS
| NoLock
| NoRdAhead
| NoMemInit
| PrevMeta
let int_of_flag_env = function
| FixedMap -> 0x01
| NoSubdir -> 0x4000
| NoSync -> 0x10_000
| RdOnly -> 0x20_000
| NoMetaSync -> 0x40_000
| WriteMap -> 0x80_000
| MapAsync -> 0x100_000
| NoTLS -> 0x200_000
| NoLock -> 0x400_000
| NoRdAhead -> 0x800_000
| NoMemInit -> 0x1_000_000
| PrevMeta -> 0x2_000_000
let flags_env_of_int v =
List.fold_left begin fun acc flag ->
if v land (int_of_flag_env flag) <> 0 then flag :: acc else acc
end []
[ FixedMap ; NoSubdir ; NoSync ; RdOnly ; NoMetaSync ;
WriteMap ; MapAsync ; NoTLS ; NoLock ; NoRdAhead ;
NoMemInit ; PrevMeta ]
type flag_open =
| ReverseKey
| DupSort
| IntegerKey
| DupFixed
| IntegerDup
| ReverseDup
| Create
let int_of_flag_open = function
| ReverseKey -> 0x02
| DupSort -> 0x04
| IntegerKey -> 0x08
| DupFixed -> 0x10
| IntegerDup -> 0x20
| ReverseDup -> 0x40
| Create -> 0x40_000
let flags_open_of_int v =
List.fold_left begin fun acc flag ->
if v land (int_of_flag_open flag) <> 0 then flag :: acc else acc
end []
[ ReverseKey ; DupSort ; IntegerKey ; DupFixed ; IntegerDup ;
ReverseDup ; Create ]
type flag_put =
| NoOverwrite
| NoDupData
| Current
| Reserve
| Append
| AppendDup
| Multiple
let int_of_flag_put = function
| NoOverwrite -> 0x10
| NoDupData -> 0x20
| Current -> 0x40
| Reserve -> 0x10_000
| Append -> 0x20_000
| AppendDup -> 0x40_000
| Multiple -> 0x80_000
let fold_flags int_of_flag flags =
List.fold_left (fun a flag -> a lor (int_of_flag flag)) 0 flags
let int_of_flags_env = fold_flags int_of_flag_env
let int_of_flags_open = fold_flags int_of_flag_open
let int_of_flags_put = fold_flags int_of_flag_put
let return ?(on_error = fun () -> ()) ret v =
if ret = 0 then
Ok v
else begin
on_error () ;
Error (error_of_int ret)
end
external set_maxreaders : t -> int -> int = "stub_mdb_env_set_maxreaders" [@@noalloc]
let set_maxreaders t readers =
let ret = set_maxreaders t readers in
return ret ()
external set_maxdbs : t -> int -> int = "stub_mdb_env_set_maxdbs" [@@noalloc]
let set_maxdbs t dbs =
let ret = set_maxdbs t dbs in
return ret ()
external set_mapsize : t -> int64 -> int = "stub_mdb_env_set_mapsize" [@@noalloc]
let set_mapsize t size =
let ret = set_mapsize t size in
return ret ()
external opendir :
t -> string -> int -> Unix.file_perm -> int = "stub_mdb_env_open" [@@noalloc]
external closedir :
t -> unit = "stub_mdb_env_close" [@@noalloc]
let opendir ?maxreaders ?maxdbs ?mapsize ?(flags=[]) path mode =
match create () with
| Error v -> Error (error_of_int v)
| Ok t ->
begin match maxreaders with
| None -> Ok ()
| Some readers -> set_maxreaders t readers
end >>= fun () ->
begin match maxdbs with
| None -> Ok ()
| Some dbs -> set_maxdbs t dbs
end >>= fun () ->
begin match mapsize with
| None -> Ok ()
| Some size -> set_mapsize t size
end >>= fun () ->
let ret = opendir t path (int_of_flags_env flags) mode in
return ret t ~on_error:(fun () -> closedir t)
external copy :
t -> string -> int -> int = "stub_mdb_env_copy2" [@@noalloc]
let copy ?(compact=false) t path =
let ret = copy t path (if compact then 0x01 else 0x00) in
return ret ()
external copyfd :
t -> Unix.file_descr -> int -> int = "stub_mdb_env_copyfd2" [@@noalloc]
let copyfd ?(compact=false) t fd =
let ret = copyfd t fd (if compact then 0x01 else 0x00) in
return ret ()
type stat = {
psize : int ;
depth : int ;
branch_pages : int ;
leaf_pages : int ;
overflow_pages : int ;
entries : int ;
}
external stat : t -> stat = "stub_mdb_env_stat"
type envinfo = {
mapsize : int ;
last_pgno : int ;
last_txnid : int ;
maxreaders : int ;
numreaders : int ;
}
external envinfo : t -> envinfo = "stub_mdb_env_info"
external sync : t -> bool -> int = "stub_mdb_env_sync" [@@noalloc]
let sync ?(force=false) t =
let ret = sync t force in
return ret ()
external setclear_flags :
t -> int -> bool -> int = "stub_mdb_env_set_flags" [@@noalloc]
let set_flags t flags =
let ret = setclear_flags t (int_of_flags_env flags) true in
return ret ()
let clear_flags t flags =
let ret = setclear_flags t (int_of_flags_env flags) false in
return ret ()
external get_flags : t -> int = "stub_mdb_env_get_flags" [@@noalloc]
let get_flags t =
flags_env_of_int (get_flags t)
external get_path : t -> string = "stub_mdb_env_get_path"
external get_fd : t -> Unix.file_descr = "stub_mdb_env_get_fd" [@@noalloc]
external get_maxreaders : t -> int = "stub_mdb_env_get_maxreaders" [@@noalloc]
external get_maxkeysize : t -> int = "stub_mdb_env_get_maxkeysize" [@@noalloc]
type rawtxn
type ro
type rw
type _ txn =
| Txn_ro : rawtxn -> ro txn
| Txn_rw : rawtxn -> rw txn
let rawtxn_of_txn : type a. a txn -> rawtxn = function
| Txn_ro rawtxn -> rawtxn
| Txn_rw rawtxn -> rawtxn
external txn_begin :
t -> int -> rawtxn option -> (rawtxn, int) result = "stub_mdb_txn_begin"
let create_rw_txn ?(sync=true) ?(metasync=true) ?parent t =
let flags = match sync, metasync with
| true, true -> int_of_flags_env [NoSync; NoMetaSync]
| true, false -> int_of_flag_env NoSync
| false, true -> int_of_flag_env NoMetaSync
| _ -> 0 in
match txn_begin t flags (Option.map ~f:rawtxn_of_txn parent) with
| Error i -> Error (error_of_int i)
| Ok tx -> Ok (Txn_rw tx)
let create_ro_txn ?(sync=true) ?(metasync=true) ?parent t =
let flags = match sync, metasync with
| true, true -> int_of_flags_env [RdOnly; NoSync; NoMetaSync]
| true, false -> int_of_flags_env [RdOnly; NoSync]
| false, true -> int_of_flags_env [RdOnly; NoMetaSync]
| _ -> int_of_flag_env RdOnly in
match txn_begin t flags (Option.map ~f:rawtxn_of_txn parent) with
| Error i -> Error (error_of_int i)
| Ok tx -> Ok (Txn_ro tx)
external get_txn_id : rawtxn -> int = "stub_mdb_txn_id" [@@noalloc]
external get_txn_env : rawtxn -> t = "stub_mdb_txn_env"
let get_txn_id txn =
get_txn_id (rawtxn_of_txn txn)
let get_txn_env txn =
get_txn_env (rawtxn_of_txn txn)
external commit_txn : rawtxn -> int = "stub_mdb_txn_commit" [@@noalloc]
external abort_txn : rawtxn -> unit = "stub_mdb_txn_abort" [@@noalloc]
let commit_txn txn =
return (commit_txn (rawtxn_of_txn txn)) ()
let abort_txn txn =
abort_txn (rawtxn_of_txn txn)
external reset_ro_txn : rawtxn -> unit = "stub_mdb_txn_reset" [@@noalloc]
external renew_ro_txn : rawtxn -> int = "stub_mdb_txn_renew" [@@noalloc]
let reset_ro_txn (Txn_ro rawtxn) =
reset_ro_txn rawtxn
let renew_ro_txn (Txn_ro rawtxn) =
return (renew_ro_txn rawtxn) ()
type db = nativeint
external opendb :
rawtxn -> string option -> int -> (db, int) result = "stub_mdb_dbi_open"
let opendb ?(flags=[]) ?name txn =
R.reword_error error_of_int
(opendb (rawtxn_of_txn txn) name (int_of_flags_open flags))
external db_stat :
rawtxn -> db -> (stat, int) result = "stub_mdb_stat"
let db_stat txn dbi =
R.reword_error error_of_int (db_stat (rawtxn_of_txn txn) dbi)
external db_flags :
rawtxn -> db -> (int, int) result = "stub_mdb_dbi_flags"
let db_flags txn dbi =
match db_flags (rawtxn_of_txn txn) dbi with
| Error i -> Error (error_of_int i)
| Ok v -> Ok (flags_open_of_int v)
external db_drop :
rawtxn -> db -> bool -> int = "stub_mdb_drop" [@@noalloc]
let db_drop txn dbi =
return (db_drop (rawtxn_of_txn txn) dbi false) ()
let with_ro_db ?sync ?metasync ?parent ?flags ?name t ~f =
create_ro_txn ?sync ?metasync ?parent t >>= fun txn ->
opendb ?flags ?name txn >>= fun db ->
match f txn db with
| exception exn ->
abort_txn txn ;
raise exn
| Ok res ->
commit_txn txn >>= fun () ->
Ok res
| Error err ->
abort_txn txn ;
Error err
let with_rw_db ?sync ?metasync ?parent ?flags ?name t ~f =
create_rw_txn ?sync ?metasync ?parent t >>= fun txn ->
opendb ?flags ?name txn >>= fun db ->
match f txn db with
| exception exn ->
abort_txn txn ;
raise exn
| Ok res ->
commit_txn txn >>= fun () ->
Ok res
| Error err ->
abort_txn txn ;
Error err
type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
external get :
rawtxn -> db -> string -> (buffer, int) result = "stub_mdb_get"
let get txn dbi k =
R.reword_error error_of_int (get (rawtxn_of_txn txn) dbi k)
let mem txn dbi k =
match get txn dbi k with
| Ok _ -> Ok true
| Error KeyNotFound -> Ok false
| Error err -> Error err
external put :
rawtxn -> db -> string -> buffer -> int -> int = "stub_mdb_put" [@@noalloc]
external put_string :
rawtxn -> db -> string -> string -> int -> int = "stub_mdb_put_string" [@@noalloc]
let put ?(flags=[]) txn dbi k v =
let flags = int_of_flags_put flags in
return (put (rawtxn_of_txn txn) dbi k v flags) ()
let put_string ?(flags=[]) txn dbi k v =
let flags = int_of_flags_put flags in
return (put_string (rawtxn_of_txn txn) dbi k v flags) ()
external del :
rawtxn -> db -> string -> buffer option -> int = "stub_mdb_del" [@@noalloc]
external del_string :
rawtxn -> db -> string -> string option -> int = "stub_mdb_del_string" [@@noalloc]
let del ?data txn dbi k =
return (del (rawtxn_of_txn txn) dbi k data) ()
let del_string ?data txn dbi k =
return (del_string (rawtxn_of_txn txn) dbi k data) ()
type rawcursor
type _ cursor =
| Cursor_ro : rawcursor -> ro cursor
| Cursor_rw : rawcursor -> rw cursor
let rawcursor_of_cursor : type a. a cursor -> rawcursor = function
| Cursor_ro rawcursor -> rawcursor
| Cursor_rw rawcursor -> rawcursor
let cursor_ro rawcursor = Cursor_ro rawcursor
let cursor_rw rawcursor = Cursor_rw rawcursor
external opencursor :
rawtxn -> db -> (rawcursor, int) result = "stub_mdb_cursor_open"
let opencursor :
type a. a txn -> db -> (a cursor, error) result = fun txn dbi ->
match txn with
| Txn_ro rawtxn ->
R.reword_error error_of_int (opencursor rawtxn dbi) |>
R.map cursor_ro
| Txn_rw rawtxn ->
R.reword_error error_of_int (opencursor rawtxn dbi) |>
R.map cursor_rw
external cursor_close :
rawcursor -> unit = "stub_mdb_cursor_close" [@@noalloc]
external cursor_renew :
rawtxn -> rawcursor -> int = "stub_mdb_cursor_renew" [@@noalloc]
let cursor_close cursor =
cursor_close (rawcursor_of_cursor cursor)
let cursor_renew (Txn_ro rawtxn) (Cursor_ro rawcursor) =
return (cursor_renew rawtxn rawcursor) ()
external cursor_txn :
rawcursor -> rawtxn = "stub_mdb_cursor_txn"
let cursor_txn : type a. a cursor -> a txn = function
| Cursor_ro rawcursor -> Txn_ro (cursor_txn rawcursor)
| Cursor_rw rawcursor -> Txn_rw (cursor_txn rawcursor)
external cursor_db :
rawcursor -> db = "stub_mdb_cursor_dbi" [@@noalloc]
let cursor_db cursor =
cursor_db (rawcursor_of_cursor cursor)
type cursor_op =
| First
| First_dup
| Get_both
| Get_both_range
| Get_current
| Get_multiple
| Last
| Last_dup
| Next
| Next_dup
| Next_multiple
| Next_nodup
| Prev
| Prev_dup
| Prev_nodup
| Set
| Set_key
| Set_range
| Prev_multiple
external cursor_get_op :
rawcursor -> string option -> buffer option -> cursor_op ->
(buffer * buffer, int) result = "stub_mdb_cursor_get"
let cursor_get_op ?key ?data cursor op =
R.reword_error error_of_int
(cursor_get_op (rawcursor_of_cursor cursor) key data op)
let cursor_first cursor =
R.map ignore (cursor_get_op cursor First)
let cursor_last cursor =
R.map ignore (cursor_get_op cursor Last)
let cursor_next cursor =
R.map ignore (cursor_get_op cursor Next)
let cursor_prev cursor =
R.map ignore (cursor_get_op cursor Prev)
let cursor_at cursor = function
| "" -> cursor_first cursor
| key -> R.map ignore (cursor_get_op ~key cursor Set_range)
let cursor_get cursor =
cursor_get_op cursor Get_current
let cursor_fold_left ~f ~init cursor =
let rec inner a =
match cursor_get cursor with
| Error KeyNotFound -> Ok a
| Error err -> Error err
| Ok kv ->
f a kv >>= fun a ->
match cursor_next cursor with
| Error KeyNotFound -> Ok a
| Error err -> Error err
| Ok () -> inner a
in
inner init
let cursor_iter ~f cursor =
cursor_fold_left ~init:() ~f:(fun () kv -> f kv) cursor
external cursor_put :
rawcursor -> string -> buffer -> int -> int = "stub_mdb_cursor_put" [@@noalloc]
external cursor_put_string :
rawcursor -> string -> string -> int -> int = "stub_mdb_cursor_put_string" [@@noalloc]
external cursor_del :
rawcursor -> int -> int = "stub_mdb_cursor_del" [@@noalloc]
external cursor_count :
rawcursor -> (int, int) result = "stub_mdb_cursor_count"
let cursor_put ?(flags=[]) cursor k v =
return
(cursor_put (rawcursor_of_cursor cursor) k v (int_of_flags_put flags))
()
let cursor_put_string ?(flags=[]) cursor k v =
return
(cursor_put_string (rawcursor_of_cursor cursor) k v (int_of_flags_put flags))
()
let cursor_del ?(flags=[]) cursor =
return
(cursor_del (rawcursor_of_cursor cursor) (int_of_flags_put flags))
()
let cursor_count cursor =
R.reword_error error_of_int
(cursor_count (rawcursor_of_cursor cursor))
let with_cursor txn db ~f =
opencursor txn db >>= fun cursor ->
finalize
~final:(fun () -> cursor_close cursor)
~f:(fun () -> f cursor)
(*---------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---------------------------------------------------------------------------*)

255
vendors/ocaml-lmdb/src/lmdb.mli vendored Normal file
View File

@ -0,0 +1,255 @@
(*---------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
open Rresult
type error =
| NoSuchFileOrDir
| IOError
| EnvironmentLocked
| OutOfMemory
| PermissionDenied
| InvalidArgument
| NoSpaceLeftOnDevice
| KeyExist
| KeyNotFound
| PageNotFound
| Corrupted
| Panic
| VersionMismatch
| InvalidFile
| MapFull
| DbsFull
| ReadersFull
| TLSFull
| TxnFull
| CursorFull
| PageFull
| MapResized
| Incompatible
| BadRslot
| BadTxn
| BadValSize
| BadDbi
| TxnProblem
val string_of_error : error -> string
val pp_error : Format.formatter -> error -> unit
val to_msg : ('a, error) result -> ('a, [> R.msg]) result
type version = {
major : int ;
minor : int ;
patch : int ;
}
val version : unit -> version
type ro
type rw
type t
type flag_env =
| FixedMap
| NoSubdir
| NoSync
| RdOnly
| NoMetaSync
| WriteMap
| MapAsync
| NoTLS
| NoLock
| NoRdAhead
| NoMemInit
| PrevMeta
val opendir :
?maxreaders:int -> ?maxdbs:int -> ?mapsize:int64 -> ?flags:flag_env list ->
string -> Unix.file_perm -> (t, error) result
val closedir : t -> unit
val copy : ?compact:bool -> t -> string -> (unit, error) result
val copyfd : ?compact:bool -> t -> Unix.file_descr -> (unit, error) result
type stat = {
psize : int ;
depth : int ;
branch_pages : int ;
leaf_pages : int ;
overflow_pages : int ;
entries : int ;
}
val stat : t -> stat
type envinfo = {
mapsize : int ;
last_pgno : int ;
last_txnid : int ;
maxreaders : int ;
numreaders : int ;
}
val envinfo : t -> envinfo
val sync : ?force:bool -> t -> (unit, error) result
val get_flags : t -> flag_env list
val set_flags : t -> flag_env list -> (unit, error) result
val clear_flags : t -> flag_env list -> (unit, error) result
val get_path : t -> string
val get_fd : t -> Unix.file_descr
val get_maxreaders : t -> int
val get_maxkeysize : t -> int
val set_mapsize : t -> int64 -> (unit, error) result
type _ txn
val create_rw_txn :
?sync:bool -> ?metasync:bool ->
?parent:rw txn -> t -> (rw txn, error) result
val create_ro_txn :
?sync:bool -> ?metasync:bool ->
?parent:_ txn -> t -> (ro txn, error) result
val get_txn_id : _ txn -> int
val get_txn_env : _ txn -> t
val commit_txn : _ txn -> (unit, error) result
val abort_txn : _ txn -> unit
val reset_ro_txn : ro txn -> unit
val renew_ro_txn : ro txn -> (unit, error) result
type flag_open =
| ReverseKey
| DupSort
| IntegerKey
| DupFixed
| IntegerDup
| ReverseDup
| Create
type db
val opendb :
?flags:flag_open list -> ?name:string -> _ txn -> (db, error) result
val db_stat : _ txn -> db -> (stat, error) result
val db_flags : _ txn -> db -> (flag_open list, error) result
val db_drop : _ txn -> db -> (unit, error) result
val with_ro_db :
?sync:bool -> ?metasync:bool ->
?parent:_ txn -> ?flags:flag_open list ->
?name:string -> t -> f:(ro txn -> db -> ('a, error) result) ->
('a, error) result
val with_rw_db :
?sync:bool -> ?metasync:bool ->
?parent:rw txn -> ?flags:flag_open list ->
?name:string -> t -> f:(rw txn -> db -> ('a, error) result) ->
('a, error) result
type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
val get : _ txn -> db -> string -> (buffer, error) result
val mem : _ txn -> db -> string -> (bool, error) result
type flag_put =
| NoOverwrite
| NoDupData
| Current
| Reserve
| Append
| AppendDup
| Multiple
val put : ?flags:flag_put list ->
rw txn -> db -> string -> buffer -> (unit, error) result
val put_string : ?flags:flag_put list ->
rw txn -> db -> string -> string -> (unit, error) result
val del : ?data:buffer ->
rw txn -> db -> string -> (unit, error) result
val del_string : ?data:string ->
rw txn -> db -> string -> (unit, error) result
type _ cursor
val opencursor : 'a txn -> db -> ('a cursor, error) result
val cursor_close : _ cursor -> unit
val cursor_renew : ro txn -> ro cursor -> (unit, error) result
val cursor_txn : 'a cursor -> 'a txn
val cursor_db : _ cursor -> db
val cursor_first : _ cursor -> (unit, error) result
val cursor_last : _ cursor -> (unit, error) result
val cursor_prev : _ cursor -> (unit, error) result
val cursor_next : _ cursor -> (unit, error) result
val cursor_at : _ cursor -> string -> (unit, error) result
val cursor_get : _ cursor -> (buffer * buffer, error) result
val cursor_fold_left :
f:('a -> (buffer * buffer) -> ('a, error) result) ->
init:'a -> _ cursor -> ('a, error) result
val cursor_iter :
f:(buffer * buffer -> (unit, error) result) -> _ cursor -> (unit, error) result
val with_cursor :
'a txn -> db -> f:('a cursor -> ('b, error) result) ->
('b, error) result
type cursor_op =
| First
| First_dup
| Get_both
| Get_both_range
| Get_current
| Get_multiple
| Last
| Last_dup
| Next
| Next_dup
| Next_multiple
| Next_nodup
| Prev
| Prev_dup
| Prev_nodup
| Set
| Set_key
| Set_range
| Prev_multiple
val cursor_put : ?flags:flag_put list ->
rw cursor -> string -> buffer -> (unit, error) result
val cursor_put_string : ?flags:flag_put list ->
rw cursor -> string -> string -> (unit, error) result
val cursor_del : ?flags:flag_put list -> rw cursor -> (unit, error) result
val cursor_count : _ cursor -> (int, error) result
(*---------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---------------------------------------------------------------------------*)

566
vendors/ocaml-lmdb/src/lmdb_stubs.c vendored Normal file
View File

@ -0,0 +1,566 @@
/* --------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
--------------------------------------------------------------------------- */
#include <string.h>
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/custom.h>
#include <caml/bigarray.h>
#include "lmdb.h"
CAMLprim value stub_mdb_version(value unit) {
CAMLparam1(unit);
CAMLlocal1(result);
int major, minor, patch;
mdb_version(&major, &minor, &patch);
result = caml_alloc_tuple(3);
Store_field(result, 0, Val_int(major));
Store_field(result, 1, Val_int(minor));
Store_field(result, 2, Val_int(patch));
CAMLreturn(result);
}
CAMLprim value stub_mdb_strerror(value errno) {
CAMLparam1(errno);
CAMLlocal1(result);
char *errstr;
errstr = mdb_strerror(Int_val(errno));
result = caml_copy_string(errstr);
CAMLreturn(result);
}
#define Env_val(v) (*((MDB_env **) Data_custom_val(v)))
#define Txn_val(v) (*((MDB_txn **) Data_custom_val(v)))
#define Cursor_val(v) (*((MDB_cursor **) Data_custom_val(v)))
#define Gen_custom_block(SNAME, CNAME, MNAME) \
static int compare_##SNAME(value a, value b) { \
CNAME *aa = MNAME(a), *bb = MNAME(b); \
return (aa == bb ? 0 : (aa < bb ? -1 : 1)); \
} \
\
static struct custom_operations lmdb_##SNAME##_ops = { \
.identifier = "lmdb_" #SNAME, \
.finalize = custom_finalize_default, \
.compare = compare_##SNAME, \
.compare_ext = custom_compare_ext_default, \
.hash = custom_hash_default, \
.serialize = custom_serialize_default, \
.deserialize = custom_deserialize_default \
}; \
\
static value alloc_##SNAME (CNAME *a) { \
value custom = alloc_custom(&lmdb_##SNAME##_ops, sizeof(CNAME *), 0, 1); \
MNAME(custom) = a; \
return custom; \
}
Gen_custom_block(env, MDB_env, Env_val)
Gen_custom_block(txn, MDB_txn, Txn_val)
Gen_custom_block(cursor, MDB_cursor, Cursor_val)
CAMLprim value stub_mdb_env_create(value unit) {
CAMLparam1(unit);
CAMLlocal2(result, ml_env);
int ret;
MDB_env *env;
ret = mdb_env_create(&env);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_env = alloc_env(env);
Store_field(result, 0, ml_env);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_open(value env, value path, value flags, value mode) {
return Val_int(mdb_env_open(Env_val(env), String_val(path), Int_val(flags), Int_val(mode)));
}
CAMLprim value stub_mdb_env_close(value env) {
mdb_env_close(Env_val(env));
return Val_unit;
}
CAMLprim value stub_mdb_env_copy2(value env, value path, value flags) {
return Val_int(mdb_env_copy2(Env_val(env), String_val(path), Int_val(flags)));
}
CAMLprim value stub_mdb_env_copyfd2(value env, value fd, value flags) {
return Val_int(mdb_env_copyfd2(Env_val(env), Int_val(fd), Int_val(flags)));
}
static void caml_mdb_stat(value result, const MDB_stat *stat) {
Store_field(result, 0, Val_int(stat->ms_psize));
Store_field(result, 1, Val_int(stat->ms_depth));
Store_field(result, 2, Val_long(stat->ms_branch_pages));
Store_field(result, 3, Val_long(stat->ms_leaf_pages));
Store_field(result, 4, Val_long(stat->ms_overflow_pages));
Store_field(result, 5, Val_long(stat->ms_entries));
}
CAMLprim value stub_mdb_env_stat(value env) {
CAMLparam1(env);
CAMLlocal1(result);
MDB_stat stat;
mdb_env_stat(Env_val(env), &stat);
result = caml_alloc_tuple(6);
caml_mdb_stat(result, &stat);
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_info(value env) {
CAMLparam1(env);
CAMLlocal1(result);
MDB_envinfo info;
mdb_env_info(Env_val(env), &info);
result = caml_alloc_tuple(5);
Store_field(result, 0, Val_long(info.me_mapsize));
Store_field(result, 1, Val_long(info.me_last_pgno));
Store_field(result, 2, Val_long(info.me_last_txnid));
Store_field(result, 3, Val_int(info.me_maxreaders));
Store_field(result, 4, Val_int(info.me_numreaders));
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_sync(value env, value force) {
return Val_int(mdb_env_sync(Env_val(env), Bool_val(force)));
}
CAMLprim value stub_mdb_env_set_flags(value env, value flags, value onoff) {
return Val_int(mdb_env_set_flags(Env_val(env), Int_val(flags), Bool_val(onoff)));
}
CAMLprim value stub_mdb_env_get_flags(value env) {
int flags;
mdb_env_get_flags(Env_val(env), &flags);
return Val_int(flags);
}
CAMLprim value stub_mdb_env_get_path(value env) {
CAMLparam1(env);
CAMLlocal1(result);
const char *path;
mdb_env_get_path(Env_val(env), &path);
result = caml_copy_string(path);
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_get_fd(value env) {
mdb_filehandle_t fd;
mdb_env_get_fd(Env_val(env), &fd);
return Val_int(fd);
}
CAMLprim value stub_mdb_env_set_mapsize(value env, value size) {
return Val_int(mdb_env_set_mapsize(Env_val(env), Int64_val(size)));
}
CAMLprim value stub_mdb_env_set_maxreaders(value env, value readers) {
return Val_int(mdb_env_set_maxreaders(Env_val(env), Int_val(readers)));
}
CAMLprim value stub_mdb_env_get_maxreaders(value env) {
unsigned int readers;
mdb_env_get_maxreaders(Env_val(env), &readers);
return Val_int(readers);
}
CAMLprim value stub_mdb_env_set_maxdbs(value env, value dbs) {
return Val_int(mdb_env_set_maxdbs(Env_val(env), Int_val(dbs)));
}
CAMLprim value stub_mdb_env_get_maxkeysize(value env) {
return Val_int(mdb_env_get_maxkeysize(Env_val(env)));
}
CAMLprim value stub_mdb_txn_begin(value env, value flags, value parent) {
CAMLparam3(env, flags, parent);
CAMLlocal2(result, ml_txn);
int ret;
MDB_txn *parent_txn = Is_block(parent) ? Txn_val(Field(parent, 0)) : NULL;
MDB_txn *new_txn;
ret = mdb_txn_begin(Env_val(env), parent_txn, Int_val(flags), &new_txn);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_txn = alloc_txn(new_txn);
Store_field(result, 0, ml_txn);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_txn_env(value txn) {
CAMLparam1(txn);
CAMLlocal1(result);
MDB_env *env = mdb_txn_env(Txn_val(txn));
result = alloc_env(env);
CAMLreturn(result);
}
CAMLprim value stub_mdb_txn_id(value txn) {
return Val_long(mdb_txn_id(Txn_val(txn)));
}
CAMLprim value stub_mdb_txn_commit(value txn) {
return Val_int(mdb_txn_commit(Txn_val(txn)));
}
CAMLprim value stub_mdb_txn_abort(value txn) {
mdb_txn_abort(Txn_val(txn));
return Val_unit;
}
CAMLprim value stub_mdb_txn_reset(value txn) {
mdb_txn_reset(Txn_val(txn));
return Val_unit;
}
CAMLprim value stub_mdb_txn_renew(value txn) {
return Val_int(mdb_txn_renew(Txn_val(txn)));
}
CAMLprim value stub_mdb_dbi_open(value txn, value name, value flags) {
CAMLparam3(txn, name, flags);
CAMLlocal2(result, ml_dbi);
MDB_dbi dbi;
int ret;
const char* db_name = NULL;
if (Is_block(name)) db_name = String_val(Field(name, 0));
ret = mdb_dbi_open(Txn_val(txn), db_name, Int_val(flags), &dbi);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_dbi = caml_copy_nativeint(dbi);
Store_field(result, 0, ml_dbi);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_stat(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal2(result, tuple);
MDB_stat stat;
int ret;
ret = mdb_stat(Txn_val(txn), Nativeint_val(dbi), &stat);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(6);
caml_mdb_stat(tuple, &stat);
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_dbi_flags(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal1(result);
unsigned int flags;
int ret;
ret = mdb_dbi_flags(Txn_val(txn), Nativeint_val(dbi), &flags);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, Val_int(flags));
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_dbi_close(value env, value dbi) {
mdb_dbi_close(Env_val(env), Nativeint_val(dbi));
return Val_unit;
}
CAMLprim value stub_mdb_drop(value txn, value dbi, value del) {
return Val_int(mdb_drop(Txn_val(txn), Nativeint_val(dbi), Bool_val(del)));
}
static inline value alloc_mdb_val_ba (MDB_val *v) {
return
(v ?
caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, v->mv_data, v->mv_size) :
caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, NULL, 0));
}
CAMLprim value stub_mdb_get(value txn, value dbi, value key) {
CAMLparam3(txn, dbi, key);
CAMLlocal1(result);
MDB_val k, v;
int ret;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
ret = mdb_get(Txn_val(txn), Nativeint_val(dbi), &k, &v);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, alloc_mdb_val_ba(&v));
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_put(value txn, value dbi,
value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = Caml_ba_array_val(data)->dim[0];
v.mv_data = Caml_ba_data_val(data);
return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_put_string(value txn, value dbi,
value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = caml_string_length(data);
v.mv_data = String_val(data);
return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_del(value txn, value dbi, value key, value data) {
MDB_val k, v, *vp = NULL;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
if (Is_block(data)) {
v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
v.mv_data = Caml_ba_data_val(Field(data, 0));
vp = &v;
}
return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
}
CAMLprim value stub_mdb_del_string(value txn, value dbi, value key, value data) {
MDB_val k, v, *vp = NULL;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
if (Is_block(data)) {
v.mv_size = caml_string_length(Field(data, 0));
v.mv_data = String_val(Field(data, 0));
vp = &v;
}
return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
}
CAMLprim value stub_mdb_cursor_open(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal2(result, ml_cursor);
MDB_cursor *cursor;
int ret;
ret = mdb_cursor_open(Txn_val(txn), Nativeint_val(dbi), &cursor);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_cursor = alloc_cursor(cursor);
Store_field(result, 0, ml_cursor);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_close(value cursor) {
mdb_cursor_close(Cursor_val(cursor));
return Val_unit;
}
CAMLprim value stub_mdb_cursor_renew(value txn, value cursor) {
return Val_int(mdb_cursor_renew(Txn_val(txn), Cursor_val(cursor)));
}
CAMLprim value stub_mdb_cursor_txn(value cursor) {
return (value) mdb_cursor_txn(Cursor_val(cursor));
}
CAMLprim value stub_mdb_cursor_dbi(value cursor) {
return Val_int(mdb_cursor_dbi(Cursor_val(cursor)));
}
CAMLprim value stub_mdb_cursor_get(value cursor, value key, value data, value op) {
CAMLparam4(cursor, key, data, op);
CAMLlocal2(result, tuple);
MDB_val k, v;
int ret;
if (Is_block(key)) {
k.mv_size = caml_string_length(Field(key, 0));
k.mv_data = String_val(Field(key, 0));
}
if (Is_block(data)) {
v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
v.mv_data = Caml_ba_data_val(Field(data, 0));
}
ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(2);
Store_field(tuple, 0, alloc_mdb_val_ba(&k));
Store_field(tuple, 1, alloc_mdb_val_ba(&v));
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_get_string(value cursor, value key, value data, value op) {
CAMLparam4(cursor, key, data, op);
CAMLlocal2(result, tuple);
MDB_val k, v;
int ret;
if (Is_block(key)) {
k.mv_size = caml_string_length(Field(key, 0));
k.mv_data = String_val(Field(key, 0));
}
if (Is_block(data)) {
v.mv_size = caml_string_length(Field(data, 0));
v.mv_data = String_val(Field(data, 0));
}
ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(2);
Store_field(tuple, 0, alloc_mdb_val_ba(&k));
Store_field(tuple, 1, alloc_mdb_val_ba(&v));
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_put(value cursor, value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = Caml_ba_array_val(data)->dim[0];
v.mv_data = Caml_ba_data_val(data);
return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_put_string(value cursor, value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = caml_string_length(data);
v.mv_data = String_val(data);
return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_del(value cursor, value flags) {
return Val_int(mdb_cursor_del(Cursor_val(cursor), Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_count(value cursor) {
CAMLparam1(cursor);
CAMLlocal1(result);
mdb_size_t count;
int ret;
ret = mdb_cursor_count(Cursor_val(cursor), &count);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, Val_long(count));
}
CAMLreturn(result);
}
/* --------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--------------------------------------------------------------------------- */

11130
vendors/ocaml-lmdb/src/mdb.c vendored Normal file
View File

File diff suppressed because it is too large Load Diff

421
vendors/ocaml-lmdb/src/midl.c vendored Normal file
View File

@ -0,0 +1,421 @@
/** @file midl.c
* @brief ldap bdb back-end ID List functions */
/* $OpenLDAP$ */
/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
*
* Copyright 2000-2016 The OpenLDAP Foundation.
* Portions Copyright 2001-2017 Howard Chu, Symas Corp.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted only as authorized by the OpenLDAP
* Public License.
*
* A copy of this license is available in the file LICENSE in the
* top-level directory of the distribution or, alternatively, at
* <http://www.OpenLDAP.org/license.html>.
*/
#include <limits.h>
#include <string.h>
#include <stdlib.h>
#include <errno.h>
#include <sys/types.h>
#include "midl.h"
/** @defgroup internal LMDB Internals
* @{
*/
/** @defgroup idls ID List Management
* @{
*/
#define CMP(x,y) ( (x) < (y) ? -1 : (x) > (y) )
unsigned mdb_midl_search( MDB_IDL ids, MDB_ID id )
{
/*
* binary search of id in ids
* if found, returns position of id
* if not found, returns first position greater than id
*/
unsigned base = 0;
unsigned cursor = 1;
int val = 0;
unsigned n = ids[0];
while( 0 < n ) {
unsigned pivot = n >> 1;
cursor = base + pivot + 1;
val = CMP( ids[cursor], id );
if( val < 0 ) {
n = pivot;
} else if ( val > 0 ) {
base = cursor;
n -= pivot + 1;
} else {
return cursor;
}
}
if( val > 0 ) {
++cursor;
}
return cursor;
}
#if 0 /* superseded by append/sort */
int mdb_midl_insert( MDB_IDL ids, MDB_ID id )
{
unsigned x, i;
x = mdb_midl_search( ids, id );
assert( x > 0 );
if( x < 1 ) {
/* internal error */
return -2;
}
if ( x <= ids[0] && ids[x] == id ) {
/* duplicate */
assert(0);
return -1;
}
if ( ++ids[0] >= MDB_IDL_DB_MAX ) {
/* no room */
--ids[0];
return -2;
} else {
/* insert id */
for (i=ids[0]; i>x; i--)
ids[i] = ids[i-1];
ids[x] = id;
}
return 0;
}
#endif
MDB_IDL mdb_midl_alloc(int num)
{
MDB_IDL ids = malloc((num+2) * sizeof(MDB_ID));
if (ids) {
*ids++ = num;
*ids = 0;
}
return ids;
}
void mdb_midl_free(MDB_IDL ids)
{
if (ids)
free(ids-1);
}
void mdb_midl_shrink( MDB_IDL *idp )
{
MDB_IDL ids = *idp;
if (*(--ids) > MDB_IDL_UM_MAX &&
(ids = realloc(ids, (MDB_IDL_UM_MAX+2) * sizeof(MDB_ID))))
{
*ids++ = MDB_IDL_UM_MAX;
*idp = ids;
}
}
static int mdb_midl_grow( MDB_IDL *idp, int num )
{
MDB_IDL idn = *idp-1;
/* grow it */
idn = realloc(idn, (*idn + num + 2) * sizeof(MDB_ID));
if (!idn)
return ENOMEM;
*idn++ += num;
*idp = idn;
return 0;
}
int mdb_midl_need( MDB_IDL *idp, unsigned num )
{
MDB_IDL ids = *idp;
num += ids[0];
if (num > ids[-1]) {
num = (num + num/4 + (256 + 2)) & -256;
if (!(ids = realloc(ids-1, num * sizeof(MDB_ID))))
return ENOMEM;
*ids++ = num - 2;
*idp = ids;
}
return 0;
}
int mdb_midl_append( MDB_IDL *idp, MDB_ID id )
{
MDB_IDL ids = *idp;
/* Too big? */
if (ids[0] >= ids[-1]) {
if (mdb_midl_grow(idp, MDB_IDL_UM_MAX))
return ENOMEM;
ids = *idp;
}
ids[0]++;
ids[ids[0]] = id;
return 0;
}
int mdb_midl_append_list( MDB_IDL *idp, MDB_IDL app )
{
MDB_IDL ids = *idp;
/* Too big? */
if (ids[0] + app[0] >= ids[-1]) {
if (mdb_midl_grow(idp, app[0]))
return ENOMEM;
ids = *idp;
}
memcpy(&ids[ids[0]+1], &app[1], app[0] * sizeof(MDB_ID));
ids[0] += app[0];
return 0;
}
int mdb_midl_append_range( MDB_IDL *idp, MDB_ID id, unsigned n )
{
MDB_ID *ids = *idp, len = ids[0];
/* Too big? */
if (len + n > ids[-1]) {
if (mdb_midl_grow(idp, n | MDB_IDL_UM_MAX))
return ENOMEM;
ids = *idp;
}
ids[0] = len + n;
ids += len;
while (n)
ids[n--] = id++;
return 0;
}
void mdb_midl_xmerge( MDB_IDL idl, MDB_IDL merge )
{
MDB_ID old_id, merge_id, i = merge[0], j = idl[0], k = i+j, total = k;
idl[0] = (MDB_ID)-1; /* delimiter for idl scan below */
old_id = idl[j];
while (i) {
merge_id = merge[i--];
for (; old_id < merge_id; old_id = idl[--j])
idl[k--] = old_id;
idl[k--] = merge_id;
}
idl[0] = total;
}
/* Quicksort + Insertion sort for small arrays */
#define SMALL 8
#define MIDL_SWAP(a,b) { itmp=(a); (a)=(b); (b)=itmp; }
void
mdb_midl_sort( MDB_IDL ids )
{
/* Max possible depth of int-indexed tree * 2 items/level */
int istack[sizeof(int)*CHAR_BIT * 2];
int i,j,k,l,ir,jstack;
MDB_ID a, itmp;
ir = (int)ids[0];
l = 1;
jstack = 0;
for(;;) {
if (ir - l < SMALL) { /* Insertion sort */
for (j=l+1;j<=ir;j++) {
a = ids[j];
for (i=j-1;i>=1;i--) {
if (ids[i] >= a) break;
ids[i+1] = ids[i];
}
ids[i+1] = a;
}
if (jstack == 0) break;
ir = istack[jstack--];
l = istack[jstack--];
} else {
k = (l + ir) >> 1; /* Choose median of left, center, right */
MIDL_SWAP(ids[k], ids[l+1]);
if (ids[l] < ids[ir]) {
MIDL_SWAP(ids[l], ids[ir]);
}
if (ids[l+1] < ids[ir]) {
MIDL_SWAP(ids[l+1], ids[ir]);
}
if (ids[l] < ids[l+1]) {
MIDL_SWAP(ids[l], ids[l+1]);
}
i = l+1;
j = ir;
a = ids[l+1];
for(;;) {
do i++; while(ids[i] > a);
do j--; while(ids[j] < a);
if (j < i) break;
MIDL_SWAP(ids[i],ids[j]);
}
ids[l+1] = ids[j];
ids[j] = a;
jstack += 2;
if (ir-i+1 >= j-l) {
istack[jstack] = ir;
istack[jstack-1] = i;
ir = j-1;
} else {
istack[jstack] = j-1;
istack[jstack-1] = l;
l = i;
}
}
}
}
unsigned mdb_mid2l_search( MDB_ID2L ids, MDB_ID id )
{
/*
* binary search of id in ids
* if found, returns position of id
* if not found, returns first position greater than id
*/
unsigned base = 0;
unsigned cursor = 1;
int val = 0;
unsigned n = (unsigned)ids[0].mid;
while( 0 < n ) {
unsigned pivot = n >> 1;
cursor = base + pivot + 1;
val = CMP( id, ids[cursor].mid );
if( val < 0 ) {
n = pivot;
} else if ( val > 0 ) {
base = cursor;
n -= pivot + 1;
} else {
return cursor;
}
}
if( val > 0 ) {
++cursor;
}
return cursor;
}
int mdb_mid2l_insert( MDB_ID2L ids, MDB_ID2 *id )
{
unsigned x, i;
x = mdb_mid2l_search( ids, id->mid );
if( x < 1 ) {
/* internal error */
return -2;
}
if ( x <= ids[0].mid && ids[x].mid == id->mid ) {
/* duplicate */
return -1;
}
if ( ids[0].mid >= MDB_IDL_UM_MAX ) {
/* too big */
return -2;
} else {
/* insert id */
ids[0].mid++;
for (i=(unsigned)ids[0].mid; i>x; i--)
ids[i] = ids[i-1];
ids[x] = *id;
}
return 0;
}
int mdb_mid2l_append( MDB_ID2L ids, MDB_ID2 *id )
{
/* Too big? */
if (ids[0].mid >= MDB_IDL_UM_MAX) {
return -2;
}
ids[0].mid++;
ids[ids[0].mid] = *id;
return 0;
}
#ifdef MDB_VL32
unsigned mdb_mid3l_search( MDB_ID3L ids, MDB_ID id )
{
/*
* binary search of id in ids
* if found, returns position of id
* if not found, returns first position greater than id
*/
unsigned base = 0;
unsigned cursor = 1;
int val = 0;
unsigned n = (unsigned)ids[0].mid;
while( 0 < n ) {
unsigned pivot = n >> 1;
cursor = base + pivot + 1;
val = CMP( id, ids[cursor].mid );
if( val < 0 ) {
n = pivot;
} else if ( val > 0 ) {
base = cursor;
n -= pivot + 1;
} else {
return cursor;
}
}
if( val > 0 ) {
++cursor;
}
return cursor;
}
int mdb_mid3l_insert( MDB_ID3L ids, MDB_ID3 *id )
{
unsigned x, i;
x = mdb_mid3l_search( ids, id->mid );
if( x < 1 ) {
/* internal error */
return -2;
}
if ( x <= ids[0].mid && ids[x].mid == id->mid ) {
/* duplicate */
return -1;
}
/* insert id */
ids[0].mid++;
for (i=(unsigned)ids[0].mid; i>x; i--)
ids[i] = ids[i-1];
ids[x] = *id;
return 0;
}
#endif /* MDB_VL32 */
/** @} */
/** @} */

204
vendors/ocaml-lmdb/src/midl.h vendored Normal file
View File

@ -0,0 +1,204 @@
/** @file midl.h
* @brief LMDB ID List header file.
*
* This file was originally part of back-bdb but has been
* modified for use in libmdb. Most of the macros defined
* in this file are unused, just left over from the original.
*
* This file is only used internally in libmdb and its definitions
* are not exposed publicly.
*/
/* $OpenLDAP$ */
/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
*
* Copyright 2000-2016 The OpenLDAP Foundation.
* Portions Copyright 2001-2017 Howard Chu, Symas Corp.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted only as authorized by the OpenLDAP
* Public License.
*
* A copy of this license is available in the file LICENSE in the
* top-level directory of the distribution or, alternatively, at
* <http://www.OpenLDAP.org/license.html>.
*/
#ifndef _MDB_MIDL_H_
#define _MDB_MIDL_H_
#include "lmdb.h"
#ifdef __cplusplus
extern "C" {
#endif
/** @defgroup internal LMDB Internals
* @{
*/
/** @defgroup idls ID List Management
* @{
*/
/** A generic unsigned ID number. These were entryIDs in back-bdb.
* Preferably it should have the same size as a pointer.
*/
typedef mdb_size_t MDB_ID;
/** An IDL is an ID List, a sorted array of IDs. The first
* element of the array is a counter for how many actual
* IDs are in the list. In the original back-bdb code, IDLs are
* sorted in ascending order. For libmdb IDLs are sorted in
* descending order.
*/
typedef MDB_ID *MDB_IDL;
/* IDL sizes - likely should be even bigger
* limiting factors: sizeof(ID), thread stack size
*/
#ifdef MDB_VL32
#define MDB_IDL_LOGN 14 /* DB_SIZE is 2^14, UM_SIZE is 2^15 */
#else
#define MDB_IDL_LOGN 16 /* DB_SIZE is 2^16, UM_SIZE is 2^17 */
#endif
#define MDB_IDL_DB_SIZE (1<<MDB_IDL_LOGN)
#define MDB_IDL_UM_SIZE (1<<(MDB_IDL_LOGN+1))
#define MDB_IDL_DB_MAX (MDB_IDL_DB_SIZE-1)
#define MDB_IDL_UM_MAX (MDB_IDL_UM_SIZE-1)
#define MDB_IDL_SIZEOF(ids) (((ids)[0]+1) * sizeof(MDB_ID))
#define MDB_IDL_IS_ZERO(ids) ( (ids)[0] == 0 )
#define MDB_IDL_CPY( dst, src ) (memcpy( dst, src, MDB_IDL_SIZEOF( src ) ))
#define MDB_IDL_FIRST( ids ) ( (ids)[1] )
#define MDB_IDL_LAST( ids ) ( (ids)[(ids)[0]] )
/** Current max length of an #mdb_midl_alloc()ed IDL */
#define MDB_IDL_ALLOCLEN( ids ) ( (ids)[-1] )
/** Append ID to IDL. The IDL must be big enough. */
#define mdb_midl_xappend(idl, id) do { \
MDB_ID *xidl = (idl), xlen = ++(xidl[0]); \
xidl[xlen] = (id); \
} while (0)
/** Search for an ID in an IDL.
* @param[in] ids The IDL to search.
* @param[in] id The ID to search for.
* @return The index of the first ID greater than or equal to \b id.
*/
unsigned mdb_midl_search( MDB_IDL ids, MDB_ID id );
/** Allocate an IDL.
* Allocates memory for an IDL of the given size.
* @return IDL on success, NULL on failure.
*/
MDB_IDL mdb_midl_alloc(int num);
/** Free an IDL.
* @param[in] ids The IDL to free.
*/
void mdb_midl_free(MDB_IDL ids);
/** Shrink an IDL.
* Return the IDL to the default size if it has grown larger.
* @param[in,out] idp Address of the IDL to shrink.
*/
void mdb_midl_shrink(MDB_IDL *idp);
/** Make room for num additional elements in an IDL.
* @param[in,out] idp Address of the IDL.
* @param[in] num Number of elements to make room for.
* @return 0 on success, ENOMEM on failure.
*/
int mdb_midl_need(MDB_IDL *idp, unsigned num);
/** Append an ID onto an IDL.
* @param[in,out] idp Address of the IDL to append to.
* @param[in] id The ID to append.
* @return 0 on success, ENOMEM if the IDL is too large.
*/
int mdb_midl_append( MDB_IDL *idp, MDB_ID id );
/** Append an IDL onto an IDL.
* @param[in,out] idp Address of the IDL to append to.
* @param[in] app The IDL to append.
* @return 0 on success, ENOMEM if the IDL is too large.
*/
int mdb_midl_append_list( MDB_IDL *idp, MDB_IDL app );
/** Append an ID range onto an IDL.
* @param[in,out] idp Address of the IDL to append to.
* @param[in] id The lowest ID to append.
* @param[in] n Number of IDs to append.
* @return 0 on success, ENOMEM if the IDL is too large.
*/
int mdb_midl_append_range( MDB_IDL *idp, MDB_ID id, unsigned n );
/** Merge an IDL onto an IDL. The destination IDL must be big enough.
* @param[in] idl The IDL to merge into.
* @param[in] merge The IDL to merge.
*/
void mdb_midl_xmerge( MDB_IDL idl, MDB_IDL merge );
/** Sort an IDL.
* @param[in,out] ids The IDL to sort.
*/
void mdb_midl_sort( MDB_IDL ids );
/** An ID2 is an ID/pointer pair.
*/
typedef struct MDB_ID2 {
MDB_ID mid; /**< The ID */
void *mptr; /**< The pointer */
} MDB_ID2;
/** An ID2L is an ID2 List, a sorted array of ID2s.
* The first element's \b mid member is a count of how many actual
* elements are in the array. The \b mptr member of the first element is unused.
* The array is sorted in ascending order by \b mid.
*/
typedef MDB_ID2 *MDB_ID2L;
/** Search for an ID in an ID2L.
* @param[in] ids The ID2L to search.
* @param[in] id The ID to search for.
* @return The index of the first ID2 whose \b mid member is greater than or equal to \b id.
*/
unsigned mdb_mid2l_search( MDB_ID2L ids, MDB_ID id );
/** Insert an ID2 into a ID2L.
* @param[in,out] ids The ID2L to insert into.
* @param[in] id The ID2 to insert.
* @return 0 on success, -1 if the ID was already present in the ID2L.
*/
int mdb_mid2l_insert( MDB_ID2L ids, MDB_ID2 *id );
/** Append an ID2 into a ID2L.
* @param[in,out] ids The ID2L to append into.
* @param[in] id The ID2 to append.
* @return 0 on success, -2 if the ID2L is too big.
*/
int mdb_mid2l_append( MDB_ID2L ids, MDB_ID2 *id );
#ifdef MDB_VL32
typedef struct MDB_ID3 {
MDB_ID mid; /**< The ID */
void *mptr; /**< The pointer */
unsigned int mcnt; /**< Number of pages */
unsigned int mref; /**< Refcounter */
} MDB_ID3;
typedef MDB_ID3 *MDB_ID3L;
unsigned mdb_mid3l_search( MDB_ID3L ids, MDB_ID id );
int mdb_mid3l_insert( MDB_ID3L ids, MDB_ID3 *id );
#endif /* MDB_VL32 */
/** @} */
/** @} */
#ifdef __cplusplus
}
#endif
#endif /* _MDB_MIDL_H_ */

10
vendors/ocaml-lmdb/test/jbuild vendored Normal file
View File

@ -0,0 +1,10 @@
(jbuild_version 1)
(executable
((name test)
(libraries (cstruct rresult lmdb alcotest))))
(alias
((name runtest-lmdb)
(deps (test.exe))
(action (run ${<}))))

178
vendors/ocaml-lmdb/test/test.ml vendored Normal file
View File

@ -0,0 +1,178 @@
open Rresult
open Lmdb
let assert_false v =
assert (not v)
let assert_error err = function
| Ok _ -> invalid_arg "assert_error"
| Error e -> if e <> err then invalid_arg "assert_error"
let assert_equal_ba expected ba =
assert (expected = Cstruct.(to_string (of_bigarray ba)))
let version () =
let { major ; minor ; patch } = version () in
assert (major = 0) ;
assert (minor = 9) ;
assert (patch = 70)
let test_string_of_error () =
let errmsg = string_of_error KeyExist in
assert (String.length errmsg > 0)
let cleanup () =
let files = [ "/tmp/data.mdb" ; "/tmp/lock.mdb" ] in
ListLabels.iter files ~f:begin fun fn ->
Sys.(if file_exists fn then remove fn)
end
let env () =
cleanup () ;
opendir ~maxreaders:34 ~maxdbs:1 "/tmp" 0o644 >>= fun env ->
let _stat = stat env in
let _envinfo = envinfo env in
let _flags = get_flags env in
let _path = get_path env in
let _fd = get_fd env in
let _maxreaders = get_maxreaders env in
let _maxkeysize = get_maxkeysize env in
sync env >>= fun () ->
Ok ()
let txn () =
cleanup () ;
opendir ~maxdbs:1 "/tmp" 0o644 >>= fun env ->
create_ro_txn env >>= fun rotxn ->
reset_ro_txn rotxn ;
create_rw_txn env >>= fun rwtxn ->
assert (rwtxn = rwtxn) ;
let env2 = get_txn_env rwtxn in
assert (env = env2) ;
opendb rwtxn >>= fun defaultdbi ->
opendb ~flags:[Create] rwtxn ~name:"bleh" >>= fun dbi ->
put_string rwtxn dbi "test" "test" >>= fun () ->
get rwtxn dbi "test" >>= fun buffer ->
assert_equal_ba "test" buffer ;
assert_error KeyNotFound (del rwtxn dbi "bleh") ;
del rwtxn dbi "test" >>= fun () ->
db_stat rwtxn dbi >>= fun _stat ->
db_flags rwtxn dbi >>= fun _flags ->
db_drop rwtxn dbi >>= fun () ->
closedir env ;
Ok ()
let cursors () =
cleanup () ;
opendir "/tmp" 0o644 >>= fun env ->
create_rw_txn env >>= fun txn ->
opendb txn >>= fun db ->
opencursor txn db >>= fun cursor ->
assert_error KeyNotFound (cursor_first cursor) ;
assert_error KeyNotFound (cursor_last cursor) ;
cursor_put_string cursor "test" "test" >>= fun () ->
cursor_put_string cursor "test2" "test2" >>= fun () ->
sync env >>= fun () ->
cursor_first cursor >>= fun () ->
cursor_at cursor "" >>= fun () ->
assert_error KeyNotFound (cursor_prev cursor) ;
cursor_last cursor >>= fun () ->
assert_error KeyNotFound (cursor_next cursor) ;
cursor_prev cursor >>= fun () ->
get txn db "test" >>= fun buf ->
assert_equal_ba "test" buf ;
cursor_get cursor >>= fun (k, v) ->
assert_equal_ba "test" k ;
assert_equal_ba "test" v ;
closedir env ;
Ok ()
let cursors_del () =
cleanup () ;
opendir "/tmp" 0o644 >>= fun env ->
with_rw_db env ~f:begin fun txn db ->
with_cursor txn db ~f:begin fun cursor ->
cursor_put_string cursor "k1" "v1" >>= fun () ->
cursor_first cursor >>= fun () ->
cursor_fold_left cursor ~init:() ~f:begin fun acc (_k, _v) ->
cursor_del cursor
end >>= fun () ->
assert_error KeyNotFound (cursor_first cursor) ;
Ok ()
end
end
let cursors_del4 () =
cleanup () ;
opendir "/tmp" 0o644 >>= fun env ->
with_rw_db env ~f:begin fun txn db ->
with_cursor txn db ~f:begin fun cursor ->
cursor_put_string cursor "k1" "v1" >>= fun () ->
cursor_put_string cursor "k2" "v2" >>= fun () ->
cursor_put_string cursor "k3" "v3" >>= fun () ->
cursor_put_string cursor "k4" "v4" >>= fun () ->
cursor_first cursor >>= fun () ->
cursor_fold_left cursor ~init:() ~f:begin fun acc (_k, _v) ->
cursor_del cursor
end >>= fun () ->
assert_error KeyNotFound (cursor_first cursor) ;
Ok ()
end
end
let fold () =
cleanup () ;
opendir "/tmp" 0o644 >>= fun env ->
with_rw_db env ~f:begin fun txn db ->
opencursor txn db >>= fun cursor ->
cursor_put_string cursor "k1" "v1" >>= fun () ->
cursor_put_string cursor "k2" "v2" >>= fun () ->
cursor_put_string cursor "k3" "v3" >>= fun () ->
cursor_put_string cursor "k4" "v4" >>= fun () ->
cursor_first cursor >>= fun () ->
cursor_fold_left ~f:begin fun i (k, v) ->
assert_equal_ba ("k" ^ (string_of_int i)) k ;
assert_equal_ba ("v" ^ (string_of_int i)) v ;
Ok (succ i)
end ~init:1 cursor >>= fun _ ->
Ok ()
end >>= fun () ->
closedir env ;
Ok ()
let consistency () =
cleanup () ;
opendir "/tmp" 0o644 >>= fun env ->
let v = Cstruct.(to_bigarray (of_string "bleh")) in
with_rw_db env ~f:begin fun txn db ->
put txn db "bleh" v
end >>= fun () ->
with_ro_db env ~f:begin fun txn db ->
get txn db "bleh" >>= fun v' ->
(* assert (v = v') ; *)
assert_equal_ba "bleh" v' ;
Ok ()
end >>= fun () ->
Ok ()
let fail_on_error f () =
match f () with
| Ok _ -> ()
| Error err -> failwith (string_of_error err)
let basic = [
"version", `Quick, version ;
"string_of_error", `Quick, test_string_of_error ;
"env", `Quick, fail_on_error env ;
"txn", `Quick, fail_on_error txn ;
"cursors", `Quick, fail_on_error cursors ;
"cursors_del", `Quick, fail_on_error cursors_del ;
"cursors_del4", `Quick, fail_on_error cursors_del4 ;
"fold", `Quick, fail_on_error fold ;
"consistency", `Quick, fail_on_error consistency ;
]
let () =
Alcotest.run "lmdb" [
"basic", basic ;
]