From ad7c4750e2c56e02708552654b8d89be27cb721c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sat, 2 Mar 2019 12:09:47 +0100 Subject: [PATCH 1/4] don't depend on mirage-types, use mirage-kv instead --- lib_test/dune | 2 +- lib_test/parse_test.ml | 13 +++++-------- mirage/dune | 2 +- mirage/tar_mirage.mli | 2 +- tar-mirage.opam | 5 +---- 5 files changed, 9 insertions(+), 15 deletions(-) diff --git a/lib_test/dune b/lib_test/dune index 02a4ddf..b02f7bd 100644 --- a/lib_test/dune +++ b/lib_test/dune @@ -1,7 +1,7 @@ (executables (names parse_test) (flags :standard -safe-string) - (libraries mirage-block-unix mirage-types-lwt oUnit lwt io-page-unix + (libraries mirage-block-unix mirage-block-lwt oUnit lwt io-page-unix tar-unix tar-mirage)) (alias diff --git a/lib_test/parse_test.ml b/lib_test/parse_test.ml index 38e9034..1d8ccf8 100644 --- a/lib_test/parse_test.ml +++ b/lib_test/parse_test.ml @@ -145,10 +145,6 @@ let can_list_longlink_tar () = ) (fun () -> Unix.close fd); ) -let expect_ok = function - | Ok x -> x - | Error _ -> failwith "expect_ok: got Error" - module Block4096 = struct include Block @@ -180,7 +176,7 @@ module Block4096 = struct end module type BLOCK = sig - include Mirage_types_lwt.BLOCK + include Mirage_block_lwt.S val connect: string -> t Lwt.t end @@ -200,9 +196,10 @@ module Test(B: BLOCK) = struct KV_RO.connect b >>= fun k -> Lwt_list.iter_s (fun file -> - KV_RO.size k file - >>= fun r -> - let size = expect_ok r in + KV_RO.size k file >>= function + | Error e -> + failwith ("KV_RO: expected ok, got Error " ^ (Fmt.to_to_string KV_RO.pp_error e)) + | Ok size -> let stats = Unix.LargeFile.stat file in assert_equal ~printer:Int64.to_string stats.Unix.LargeFile.st_size size; let read_file key ofs len = diff --git a/mirage/dune b/mirage/dune index 6eef599..d2e5364 100644 --- a/mirage/dune +++ b/mirage/dune @@ -1,6 +1,6 @@ (library (name tar_mirage) (public_name tar-mirage) - (libraries tar io-page lwt mirage-types-lwt mirage-block mirage-block-lwt) + (libraries tar io-page lwt mirage-kv-lwt mirage-block mirage-block-lwt) (flags :standard -safe-string) (wrapped false)) diff --git a/mirage/tar_mirage.mli b/mirage/tar_mirage.mli index 3497491..806e7c8 100644 --- a/mirage/tar_mirage.mli +++ b/mirage/tar_mirage.mli @@ -20,7 +20,7 @@ module Make_KV_RO (BLOCK : Mirage_block_lwt.S) : sig (** Construct a read-only key-value store from an existing block device containing tar-format data. *) - include Mirage_types_lwt.KV_RO + include Mirage_kv_lwt.RO val connect: BLOCK.t -> t Lwt.t end diff --git a/tar-mirage.opam b/tar-mirage.opam index e0ab891..fccc8a7 100644 --- a/tar-mirage.opam +++ b/tar-mirage.opam @@ -13,7 +13,7 @@ depends: [ "re" {>="1.7.2"} "result" "mirage-block-unix" {with-test & >= "2.5.0"} - "mirage-types-lwt" {>= "3.0.0"} + "mirage-kv-lwt" {>= "2.0.0"} "lwt" "io-page" "mirage-block-unix" {with-test} @@ -21,9 +21,6 @@ depends: [ "ounit" {with-test} "tar-unix" {with-test} ] -conflicts: [ - "mirage-types-lwt" {< "3.0.0"} -] build: [ ["dune" "subst"] {pinned} ["dune" "build" "-p" name "-j" jobs] From aee659ca500d88b7d5ea86eaf595d61869de7f1c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sat, 2 Mar 2019 16:39:58 +0100 Subject: [PATCH 2/4] mirage-kv 2.0.0 --- lib_test/parse_test.ml | 21 ++--- mirage/dune | 2 +- mirage/tar_mirage.ml | 192 ++++++++++++++++++++++++++++------------- tar-mirage.opam | 2 + 4 files changed, 142 insertions(+), 75 deletions(-) diff --git a/lib_test/parse_test.ml b/lib_test/parse_test.ml index 1d8ccf8..f2ede59 100644 --- a/lib_test/parse_test.ml +++ b/lib_test/parse_test.ml @@ -196,12 +196,7 @@ module Test(B: BLOCK) = struct KV_RO.connect b >>= fun k -> Lwt_list.iter_s (fun file -> - KV_RO.size k file >>= function - | Error e -> - failwith ("KV_RO: expected ok, got Error " ^ (Fmt.to_to_string KV_RO.pp_error e)) - | Ok size -> let stats = Unix.LargeFile.stat file in - assert_equal ~printer:Int64.to_string stats.Unix.LargeFile.st_size size; let read_file key ofs len = let fd = Unix.openfile key [ Unix.O_RDONLY ] 0 in finally @@ -212,22 +207,20 @@ module Test(B: BLOCK) = struct assert_equal ~printer:string_of_int len len'; Bytes.to_string buf ) (fun () -> Unix.close fd) in - let read_tar key ofs len = - KV_RO.read k key ofs len - >>= function + let read_tar key = + KV_RO.get k key >>= function | Error _ -> failwith "KV_RO.read" - | Ok bufs -> return (String.concat "" (List.map Cstruct.to_string bufs)) in + | Ok buf -> return buf in (* Read whole file *) let size = stats.Unix.LargeFile.st_size in let value = read_file file 0 (Int64.to_int size) in - read_tar file 0L size - >>= fun value' -> + read_tar (Mirage_kv.Key.v file) >>= fun value' -> assert_equal ~printer:(fun x -> x) value value'; if Int64.compare size 2L = 1 then begin let value = read_file file 1 ((Int64.to_int size) - 2) in - read_tar file 1L (Int64.sub size 2L) - >>= fun value' -> - assert_equal ~printer:(fun x -> x) value value'; + read_tar (Mirage_kv.Key.v file) >>= fun value' -> + let value'' = String.sub value' 1 ((Int64.to_int size) - 2) in + assert_equal ~printer:(fun x -> x) value value''; return () end else return () ) files in diff --git a/mirage/dune b/mirage/dune index d2e5364..1ba1a3d 100644 --- a/mirage/dune +++ b/mirage/dune @@ -1,6 +1,6 @@ (library (name tar_mirage) (public_name tar-mirage) - (libraries tar io-page lwt mirage-kv-lwt mirage-block mirage-block-lwt) + (libraries tar io-page lwt mirage-kv mirage-kv-lwt mirage-block mirage-block-lwt ptime) (flags :standard -safe-string) (wrapped false)) diff --git a/mirage/tar_mirage.ml b/mirage/tar_mirage.ml index 2481d9a..7e12875 100644 --- a/mirage/tar_mirage.ml +++ b/mirage/tar_mirage.ml @@ -22,31 +22,47 @@ module StringMap = Map.Make(String) module Make_KV_RO (BLOCK : Mirage_block_lwt.S) = struct + type entry = + | Value of Tar.Header.t * int64 + | Dict of Tar.Header.t * entry StringMap.t + type t = { b: BLOCK.t; - map: (Tar.Header.t * int64) StringMap.t; + map: entry; info: Mirage_block.info; } - type error = Mirage_kv.error - type 'a io = 'a Lwt.t - type page_aligned_buffer = Cstruct.t + type key = Mirage_kv.Key.t - let pp_error = Mirage_kv.pp_error + type value = string - (* Compare filenames without a leading / or ./ *) - let trim_slash x = - let startswith prefix x = - let prefix' = String.length prefix in - let x' = String.length x in - x' >= prefix' && (String.sub x 0 prefix' = prefix) in - if startswith "./" x - then String.sub x 2 (String.length x - 2) - else if startswith "/" x - then String.sub x 1 (String.length x - 1) - else x + type error = [ Mirage_kv.error | `Block of BLOCK.error ] + + let pp_error ppf = function + | #Mirage_kv.error as e -> Mirage_kv.pp_error ppf e + | `Block b -> BLOCK.pp_error ppf b + + let get_node t key = + let rec find e = function + | [] -> Ok e + | hd::tl -> match e with + | Value _ -> Error (`Dictionary_expected key) + | Dict (_, m) -> match StringMap.find_opt hd m with + | Some e -> find e tl + | None -> Error (`Not_found key) + in + find t (Mirage_kv.Key.segments key) + + let exists t key = + let r = match get_node t.map key with + | Ok (Value _) -> Ok (Some `Value) + | Ok (Dict _) -> Ok (Some `Dictionary) + | Error (`Not_found _) -> Ok None + | Error e -> Error e + in + Lwt.return r module Reader = struct type in_channel = { @@ -82,41 +98,18 @@ module Make_KV_RO (BLOCK : Mirage_block_lwt.S) = struct end module HR = Tar.HeaderReader(Lwt)(Reader) - let connect b = - BLOCK.get_info b >>= fun info -> - let in_channel = { Reader.b; offset = 0L; info } in - let rec loop map = - HR.read in_channel >>= function - | Result.Error `Eof -> Lwt.return map - | Result.Ok tar -> - let filename = trim_slash tar.Tar.Header.file_name in - let data_tar_offset = Int64.div in_channel.Reader.offset 512L in - let map = StringMap.add filename (tar, data_tar_offset) map in - Reader.skip in_channel (Int64.to_int tar.Tar.Header.file_size) >>= fun () -> - Reader.skip in_channel (Tar.Header.compute_zero_padding_length tar) >>= fun () -> - loop map in - loop StringMap.empty >>= fun map -> - Lwt.return ({ b; map; info }) - - let disconnect _ = Lwt.return () - - let mem t key = - Lwt.return (Ok (StringMap.mem key t.map)) - - let read t key (offset:int64) (length:int64) = - let key = trim_slash key in - if not(StringMap.mem key t.map) - then Lwt.return (Error (`Unknown_key key)) - else begin - let hdr, start_sector = StringMap.find key t.map in - + let get t key = + match get_node t.map key with + | Error e -> Lwt.return (Error e) + | Ok (Dict _) -> Lwt.return (Error (`Value_expected key)) + | Ok (Value (hdr, start_sector)) -> BLOCK.get_info t.b >>= fun info -> let open Int64 in let sector_size = of_int info.Mirage_block.sector_size in (* Compute the unaligned data we need to read *) - let start_bytes = add (mul start_sector 512L) offset in - let length_bytes = min length (sub hdr.Tar.Header.file_size offset) in + let start_bytes = mul start_sector 512L in + let length_bytes = hdr.Tar.Header.file_size in let end_bytes = add start_bytes length_bytes in (* Compute the starting sector and ending sector (rounding down then up) *) let start_sector, start_padding = div start_bytes sector_size, rem start_bytes sector_size in @@ -129,18 +122,97 @@ module Make_KV_RO (BLOCK : Mirage_block_lwt.S) = struct (* Don't try to read beyond the end of the archive *) let total_size_bytes = Int64.(mul t.info.Mirage_block.size_sectors sector_size) in let tmp = Cstruct.sub block 0 (min (Cstruct.len block) Int64.(to_int @@ (sub total_size_bytes (mul start_sector 512L)))) in - BLOCK.read t.b start_sector [ tmp ] - >>= function - | Error _ -> Lwt.fail (Failure (Printf.sprintf "Failed to read %s" key)) - | Ok () -> Lwt.return (Ok [ Cstruct.sub block (to_int start_padding) (to_int length_bytes) ]) - end - - let size t key = - let key = trim_slash key in - if not(StringMap.mem key t.map) - then Lwt.return (Error (`Unknown_key key)) - else begin - let hdr, _start_sector = StringMap.find key t.map in - Lwt.return (Ok hdr.Tar.Header.file_size) - end + BLOCK.read t.b start_sector [ tmp ] >|= function + | Error b -> Error (`Block b) + | Ok () -> + let buf = Cstruct.sub block (to_int start_padding) (to_int length_bytes) in + Ok (Cstruct.to_string buf) + + let list t key = + let r = match get_node t.map key with + | Ok (Dict (_, m)) -> + Ok (StringMap.fold (fun key value acc -> + match value with + | Dict _ -> (key, `Dictionary) :: acc + | Value _ -> (key, `Value) :: acc) + m []) + | Ok (Value _) -> Error (`Dictionary_expected key) + | Error e -> Error e + in + Lwt.return r + + let to_day_ps hdr = + let ts = + match Ptime.Span.of_float_s (Int64.to_float hdr.Tar.Header.mod_time) with + | None -> Ptime.epoch + | Some span -> match Ptime.add_span Ptime.epoch span with + | None -> Ptime.epoch + | Some ts -> ts + in + Ptime.(Span.to_d_ps (to_span ts)) + + let last_modified t key = + let r = match get_node t.map key with + | Ok (Dict (hdr, _)) -> Ok (to_day_ps hdr) + | Ok (Value (hdr, _)) -> Ok (to_day_ps hdr) + | Error e -> Error e + in + Lwt.return r + + let digest t key = + get t key >|= function + | Error e -> Error e + | Ok data -> Ok (Digest.string data) + + (* Compare filenames without a leading / or ./ *) + let trim_slash x = + let startswith prefix x = + let prefix' = String.length prefix in + let x' = String.length x in + x' >= prefix' && (String.sub x 0 prefix' = prefix) in + if startswith "./" x + then String.sub x 2 (String.length x - 2) + else if startswith "/" x + then String.sub x 1 (String.length x - 1) + else x + + let is_dict filename = + String.get filename (pred (String.length filename)) = '/' + + let insert map key value = + let rec go m = function + | [] -> assert false + | [hd] -> StringMap.add hd value m + | hd::tl -> + let hdr, m' = match StringMap.find_opt hd m with + | None -> Tar.Header.make hd 0L, StringMap.empty + | Some (Value _) -> assert false + | Some (Dict (hdr, m)) -> hdr, m + in + let m'' = go m' tl in + StringMap.add hd (Dict (hdr, m'')) m + in + go map (Mirage_kv.Key.segments key) + + let connect b = + BLOCK.get_info b >>= fun info -> + let in_channel = { Reader.b; offset = 0L; info } in + let rec loop map = + HR.read in_channel >>= function + | Result.Error `Eof -> Lwt.return map + | Result.Ok tar -> + let filename = trim_slash tar.Tar.Header.file_name in + let data_tar_offset = Int64.div in_channel.Reader.offset 512L in + let v_or_d = if is_dict filename then Dict (tar, StringMap.empty) else Value (tar, data_tar_offset) in + let map = insert map (Mirage_kv.Key.v filename) v_or_d in + Reader.skip in_channel (Int64.to_int tar.Tar.Header.file_size) >>= fun () -> + Reader.skip in_channel (Tar.Header.compute_zero_padding_length tar) >>= fun () -> + loop map in + let root = StringMap.empty in + loop root >>= fun map -> + let map = Dict (Tar.Header.make "/" 0L, map) in + Lwt.return ({ b; map; info }) + + let disconnect _ = Lwt.return () + end diff --git a/tar-mirage.opam b/tar-mirage.opam index fccc8a7..71edf6f 100644 --- a/tar-mirage.opam +++ b/tar-mirage.opam @@ -13,9 +13,11 @@ depends: [ "re" {>="1.7.2"} "result" "mirage-block-unix" {with-test & >= "2.5.0"} + "mirage-kv" {>= "2.0.0"} "mirage-kv-lwt" {>= "2.0.0"} "lwt" "io-page" + "ptime" "mirage-block-unix" {with-test} "io-page-unix" {with-test} "ounit" {with-test} From d373f75f7fe1dda21700bd3f97ec8d2af1bdd925 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sat, 2 Mar 2019 16:56:16 +0100 Subject: [PATCH 3/4] remove result (tar requires ocaml 4.03.0 anyways), require 4.05.0 for tar-mirage --- .travis.yml | 2 +- lib/dune | 2 +- lib/tar.ml | 44 ++++++++++++++++++++++---------------------- lib/tar.mli | 2 +- mirage/tar_mirage.ml | 4 ++-- tar-mirage.opam | 3 +-- tar-unix.opam | 1 - tar.opam | 1 - unix/tar_lwt_unix.ml | 4 ++-- 9 files changed, 30 insertions(+), 33 deletions(-) diff --git a/.travis.yml b/.travis.yml index f5c2966..eac2372 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,7 +10,7 @@ env: - PINS="tar:. tar-unix:. tar-mirage:." matrix: - DISTRO="alpine" OCAML_VERSION="4.03" PACKAGE="tar-unix" - - DISTRO="alpine" OCAML_VERSION="4.04" PACKAGE="tar-mirage" + - DISTRO="alpine" OCAML_VERSION="4.04" PACKAGE="tar-unix" - DISTRO="alpine" OCAML_VERSION="4.05" PACKAGE="tar-mirage" - DISTRO="alpine" OCAML_VERSION="4.06" PACKAGE="tar-unix" - DISTRO="alpine" OCAML_VERSION="4.07" PACKAGE="tar-mirage" diff --git a/lib/dune b/lib/dune index 8377c7b..2aa4c30 100644 --- a/lib/dune +++ b/lib/dune @@ -2,6 +2,6 @@ (name tar) (public_name tar) (wrapped false) - (libraries result cstruct re.str) + (libraries cstruct re.str) (flags :standard -safe-string) (preprocess (pps ppx_cstruct))) diff --git a/lib/tar.ml b/lib/tar.ml index 4344693..f52279b 100644 --- a/lib/tar.ml +++ b/lib/tar.ml @@ -556,7 +556,7 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) = open Reader - let read ?level (ifd: Reader.in_channel) : (Header.t, [ `Eof ]) Result.result t = + let read ?level (ifd: Reader.in_channel) : (Header.t, [ `Eof ]) result t = let level = Header.get_level level in (* We might need to read 2 headers at once if we encounter a Pax header *) let buffer = Cstruct.create Header.length in @@ -589,8 +589,8 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) = begin match Header.unmarshal ~level ~extended real_header_buf with | None -> (* Corrupt pax headers *) - return (Result.Error `Eof) - | Some x -> return (Result.Ok x) + return (Error `Eof) + | Some x -> return (Ok x) end | Some x when x.Header.link_indicator = Header.Link.LongLink && x.Header.file_name = longlink -> let extra_header_buf = Cstruct.create (Int64.to_int x.Header.file_size) in @@ -601,19 +601,19 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) = let file_name = Cstruct.(to_string @@ sub extra_header_buf 0 (len extra_header_buf - 1)) in begin next () >>= function - | None -> return (Result.Error `Eof) - | Some x -> return (Result.Ok { x with file_name }) + | None -> return (Error `Eof) + | Some x -> return (Ok { x with file_name }) end - | Some x -> return (Result.Ok x) + | Some x -> return (Ok x) | None -> begin next () >>= function - | Some x -> return (Result.Ok x) - | None -> return (Result.Error `Eof) + | Some x -> return (Ok x) + | None -> return (Error `Eof) end in - let rec read_header (file_name, link_name, hdr) : (Header.t, [`Eof]) Result.result Async.t = + let rec read_header (file_name, link_name, hdr) : (Header.t, [`Eof]) result Async.t = let raw_link_indicator = Header.get_hdr_link_indicator buffer in if (raw_link_indicator = 75 || raw_link_indicator = 76) && level = Header.GNU then let data = Cstruct.create (Int64.to_int hdr.Header.file_size) in @@ -625,20 +625,20 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) = let data = Header.unmarshal_string (Cstruct.to_string data) in get_hdr () >>= function - | Result.Error `Eof -> return (Result.Error `Eof) - | Result.Ok hdr -> + | Error `Eof -> return (Error `Eof) + | Ok hdr -> if raw_link_indicator = 75 then read_header (file_name, data, hdr) else read_header (data, link_name, hdr) else begin let link_name = if link_name = "" then hdr.Header.link_name else link_name in let file_name = if file_name = "" then hdr.Header.file_name else file_name in - return (Result.Ok {hdr with Header.link_name; file_name }) + return (Ok {hdr with Header.link_name; file_name }) end in get_hdr () >>= function - | Result.Error `Eof -> return (Result.Error `Eof) - | Result.Ok hdr -> + | Error `Eof -> return (Error `Eof) + | Ok hdr -> read_header ("", "", hdr) end @@ -775,11 +775,11 @@ module Make (IO : IO) = struct skips past the zero padding to the next header *) let with_next_file (fd: IO.in_channel) (f: IO.in_channel -> Header.t -> 'a) = match HR.read fd with - | Result.Ok hdr -> + | Ok hdr -> (* NB if the function 'f' fails we're boned *) finally (fun () -> f fd hdr) (fun () -> Reader.skip fd (Header.compute_zero_padding_length hdr)) - | Result.Error `Eof -> raise Header.End_of_stream + | Error `Eof -> raise Header.End_of_stream (** List the contents of a tar *) let list ?level fd = @@ -788,11 +788,11 @@ module Make (IO : IO) = struct try while true do match HR.read ~level fd with - | Result.Ok hdr -> + | Ok hdr -> list := hdr :: !list; Reader.skip fd (Int64.to_int hdr.Header.file_size); Reader.skip fd (Header.compute_zero_padding_length hdr) - | Result.Error `Eof -> raise Header.End_of_stream + | Error `Eof -> raise Header.End_of_stream done; List.rev !list; with @@ -821,14 +821,14 @@ module Make (IO : IO) = struct try while true do match HR.read ifd with - | Result.Ok hdr -> + | Ok hdr -> let size = hdr.Header.file_size in let padding = Header.compute_zero_padding_length hdr in let ofd = dest hdr in copy_n ifd ofd size; IO.close_out ofd; Reader.skip ifd padding - | Result.Error `Eof -> raise Header.End_of_stream + | Error `Eof -> raise Header.End_of_stream done with | End_of_file -> failwith "Unexpected end of file while reading stream" @@ -850,8 +850,8 @@ module Make (IO : IO) = struct include Header let get_next_header ?level ic = match HR.read ?level ic with - | Result.Ok hdr -> hdr - | Result.Error `Eof -> raise Header.End_of_stream + | Ok hdr -> hdr + | Error `Eof -> raise Header.End_of_stream end end diff --git a/lib/tar.mli b/lib/tar.mli index 2a80cd1..5f8566c 100644 --- a/lib/tar.mli +++ b/lib/tar.mli @@ -150,7 +150,7 @@ module HeaderReader(Async: ASYNC)(Reader: READER with type 'a t = 'a Async.t) : zero-filled blocks are discovered. Assumes stream is positioned at the possible start of a header block. End_of_file is thrown if the stream unexpectedly fails *) - val read : ?level:Header.compatibility -> Reader.in_channel -> (Header.t, [`Eof]) Result.result Async.t + val read : ?level:Header.compatibility -> Reader.in_channel -> (Header.t, [`Eof]) result Async.t end module HeaderWriter(Async: ASYNC)(Writer: WRITER with type 'a t = 'a Async.t) : sig diff --git a/mirage/tar_mirage.ml b/mirage/tar_mirage.ml index 7e12875..3fe1c9e 100644 --- a/mirage/tar_mirage.ml +++ b/mirage/tar_mirage.ml @@ -199,8 +199,8 @@ module Make_KV_RO (BLOCK : Mirage_block_lwt.S) = struct let in_channel = { Reader.b; offset = 0L; info } in let rec loop map = HR.read in_channel >>= function - | Result.Error `Eof -> Lwt.return map - | Result.Ok tar -> + | Error `Eof -> Lwt.return map + | Ok tar -> let filename = trim_slash tar.Tar.Header.file_name in let data_tar_offset = Int64.div in_channel.Reader.offset 512L in let v_or_d = if is_dict filename then Dict (tar, StringMap.empty) else Value (tar, data_tar_offset) in diff --git a/tar-mirage.opam b/tar-mirage.opam index 71edf6f..1a71dac 100644 --- a/tar-mirage.opam +++ b/tar-mirage.opam @@ -6,12 +6,11 @@ homepage: "https://github.com/mirage/ocaml-tar" doc: "https://mirage.github.io/ocaml-tar/" bug-reports: "https://github.com/mirage/ocaml-tar/issues" depends: [ - "ocaml" {>= "4.04.2"} + "ocaml" {>= "4.05.0"} "dune" {build & >= "1.0"} "tar" "cstruct" {>= "1.9.0"} "re" {>="1.7.2"} - "result" "mirage-block-unix" {with-test & >= "2.5.0"} "mirage-kv" {>= "2.0.0"} "mirage-kv-lwt" {>= "2.0.0"} diff --git a/tar-unix.opam b/tar-unix.opam index 2dd351c..18d24c2 100644 --- a/tar-unix.opam +++ b/tar-unix.opam @@ -12,7 +12,6 @@ depends: [ "cstruct" {>= "1.9.0"} "cstruct-lwt" "re" - "result" "lwt" ] build: [ diff --git a/tar.opam b/tar.opam index 6691296..ca2de99 100644 --- a/tar.opam +++ b/tar.opam @@ -12,7 +12,6 @@ depends: [ "ppx_cstruct" {>= "3.1.0"} "cstruct" {>= "1.9.0"} "re" - "result" ] build: [ ["dune" "subst"] {pinned} diff --git a/unix/tar_lwt_unix.ml b/unix/tar_lwt_unix.ml index 5e9f9ba..d3056ff 100644 --- a/unix/tar_lwt_unix.ml +++ b/unix/tar_lwt_unix.ml @@ -63,8 +63,8 @@ module Header = struct let get_next_header ?level ic = HR.read ?level ic >>= function - | Result.Error `Eof -> return None - | Result.Ok hdr -> return (Some hdr) + | Error `Eof -> return None + | Ok hdr -> return (Some hdr) (** Return the header needed for a particular file on disk *) let of_file ?level (file: string) : t Lwt.t = From 6cd163f2d5e2b32d7b30aac71415ad3e2fcf90ac Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sat, 2 Mar 2019 16:57:10 +0100 Subject: [PATCH 4/4] update opam with mirage-block dependency --- tar-mirage.opam | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tar-mirage.opam b/tar-mirage.opam index 1a71dac..84e080f 100644 --- a/tar-mirage.opam +++ b/tar-mirage.opam @@ -11,13 +11,14 @@ depends: [ "tar" "cstruct" {>= "1.9.0"} "re" {>="1.7.2"} - "mirage-block-unix" {with-test & >= "2.5.0"} + "mirage-block" + "mirage-block-lwt" "mirage-kv" {>= "2.0.0"} "mirage-kv-lwt" {>= "2.0.0"} "lwt" "io-page" "ptime" - "mirage-block-unix" {with-test} + "mirage-block-unix" {with-test & >= "2.5.0"} "io-page-unix" {with-test} "ounit" {with-test} "tar-unix" {with-test}