Skip to content

Commit

Permalink
more tests are working now
Browse files Browse the repository at this point in the history
  • Loading branch information
@hannesm
hannesm committed Feb 4, 2024
1 parent 29d884e commit 281883b
Show file tree
Hide file tree
Showing 5 changed files with 194 additions and 237 deletions.
3 changes: 2 additions & 1 deletion lib_test/dune
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(tests
(names parse_test write_test allocate_set_partial_test global_extended_headers_test)
(package tar-unix)
(package tar-mirage)
(libraries
mirage-block-unix
mirage-block
Expand All @@ -9,4 +9,5 @@
alcotest-lwt
lwt
tar-unix
tar-mirage
))
163 changes: 53 additions & 110 deletions lib_test/global_extended_headers_test.ml
View file
Original file line number Diff line number Diff line change
@@ -1,37 +1,5 @@
let level = Tar.Header.Ustar

module Writer = struct
type out_channel = Stdlib.out_channel
type 'a io = 'a
let really_write oc str =
output_string oc str
end

module HW = Tar.HeaderWriter
(struct type 'a t = 'a
let ( >>= ) x f = f x
let return x = x end)
(Writer)

module Reader = struct
type in_channel = Stdlib.in_channel
type 'a io = 'a
let really_read ic buf =
really_input ic buf 0 (Bytes.length buf)
let skip ic len =
let cur = pos_in ic in
seek_in ic (cur + len)
let read ic buf =
let max = Bytes.length buf in
input ic buf 0 max
end

module HR = Tar.HeaderReader
(struct type 'a t = 'a
let ( >>= ) x f = f x
let return x = x end)
(Reader)

let make_extended user_id =
Tar.Header.Extended.make ~user_id ()

Expand All @@ -41,92 +9,67 @@ let make_file =
let name = "file" ^ string_of_int !gen in
incr gen;
let hdr = Tar.Header.make name 0L in
hdr, fun cout ->
Tar.Header.zero_padding hdr
|> output_string cout
hdr

let ( let* ) = Result.bind

(* Tests that global and per-file extended headers correctly override
each other. *)
let use_global_extended_headers _test_ctxt =
(* Write an archive using global and per-file pax extended headers *)
begin try Sys.remove "test.tar" with _ -> () end;
let cout = open_out_bin "test.tar" in
let cout = Unix.openfile "test.tar" [ Unix.O_CREAT ; Unix.O_WRONLY ] 0o644 in
let g0 = make_extended 1000 in
let hdr, f = make_file () in
match HW.write_global_extended_header g0 cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
let g1 = make_extended 3000 in
match
Fun.protect ~finally:(fun () -> Unix.close cout)
(fun () ->
let* () = Tar_unix.write_global_extended_header ~level g0 cout in
let hdr = make_file () in
let* () = Tar_unix.write_header ~level hdr cout in
let hdr = make_file () in
let hdr = { hdr with Tar.Header.extended = Some (make_extended 2000) } in
let* () = Tar_unix.write_header ~level hdr cout in
let hdr = make_file () in
let* () = Tar_unix.write_header ~level hdr cout in
let hdr = make_file () in
let* () = Tar_unix.write_global_extended_header ~level g1 cout in
let* () = Tar_unix.write_header ~level hdr cout in
Tar_unix.write_end cout)
with
| Error `Msg msg -> Alcotest.failf "failed to write something: %s" msg
| Error `Unix (err, f, a) ->
Alcotest.failf "failed to write: unix error %s %s %s" (Unix.error_message err) f a
| Ok () ->
match HW.write ~level hdr cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
| Ok () ->
f cout;
let hdr, f = make_file () in
let hdr = { hdr with Tar.Header.extended = Some (make_extended 2000) } in
match HW.write ~level hdr cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
| Ok () ->
f cout;
let hdr, f = make_file () in
match HW.write ~level hdr cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
| Ok () ->
f cout;
let g1 = make_extended 3000 in
let hdr, f = make_file () in
match HW.write_global_extended_header g1 cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
| Ok () ->
match HW.write ~level hdr cout with
| Error `Msg msg -> Alcotest.failf "failed to write header %s" msg
| Ok () ->
f cout;
Writer.really_write cout Tar.Header.zero_block;
Writer.really_write cout Tar.Header.zero_block;
close_out cout;
(* Read the same archive, testing that headers have been squashed. *)
let cin = open_in_bin "test.tar" in
let global = ref None in
let header =
let pp ppf hdr = Fmt.pf ppf "%s" (Tar.Header.Extended.to_detailed_string hdr) in
Alcotest.testable (fun ppf hdr -> Fmt.pf ppf "%a" Fmt.(option pp) hdr) ( = )
in
( match HR.read ~global:!global cin with
| Ok (hdr, global') ->
Alcotest.check header "expected global header" (Some g0) global';
global := global';
Alcotest.(check int) "expected user" 1000 hdr.Tar.Header.user_id;
let to_skip = Tar.Header.(Int64.to_int (to_sectors hdr) * length) in
Reader.skip cin to_skip;
| Error `Eof -> failwith "Couldn't read header, end of file"
| Error (`Fatal err) -> Fmt.failwith "Couldn't read header: %a" Tar.pp_error err );
( match HR.read ~global:!global cin with
| Ok (hdr, global') ->
Alcotest.check header "expected global header" (Some g0) global';
global := global';
Alcotest.(check int) "expected user" 2000 hdr.Tar.Header.user_id;
let to_skip = Tar.Header.(Int64.to_int (to_sectors hdr) * length) in
Reader.skip cin to_skip;
| Error _ -> failwith "Couldn't read header" );
( match HR.read ~global:!global cin with
| Ok (hdr, global') ->
Alcotest.check header "expected global header" (Some g0) global';
global := global';
Alcotest.(check int) "expected user" 1000 hdr.Tar.Header.user_id;
let to_skip = Tar.Header.(Int64.to_int (to_sectors hdr) * length) in
Reader.skip cin to_skip;
| Error _ -> failwith "Couldn't read header" );
( match HR.read ~global:!global cin with
| Ok (hdr, global') ->
Alcotest.check header "expected global header" (Some g1) global';
global := global';
Alcotest.(check int) "expected user" 3000 hdr.Tar.Header.user_id;
let to_skip = Tar.Header.(Int64.to_int (to_sectors hdr) * length) in
Reader.skip cin to_skip;
| Error _ -> failwith "Couldn't read header" );
( match HR.read ~global:!global cin with
| Error `Eof -> ()
| _ -> failwith "Should have found EOF");
()
(* Read the same archive, testing that headers have been squashed. *)
let header =
let pp ppf hdr = Fmt.pf ppf "%s" (Tar.Header.Extended.to_detailed_string hdr) in
Alcotest.testable (fun ppf hdr -> Fmt.pf ppf "%a" Fmt.(option pp) hdr) ( = )
in
let f _fd ?global hdr idx =
match idx with
| 0 ->
Alcotest.check header "expected global header" (Some g0) global;
Alcotest.(check int) "expected user" 1000 hdr.Tar.Header.user_id;
Ok 1
| 1 ->
Alcotest.check header "expected global header" (Some g0) global;
Alcotest.(check int) "expected user" 2000 hdr.Tar.Header.user_id;
Ok 2
| 2 ->
Alcotest.check header "expected global header" (Some g0) global;
Alcotest.(check int) "expected user" 1000 hdr.Tar.Header.user_id;
Ok 3
| 3 ->
Alcotest.check header "expected global header" (Some g1) global;
Alcotest.(check int) "expected user" 3000 hdr.Tar.Header.user_id;
Ok 4
| _ -> Alcotest.fail "too many headers"
in
match Tar_unix.fold f "test.tar" 0 with
| Ok 4 -> ()
| Ok n -> Alcotest.failf "early abort, expected 4, received %u" n
| Error e -> Alcotest.failf "failed to read: %a" Tar_unix.pp_decode_error e

