From 7c3d62a71d66e33aa49d17f027d637d725d1bac4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Fri, 21 May 2021 16:56:46 +0200 Subject: [PATCH 1/3] Remove trailing whitespace --- lib/build.ml | 2 +- lib/dao.ml | 10 +++++----- lib/docker.ml | 4 ++-- lib/manifest.ml | 4 ++-- lib/runc_sandbox.ml | 8 ++++---- lib/runc_sandbox.mli | 6 +++--- lib/s.ml | 10 +++++----- lib/tar_transfer.ml | 2 +- main.ml | 2 +- 9 files changed, 24 insertions(+), 24 deletions(-) diff --git a/lib/build.ml b/lib/build.ml index 470701ed..fa46211e 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -228,7 +228,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st Log.info (fun f -> f "Base image not present; importing %S..." base); let rootfs = tmp / "rootfs" in Os.sudo ["mkdir"; "--mode=755"; "--"; rootfs] >>= fun () -> - Fetch.fetch ~log ~rootfs base >>= fun env -> + Fetch.fetch ~log ~rootfs base >>= fun env -> Os.write_file ~path:(tmp / "env") (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> Lwt_result.return () diff --git a/lib/dao.ml b/lib/dao.ml index 3df1cf6a..a3c0858d 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -18,13 +18,13 @@ let format_timestamp time = Fmt.strf "%04d-%02d-%02d %02d:%02d:%02d" (tm_year + 1900) (tm_mon + 1) tm_mday tm_hour tm_min tm_sec let create db = - Sqlite3.exec db {| CREATE TABLE IF NOT EXISTS builds ( - id TEXT PRIMARY KEY, - created DATETIME NOT NULL, - used DATETIME NOT NULL, + Sqlite3.exec db {| CREATE TABLE IF NOT EXISTS builds ( + id TEXT PRIMARY KEY, + created DATETIME NOT NULL, + used DATETIME NOT NULL, rc INTEGER NOT NULL, parent TEXT, - FOREIGN KEY (parent) REFERENCES builds (id) ON DELETE RESTRICT + FOREIGN KEY (parent) REFERENCES builds (id) ON DELETE RESTRICT ) |} |> Db.or_fail ~cmd:"create builds"; Sqlite3.exec db {| CREATE INDEX IF NOT EXISTS lru ON builds (rc, used) |} |> Db.or_fail ~cmd:"create lru index"; diff --git a/lib/docker.ml b/lib/docker.ml index 32dd889e..c52f1fd2 100644 --- a/lib/docker.ml +++ b/lib/docker.ml @@ -26,12 +26,12 @@ let with_container ~log base fn = (fun () -> Os.exec ~stdout:`Dev_null ["docker"; "rm"; "--"; cid]) -let fetch ~log ~rootfs base = +let fetch ~log ~rootfs base = with_container ~log base (fun cid -> Os.with_pipe_between_children @@ fun ~r ~w -> let exporter = Os.exec ~stdout:(`FD_move_safely w) ["docker"; "export"; "--"; cid] in let tar = Os.sudo ~stdin:(`FD_move_safely r) ["tar"; "-C"; rootfs; "-xf"; "-"] in exporter >>= fun () -> tar - ) >>= fun () -> + ) >>= fun () -> export_env base diff --git a/lib/manifest.ml b/lib/manifest.ml index 556c3264..b69f389a 100644 --- a/lib/manifest.ml +++ b/lib/manifest.ml @@ -64,8 +64,8 @@ let generate ~exclude ~src_dir src = | Ok src' -> try List.rev src' - |> String.concat Filename.dir_sep - |> generate ~exclude ~src_dir + |> String.concat Filename.dir_sep + |> generate ~exclude ~src_dir |> Result.ok with Failure m -> Error (`Msg m) diff --git a/lib/runc_sandbox.ml b/lib/runc_sandbox.ml index 231b0e8f..819a6569 100644 --- a/lib/runc_sandbox.ml +++ b/lib/runc_sandbox.ml @@ -329,10 +329,10 @@ let create ~state_dir (c : config) = Os.ensure_dir state_dir; let arches = get_arches () in Log.info (fun f -> f "Architectures for multi-arch system: %a" Fmt.(Dump.list string) arches); - clean_runc state_dir >|= fun () -> + clean_runc state_dir >|= fun () -> { runc_state_dir = state_dir; fast_sync = c.fast_sync; arches } -open Cmdliner +open Cmdliner let fast_sync = Arg.value @@ @@ -341,8 +341,8 @@ let fast_sync = ~doc:"Ignore sync syscalls (requires runc >= 1.0.0-rc92)" ["fast-sync"] -let cmdliner : config Term.t = - let make fast_sync = +let cmdliner : config Term.t = + let make fast_sync = { fast_sync } in Term.(const make $ fast_sync) diff --git a/lib/runc_sandbox.mli b/lib/runc_sandbox.mli index 50da9eb7..b8b53f26 100644 --- a/lib/runc_sandbox.mli +++ b/lib/runc_sandbox.mli @@ -5,10 +5,10 @@ include S.SANDBOX type config [@@deriving sexp] (** The type of sandbox configurations *) -val cmdliner : config Cmdliner.Term.t -(** [cmdliner] is used for command-line interfaces to generate the necessary flags +val cmdliner : config Cmdliner.Term.t +(** [cmdliner] is used for command-line interfaces to generate the necessary flags and parameters to setup a specific sandbox's configuration. *) -val create : state_dir:string -> config -> t Lwt.t +val create : state_dir:string -> config -> t Lwt.t (** [create ~state_dir config] is a runc sandboxing system that keeps state in [state_dir] and is configured using [config]. *) diff --git a/lib/s.ml b/lib/s.ml index 95c1f140..1cafba89 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -109,11 +109,11 @@ module type BUILDER = sig This excludes the time to fetch the base image. *) end -module type FETCHER = sig +module type FETCHER = sig val fetch : log:Build_log.t -> rootfs:string -> string -> Config.env Lwt.t (** [fetch ~log ~rootfs base] initialises the [rootfs] directory by - fetching and extracting the [base] image. - Returns the image's environment. - @param log Used for outputting the progress of the fetch + fetching and extracting the [base] image. + Returns the image's environment. + @param log Used for outputting the progress of the fetch @param rootfs The directory in which to extract the base image *) -end +end diff --git a/lib/tar_transfer.ml b/lib/tar_transfer.ml index 8987b243..2d4fcd56 100644 --- a/lib/tar_transfer.ml +++ b/lib/tar_transfer.ml @@ -82,7 +82,7 @@ let copy_symlink ~src ~target ~dst ~to_untar ~user = let rec copy_dir ~src_dir ~src ~dst ~(items:(Manifest.t list)) ~to_untar ~user = Log.debug(fun f -> f "Copy dir %S -> %S@." src dst); Lwt_unix.LargeFile.lstat (src_dir / src) >>= fun stat -> - begin + begin let hdr = Tar.Header.make ~file_mode:0o755 ~mod_time:(Int64.of_float stat.Lwt_unix.LargeFile.st_mtime) diff --git a/main.ml b/main.ml index 71f5aad3..c49fbfe8 100644 --- a/main.ml +++ b/main.ml @@ -14,7 +14,7 @@ let log tag msg = | `Output -> output_string stdout msg; flush stdout let create_builder spec conf = - Obuilder.Store_spec.to_store spec >>= fun (Store ((module Store), store)) -> + Obuilder.Store_spec.to_store spec >>= fun (Store ((module Store), store)) -> let module Builder = Obuilder.Builder(Store)(Sandbox)(Fetcher) in Sandbox.create ~state_dir:(Store.state_dir store / "sandbox") conf >|= fun sandbox -> let builder = Builder.v ~store ~sandbox in From f6e665eac380d86481191edaaf5ad3e9660003ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 13 Apr 2021 17:21:41 +0200 Subject: [PATCH 2/3] Use `running_as_root` only on Unix --- lib/os.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/os.ml b/lib/os.ml index 3e4cc9c8..4c68eb13 100644 --- a/lib/os.ml +++ b/lib/os.ml @@ -71,7 +71,7 @@ let exec ?cwd ?stdin ?stdout ?stderr argv = | Ok n -> Lwt.fail_with (Fmt.strf "%t failed with exit status %d" pp n) | Error (`Msg m) -> Lwt.fail (Failure m) -let running_as_root = Unix.getuid () = 0 +let running_as_root = not (Sys.unix) || Unix.getuid () = 0 let sudo ?stdin args = let args = if running_as_root then args else "sudo" :: args in From 25b9465dc1c6f067f11ab7a0d596fbe97b308e91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 21 Jun 2021 10:49:50 +0200 Subject: [PATCH 3/3] Ignore local _opam switch --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 6ce8d7ed..347b5db0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ .merlin _build +_opam