diff --git a/scripts/Dockerfile.binaries.in b/scripts/Dockerfile.binaries.in index a78ea81b8..a8dce42bf 100644 --- a/scripts/Dockerfile.binaries.in +++ b/scripts/Dockerfile.binaries.in @@ -5,7 +5,10 @@ LABEL distro_style="apk" distro="alpine" distro_long="alpine-$alpine_version" ar RUN adduser -S tezos && \ apk update && \ apk upgrade && \ - apk add sudo bash libssl1.0 libsodium libev gmp git && \ + apk add sudo bash libssl1.0 libsodium libev gmp git snappy && \ + apk add leveldb \ + --update-cache \ + --repository http://nl.alpinelinux.org/alpine/edge/testing && \ rm -f /var/cache/apk/* && \ echo 'tezos ALL=(ALL:ALL) NOPASSWD:ALL' > /etc/sudoers.d/tezos && \ chmod 440 /etc/sudoers.d/tezos && \ diff --git a/scripts/Dockerfile.build_deps.in b/scripts/Dockerfile.build_deps.in index 28c8411a2..f1239bbf0 100644 --- a/scripts/Dockerfile.build_deps.in +++ b/scripts/Dockerfile.build_deps.in @@ -2,7 +2,10 @@ FROM ocaml/opam:alpine-$alpine_version_ocaml-$ocaml_version COPY scripts/install_build_deps.sh scripts/version.sh scripts/ COPY src/tezos-deps.opam src/ -RUN sudo apk add libsodium-dev && \ +RUN sudo apk add libsodium-dev snappy-dev && \ + sudo apk add leveldb-dev \ + --update-cache \ + --repository http://nl.alpinelinux.org/alpine/edge/testing && \ opam switch $ocaml_version && \ opam config exec -- ./scripts/install_build_deps.sh all \ rm -fr ~/.opam/log/ \ diff --git a/src/.merlin b/src/.merlin index f85696440..1e9835b3b 100644 --- a/src/.merlin +++ b/src/.merlin @@ -20,7 +20,6 @@ S client B client S attacker B attacker -FLG -open Result FLG -w -30 FLG -w -40 PKG base64 @@ -48,3 +47,4 @@ PKG sodium PKG ssl PKG unix PKG zarith +PKG leveldb \ No newline at end of file diff --git a/src/Makefile.config b/src/Makefile.config index 5668d6d22..cda9daa10 100644 --- a/src/Makefile.config +++ b/src/Makefile.config @@ -13,7 +13,7 @@ DEVFLAGS := -bin-annot -g endif OCAMLFLAGS = \ - ${DEVFLAGS} -short-paths -safe-string -w +27-30-40@8 \ + ${DEVFLAGS} -thread -short-paths -safe-string -w +27-30-40@8 \ ${INCLUDES} \ ${EXTRA_OCAMLFLAGS} diff --git a/src/Makefile.files b/src/Makefile.files index 4b51d1f15..96ce1ba6e 100644 --- a/src/Makefile.files +++ b/src/Makefile.files @@ -313,6 +313,8 @@ NODE_PACKAGES := \ irmin.unix \ ocplib-resto.directory \ ssl \ + threads.posix \ + leveldb \ EMBEDDED_NODE_PROTOCOLS := \ $(patsubst ${SRCDIR}/proto/%/,${SRCDIR}/proto/embedded_proto_%.cmxa, \ diff --git a/src/node/db/raw_store.ml b/src/node/db/raw_store.ml index e5210daad..ab0943764 100644 --- a/src/node/db/raw_store.ml +++ b/src/node/db/raw_store.ml @@ -7,89 +7,133 @@ (* *) (**************************************************************************) +module List = ListLabels open Logging.Db -type t = { root : string } - -let init root = - IO.check_dir root >>=? fun () -> - return { root } - +type t = LevelDB.db type key = string list type value = MBytes.t -let file_of_key { root } key = - String.concat Filename.dir_sep (root :: key) - -let dir_of_key { root } key = - let dir = List.rev @@ List.tl (List.rev key) in - String.concat Filename.dir_sep (root :: dir) - -let known s k = - let file = file_of_key s k in - Lwt.return (Sys.file_exists file && not (Sys.is_directory file)) - -let known_dir s k = - let file = file_of_key s k in - Lwt.return (Sys.file_exists file && Sys.is_directory file) - -let read_opt s k = - let file = file_of_key s k in - if Sys.file_exists file && not (Sys.is_directory file) then - Lwt.catch - (fun () -> - IO.with_file_in file - (fun ba -> Lwt.return (Some ba))) - (fun e -> - warn "warn: can't read %s: %s" - file (Printexc.to_string e); - Lwt.return_none) - else - Lwt.return_none - type error += Unknown of string list -let () = - Error_monad.register_error_kind - `Permanent - ~id:"store.unkown_key" - ~title:"Unknown key in store" - ~description: "" - ~pp:(fun ppf key -> - Format.fprintf ppf - "@[Unknown key %s@]" - (String.concat "/" key)) - Data_encoding.(obj1 (req "key" (list string))) - (function Unknown key -> Some key | _ -> None) - (fun key -> Unknown key) +let concat = String.concat "/" +let split = String.split_on_char '/' + +let init path = + try + return (LevelDB.open_db path) + with exn -> + Lwt.return (error_exn exn) + +let close t = LevelDB.close t + +let known t key = + Lwt.return (LevelDB.mem t (concat key)) + +let read_opt t key = + Lwt.return (map_option ~f:MBytes.of_string (LevelDB.get t (concat key))) let read t key = - read_opt t key >>= function + match LevelDB.get t (concat key) with | None -> fail (Unknown key) - | Some v -> return v + | Some k -> return (MBytes.of_string k) let read_exn t key = - read_opt t key >>= function - | None -> Lwt.fail Not_found - | Some v -> Lwt.return v + Lwt.wrap2 LevelDB.get_exn t (concat key) >|= MBytes.of_string -let remove s k = - IO.remove_file ~cleanup:true (file_of_key s k) +let store t k v = + LevelDB.put t (concat k) (MBytes.to_string v) ; + Lwt.return_unit -let store s k v = - let file = file_of_key s k in - IO.remove_file ~cleanup:false file >>= fun () -> - IO.with_file_out file v +let remove t k = + LevelDB.delete t (concat k) ; + Lwt.return_unit -let fold s k ~init ~f = - let dir = file_of_key s k in - IO.fold dir - ~init - ~f:(fun file acc -> - if IO.is_directory (Filename.concat dir file) then - f (`Dir (k @ [file])) acc - else - f (`Key (k @ [file])) acc) +let is_prefix s s' = + String.(length s <= length s' && compare s (sub s' 0 (length s)) = 0) + +let known_dir t k = + let ret = ref false in + let k = concat k in + LevelDB.iter_from begin fun kk _ -> + if is_prefix k kk then ret := true ; + false + end t k ; + Lwt.return !ret + +let remove_dir t k = + let k = concat k in + let batch = LevelDB.Batch.make () in + LevelDB.iter_from begin fun kk _ -> + if is_prefix k kk then begin + LevelDB.Batch.delete batch kk ; + true + end + else false + end t k ; + LevelDB.Batch.write t batch ; + Lwt.return_unit + +let list_equal l1 l2 len = + if len < 0 || len > List.length l1 || len > List.length l2 + then invalid_arg "list_compare: invalid len" ; + let rec inner l1 l2 len = + match len, l1, l2 with + | 0, _, _ -> true + | _, [], _ + | _, _, [] -> false + | _, h1 :: t1, h2 :: t2 -> + if h1 <> h2 then false + else inner t1 t2 (pred len) + in + inner l1 l2 len + +let is_child ~parent ~child = + let plen = List.length parent in + let clen = List.length child in + clen > plen && list_equal parent child plen + +let list_sub l pos len = + if len < 0 || pos < 0 || pos + len > List.length l then + invalid_arg "list_sub" ; + let rec inner (acc, n) = function + | [] -> List.rev acc + | h :: t -> + if n = 0 then List.rev acc + else inner (h :: acc, pred n) t in + inner ([], len) l + +let fold t k ~init ~f = + let k_concat = concat k in + let base_len = List.length k in + let i = LevelDB.Iterator.make t in + LevelDB.Iterator.seek i k_concat 0 (String.length k_concat) ; + let returned = Hashtbl.create 31 in + let rec inner acc = + match LevelDB.Iterator.valid i with + | false -> Lwt.return acc + | true -> + let kk = LevelDB.Iterator.get_key i in + let kk_split = split kk in + match is_child ~child:kk_split ~parent:k with + | false -> Lwt.return acc + | true -> + let cur_len = List.length kk_split in + LevelDB.Iterator.next i ; + if cur_len = succ base_len then begin + (f (`Key kk_split) acc) >>= inner + end + else begin + let dir = list_sub kk_split 0 (succ base_len) in + if Hashtbl.mem returned dir then + inner acc + else begin + Hashtbl.add returned dir () ; + (f (`Dir dir) acc) >>= inner + end + end ; + in + inner init let fold_keys s k ~init ~f = let rec loop k acc = @@ -101,12 +145,3 @@ let fold_keys s k ~init ~f = loop k init let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc)) - -let remove_dir s k = - let rec loop k = - fold s k ~init:() - ~f:(fun file () -> - match file with - | `Key k -> remove s k - | `Dir k -> loop k) in - loop k diff --git a/src/node/db/raw_store.mli b/src/node/db/raw_store.mli index 7767d0546..7c5ec0b09 100644 --- a/src/node/db/raw_store.mli +++ b/src/node/db/raw_store.mli @@ -12,4 +12,5 @@ open Store_sigs include STORE val init: string -> t tzresult Lwt.t +val close : t -> unit diff --git a/src/node/db/store.ml b/src/node/db/store.ml index f74b7db02..1721f706a 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -463,3 +463,4 @@ let init dir = Protocol.register s ; return s +let close = Raw_store.close diff --git a/src/node/db/store.mli b/src/node/db/store.mli index 0fefb13ba..58eb85c05 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -14,6 +14,7 @@ type global_store = t (** Open or initialize a store at a given path. *) val init: string -> t tzresult Lwt.t +val close : t -> unit (** {2 Net store} ************************************************************) diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index 0ea2ba288..9bbd77e13 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -112,6 +112,7 @@ let create { genesis ; store_root ; context_root ; Validator.activate validator mainnet_net >>= fun mainnet_validator -> let mainnet_db = Validator.net_db mainnet_validator in let shutdown () = + State.close state >>= fun () -> P2p.shutdown p2p >>= fun () -> Validator.shutdown validator >>= fun () -> Lwt.return_unit diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index ce4846faf..ce71bddcc 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -1504,3 +1504,9 @@ let read } in Net.read_all state >>=? fun () -> return state + +let close { global_data } = + Shared.use global_data begin fun { global_store } -> + Store.close global_store ; + Lwt.return_unit + end diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 8d7a2b3a6..fd57c2d18 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -30,6 +30,8 @@ val read: unit -> global_state tzresult Lwt.t +val close: + global_state -> unit Lwt.t (** {2 Errors} **************************************************************) diff --git a/src/tezos-deps.opam b/src/tezos-deps.opam index 8de320dec..c626a4045 100644 --- a/src/tezos-deps.opam +++ b/src/tezos-deps.opam @@ -38,6 +38,7 @@ depends: [ "js_of_ocaml" "sodium" {>= "0.3.0" } "magic-mime" + "leveldb" {>= "1.1.2" } "kaputt" # { test } "bisect_ppx" # { test } ]