Some minor changes from the Docker branch

.gitignore

@@ -1,2 +1,3 @@
 .merlin
 _build
+_opam

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

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

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

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)

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

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)

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]. *)

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

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)

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