let () =
let suite = "tar - pax global extended headers", [
Expand Down
34 changes: 16 additions & 18 deletions lib_test/parse_test.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -235,15 +235,14 @@ let can_list_long_pax_tar () =
- Reynir
*)
let can_list_pax_implicit_dir () =
let fd = Unix.openfile "lib_test/pax-shenanigans.tar" [ O_RDONLY; O_CLOEXEC ] 0x0 in
Fun.protect ~finally:(fun () -> Unix.close fd)
(fun () ->
match Tar_unix.HeaderReader.read ~global:None fd with
| Error `Fatal e -> Alcotest.failf "unexpected error: %a" Tar.pp_error e
| Error `Eof -> Alcotest.fail "unexpected end of file"
| Ok (hdr, _global) ->
Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.link_indicator;
Alcotest.(check string) "filename is patched" "clearly/a/directory/" hdr.file_name)
let f _fd ?global:_ hdr () =
Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator;
Alcotest.(check string) "filename is patched" "clearly/a/directory/" hdr.file_name;
Ok ()
in
match Tar_unix.fold f "lib_test/pax-shenanigans.tar" () with
| Ok () -> ()
| Error e -> Alcotest.failf "unexpected error: %a" Tar_unix.pp_decode_error e

(* Sample tar generated with commit 1583f71ea33b2836d3fb996ac7dc35d55abe2777:
[let buf =
Expand All @@ -257,15 +256,14 @@ let can_list_pax_implicit_dir () =
Tar.Header.marshal ~level (Cstruct.shift buf 1024) hdr;
buf] *)
let can_list_longlink_implicit_dir () =
let fd = Unix.openfile "lib_test/long-implicit-dir.tar" [ O_RDONLY; O_CLOEXEC ] 0x0 in
Fun.protect ~finally:(fun () -> Unix.close fd)
(fun () ->
match Tar_unix.HeaderReader.read ~global:None fd with
| Ok (hdr, _global) ->
Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.link_indicator;
Alcotest.(check string) "filename is patched" "some/long/name/for/a/directory/" hdr.file_name
| Error `Fatal e -> Alcotest.failf "unexpected error: %a" Tar.pp_error e
| Error `Eof -> Alcotest.fail "unexpected end of file")
let f _fd ?global:_ hdr () =
Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator;
Alcotest.(check string) "filename is patched" "some/long/name/for/a/directory/" hdr.file_name;
Ok ()
in
match Tar_unix.fold f "lib_test/long-implicit-dir.tar" () with
| Ok () -> ()
| Error e -> Alcotest.failf "unexpected error: %a" Tar_unix.pp_decode_error e

let starts_with ~prefix s =
let len_s = String.length s
Expand Down
Loading

0 comments on commit 281883b

Please sign in to comment.