From c979e49f3bcd678ff68706b866bd520d68f23e0b Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Wed, 21 Oct 2020 15:35:36 +0100 Subject: [PATCH 1/3] Remove unused function --- lib/os.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/lib/os.ml b/lib/os.ml index fa6c3e78..1b4e94a6 100644 --- a/lib/os.ml +++ b/lib/os.ml @@ -46,12 +46,6 @@ let sudo_result ?cwd ?stdin ?stdout ?stderr ~pp args = let args = if running_as_root then args else "sudo" :: args in exec_result ?cwd ?stdin ?stdout ?stderr ~pp args -let with_open_out path fn = - Lwt_unix.openfile path Unix.[O_RDWR; O_CREAT; O_EXCL] 0o666 >>= fun fd -> - Lwt.finalize - (fun () -> fn fd) - (fun () -> Lwt_unix.close fd) - let rec write_all fd buf ofs len = assert (len >= 0); if len = 0 then Lwt.return_unit From 90a443e6a5e2602b221f7383086f63af2b98068f Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Fri, 30 Oct 2020 09:46:31 +0000 Subject: [PATCH 2/3] Avoid warning about leading slashes Drop the `/` characters, to avoid: tar: Removing leading `/' from member names --- lib/tar_transfer.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/tar_transfer.ml b/lib/tar_transfer.ml index 6a34aa0d..f1aa1de7 100644 --- a/lib/tar_transfer.ml +++ b/lib/tar_transfer.ml @@ -106,7 +106,10 @@ let rec copy_dir ~src_dir ~src ~dst ~(items:(Manifest.t list)) ~to_untar ~user = copy_dir ~src_dir ~src ~dst ~items ~to_untar ~user ) +let remove_leading_slashes = Astring.String.drop ~sat:((=) '/') + let send_files ~src_dir ~src_manifest ~dst_dir ~user ~to_untar = + let dst_dir = remove_leading_slashes dst_dir in src_manifest |> Lwt_list.iter_s (function | `File (path, _) -> let src = src_dir / path in @@ -124,6 +127,7 @@ let send_files ~src_dir ~src_manifest ~dst_dir ~user ~to_untar = Tar_lwt_unix.write_end to_untar let send_file ~src_dir ~src_manifest ~dst ~user ~to_untar = + let dst = remove_leading_slashes dst in begin match src_manifest with | `File (path, _) -> From f8938f2cd06e6960fe96a23b34806b87882ee4aa Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Fri, 30 Oct 2020 09:49:39 +0000 Subject: [PATCH 3/3] Convert some debug prints to logs --- lib/build.ml | 2 +- lib/tar_transfer.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/build.ml b/lib/build.ml index 86eaf927..b6e98a28 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -201,7 +201,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct log `Heading (Fmt.strf "FROM %s" base); let id = Sha256.to_hex (Sha256.string base) in Store.build t.store ~id ~log (fun ~cancelled:_ ~log:_ tmp -> - Fmt.pr "Base image not present; importing %S...@." base; + Log.info (fun f -> f "Base image not present; importing %S...@." base); let rootfs = tmp / "rootfs" in Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () -> (* Lwt_process.exec ("", [| "docker"; "pull"; "--"; base |]) >>= fun _ -> *) diff --git a/lib/tar_transfer.ml b/lib/tar_transfer.ml index f1aa1de7..8987b243 100644 --- a/lib/tar_transfer.ml +++ b/lib/tar_transfer.ml @@ -80,7 +80,7 @@ let copy_symlink ~src ~target ~dst ~to_untar ~user = Tar_lwt_unix.write_block hdr (fun _ -> Lwt.return_unit) to_untar let rec copy_dir ~src_dir ~src ~dst ~(items:(Manifest.t list)) ~to_untar ~user = - Fmt.pr "Copy dir %S -> %S@." src dst; + Log.debug(fun f -> f "Copy dir %S -> %S@." src dst); Lwt_unix.LargeFile.lstat (src_dir / src) >>= fun stat -> begin let hdr = Tar.Header.make