Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

mirage-kv 2.0.0 #65

Merged
merged 4 commits into from
Apr 8, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
2 changes: 1 addition & 1 deletion lib/dune
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
44 changes: 22 additions & 22 deletions lib/tar.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 =
Expand All @@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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
2 changes: 1 addition & 1 deletion lib/tar.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion lib_test/dune
Original file line number Diff line number Diff line change
@@ -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
Expand Down
26 changes: 8 additions & 18 deletions lib_test/parse_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion mirage/dune
Original file line number Diff line number Diff line change
@@ -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))
Loading