Merge pull request #65 from hannesm/minor

mirage-kv 2.0.0

.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"

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)))

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

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

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

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,11 +196,7 @@ 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
                 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
@@ -215,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

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 mirage-kv-lwt mirage-block mirage-block-lwt ptime)
  (flags :standard -safe-string)
  (wrapped false))