Windows prereqs tests

.github/workflows/main.yml

@@ -70,6 +70,10 @@ jobs:
     runs-on: ${{ matrix.os }}
 
     steps:
+      - name: Free space
+        # https://github.com/actions/runner-images/issues/2840#issuecomment-790492173
+        run: sudo rm -rf /usr/share/dotnet /opt/ghc /usr/local/share/boost "$AGENT_TOOLSDIRECTORY"
+
       - name: Checkout code
         uses: actions/checkout@v3
 
@@ -116,4 +120,4 @@ jobs:
 
       - run: opam install . --deps-only --with-test
 
-      - run: opam exec -- dune build
+      - run: opam exec -- dune runtest

.run-gha-tests.sh

@@ -86,4 +86,3 @@ case "$1" in
         printf "Usage: .run-gha-tests.sh [btrfs|rsync|zfs]" >&2
         exit 1
 esac
-

README.md

@@ -83,7 +83,7 @@ When performing a build, the user gives OBuilder a specification file (as descri
 and a source directory, containing files which may be copied into the image using `copy`.
 
 ```sexp
-((from BASE) OP...)
+((from BASE) OP…)
 ```
 
 Example:
@@ -128,7 +128,7 @@ For example:
  (run (shell "hello")))
 ```
 
-At the moment, the `(build ...)` items must appear before the `(from ...)` line.
+At the moment, the `(build …)` items must appear before the `(from …)` line.
 
 
 ### workdir
@@ -149,7 +149,7 @@ If the path given is relative, it is combined with the previous setting.
 ### shell
 
 ```sexp
-(shell ARG...)
+(shell ARG…)
 ```
 
 Example:
@@ -165,9 +165,9 @@ The command run will be this list of arguments followed by the single argument `
 
 ```sexp
 (run
- (cache CACHE...)?
- (network NETWORK...)?
- (secrets SECRET...)?
+ (cache CACHE…)?
+ (network NETWORK…)?
+ (secrets SECRET…)?
  (shell COMMAND))
 
 ```
@@ -188,7 +188,7 @@ Examples:
 
 Runs the single argument `COMMAND` using the values in the current context (set by `workdir` and `shell`).
 
-The `(cache CACHE...)` field can be used to mount one or more persistent caches for the command.
+The `(cache CACHE…)` field can be used to mount one or more persistent caches for the command.
 Each `CACHE` takes the form `(NAME (target PATH))`, where `NAME` uniquely identifies the cache to use
 and `PATH` is the mount point within the container.
 
@@ -198,14 +198,14 @@ A mutable copy of the cache is created for the command. When the command finishe
 this copy becomes the new version of the cache, unless some other command updated the same cache first, in
 which case this one is discarded.
 
-The `(network NETWORK...)` field specifies which network(s) the container will be connected to.
+The `(network NETWORK…)` field specifies which network(s) the container will be connected to.
 `(network host)` is a special value which runs the container in the host's network namespace.
 Otherwise, a fresh network namespace is created for the container, with interfaces for the given
 networks (if any).
 
 Currently, no other networks can be used, so the only options are `host` or an isolated private network.
 
-The `(secrets SECRET...)` field can be used to request values for chosen keys, mounted as read-only files in
+The `(secrets SECRET…)` field can be used to request values for chosen keys, mounted as read-only files in
 the image. Each `SECRET` entry is under the form `(ID (target PATH))`, where `ID` selects the secret, and
 `PATH` is the location of the mounted secret file within the container.
 The sandbox context API contains a `secrets` parameter to provide values to the runtime.
@@ -219,10 +219,10 @@ When used with Docker, make sure to use the **buildkit** syntax, as only buildki
 
 ```sexp
 (copy
- (from ...)?
- (src SRC...)
+ (from …)?
+ (src SRC…)
  (dst DST)
- (exclude EXCL...)?)
+ (exclude EXCL…)?)
 ```
 
 Examples:
@@ -257,7 +257,7 @@ Otherwise, it is the source directory provided by the user.
 Notes:
 
 - Unlike Docker's `COPY` operation, OBuilder copies the files using the current
-  user and group IDs, as set with `(user ...)`.
+  user and group IDs, as set with `(user …)`.
 
 - Both `SRC` and `DST` use `/` as the directory separator on all platforms.
 
@@ -304,12 +304,12 @@ obuilder dockerfile -f example.spec > Dockerfile
 
 The dockerfile should work the same way as the spec file, except for these limitations:
 
-- In `(copy (excludes ...) ...)` the excludes part is ignored.
+- In `(copy (excludes …) …)` the excludes part is ignored.
   You will need to ensure you have a suitable `.dockerignore` file instead.
 
 - If you want to include caches or to use secrets, use `--buildkit` to output in the extended BuildKit syntax.
 
-- All `(network ...)` fields are ignored, as Docker does not allow per-step control of
+- All `(network …)` fields are ignored, as Docker does not allow per-step control of
   networking.
 
 ## Experimental macOS Support

lib/btrfs_store.ml

@@ -142,8 +142,13 @@ let build t ?base ~id fn =
 let result t id =
   let dir = Path.result t id in
   match Os.check_dir dir with
-  | `Present -> Some dir
-  | `Missing -> None
+  | `Present -> Lwt.return_some dir
+  | `Missing -> Lwt.return_none
+
+let log_file t id =
+  result t id >|= function
+  | Some dir -> dir / "log"
+  | None -> (Path.result_tmp t id) / "log"
 
 let get_cache t name =
   match Hashtbl.find_opt t.caches name with

lib/build.ml

@@ -29,7 +29,9 @@ module Context = struct
     secrets : (string * string) list;
   }
 
-  let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?(workdir="/") ?(shell=["/bin/bash"; "-c"]) ?(secrets=[]) ~log ~src_dir () =
+  let v ?switch ?(env=[]) ?(user=Obuilder_spec.root) ?workdir ?shell ?(secrets=[]) ~log ~src_dir () =
+    let workdir = Option.value ~default:(if Sys.win32 then {|C:/|} else "/") workdir in
+    let shell = Option.value ~default:(if Sys.win32 then ["cmd"; "/S"; "/C"] else ["/bin/bash"; "-c"]) shell in
     { switch; env; src_dir; user; workdir; shell; log; scope = Scope.empty; secrets }
 
   let with_binding name value t =
@@ -122,7 +124,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
         match Scope.find_opt name scope with
         | None -> Fmt.failwith "Unknown build %S" name   (* (shouldn't happen; gets caught earlier) *)
         | Some id ->
-          match Store.result t.store id with
+          Store.result t.store id >>= function
           | None ->
             Lwt_result.fail (`Msg (Fmt.str "Build result %S not found" id))
           | Some dir ->
@@ -226,24 +228,24 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
     log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom base));
     let id = Sha256.to_hex (Sha256.string base) in
     Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp ->
-        Log.info (fun f -> f "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"; "-m"; "755"; "--"; rootfs] >>= fun () ->
         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 ()
       )
-    >>!= fun id ->
-    let path = Option.get (Store.result t.store id) in
+    >>!= fun id -> Store.result t.store id
+    >|= Option.get >>= fun path ->
     let { Saved_context.env } = Saved_context.t_of_sexp (Sexplib.Sexp.load_sexp (path / "env")) in
     Lwt_result.return (id, env)
 
   let rec build ~scope t context { Obuilder_spec.child_builds; from = base; ops } =
     let rec aux context = function
       | [] -> Lwt_result.return context
       | (name, child_spec) :: child_builds ->
-        context.Context.log `Heading Fmt.(str "(build %S ...)" name);
+        context.Context.log `Heading Fmt.(str "(build %S …)" name);
         build ~scope t context child_spec >>!= fun child_result ->
         context.Context.log `Note Fmt.(str "--> finished %S" name);
         let context = Context.with_binding name child_result context in

lib/db_store.ml

@@ -45,11 +45,11 @@ module Make (Raw : S.STORE) = struct
      or by doing a new build using [fn]. We only run one instance of this
      at a time for a single [id]. *)
   let get_build t ~base ~id ~cancelled ~set_log fn =
-    match Raw.result t.raw id with
-    | Some dir ->
+    Raw.result t.raw id >>= function
+    | Some _ ->
       let now = Unix.(gmtime (gettimeofday ())) in
       Dao.set_used t.dao ~id ~now;
-      let log_file = dir / "log" in
+      Raw.log_file t.raw id >>= fun log_file ->
       begin
         if Sys.file_exists log_file then Build_log.of_saved log_file
         else Lwt.return Build_log.empty
@@ -58,7 +58,7 @@ module Make (Raw : S.STORE) = struct
       Lwt_result.return (`Loaded, id)
     | None ->
       Raw.build t.raw ?base ~id (fun dir ->
-          let log_file = dir / "log" in
+          Raw.log_file t.raw id >>= fun log_file ->
           if Sys.file_exists log_file then Unix.unlink log_file;
           Build_log.create log_file >>= fun log ->
           Lwt.wakeup set_log log;

lib/db_store.mli

@@ -18,7 +18,7 @@ module Make (Raw : S.STORE) : sig
 
   val prune : ?log:(S.id -> unit) -> t -> before:Unix.tm -> int -> int Lwt.t
 
-  val result : t -> S.id -> string option
+  val result : t -> S.id -> string option Lwt.t
 
   val cache :
     user : Obuilder_spec.user ->

lib/macos.ml

@@ -41,7 +41,7 @@ let descendants ~pid =
       let+ s = pread ["sudo"; "pgrep"; "-P"; string_of_int pid ] in
       let pids = Astring.String.cuts ~sep:"\n" s in
       List.filter_map int_of_string_opt pids)
-    (* Errors if there are none, probably errors for other reasons too... *)
+    (* Errors if there are none, probably errors for other reasons too… *)
     (fun _ -> Lwt.return [])
 
 let kill ~pid =
@@ -69,7 +69,7 @@ let copy_template ~base ~local =
 let change_home_directory_for ~user ~home_dir =
   ["dscl"; "."; "-create"; "/Users/" ^ user ; "NFSHomeDirectory"; home_dir ]
 
-(* Used by the FUSE filesystem to indicate where a users home directory should be ...*)
+(* Used by the FUSE filesystem to indicate where a users home directory should be …*)
 let update_scoreboard ~uid ~scoreboard ~home_dir =
   ["ln"; "-Fhs"; home_dir; scoreboard ^ "/" ^ string_of_int uid]
 

lib/rsync_store.ml

@@ -120,8 +120,13 @@ let delete t id =
 let result t id =
   let dir = Path.result t id in
   match Os.check_dir dir with
-  | `Present -> Some dir
-  | `Missing -> None
+  | `Present -> Lwt.return_some dir
+  | `Missing -> Lwt.return_none
+
+let log_file t id =
+  result t id >|= function
+  | Some dir -> dir / "log"
+  | None -> (Path.result_tmp t id) / "log"
 
 let state_dir t = t.path / Path.state_dirname
 

lib/s.ml

@@ -34,9 +34,13 @@ module type STORE = sig
   val delete : t -> id -> unit Lwt.t
   (** [delete t id] removes [id] from the store, if present. *)
 
-  val result : t -> id -> string option
+  val result : t -> id -> string option Lwt.t
   (** [result t id] is the path of the build result for [id], if present. *)
 
+  val log_file : t -> id -> string Lwt.t
+  (** [log_file t id] is the path of the build logs for [id]. The file may
+      not exist if the build has never been run, or failed. *)
+
   val state_dir : t -> string
   (** [state_dir] is the path of a directory which can be used to store mutable
       state related to this store (e.g. an sqlite3 database). *)

lib/sandbox.macos.ml

@@ -5,7 +5,7 @@ type t = {
   uid: int;
   gid: int;
   (* Where zfs dynamic libraries are -- can't be in /usr/local/lib
-     see notes in .mli file under "Various Gotchas"... *)
+     see notes in .mli file under "Various Gotchas"… *)
   fallback_library_path : string;
   (* FUSE file system mount point *)
   fuse_path : string;
@@ -80,7 +80,7 @@ let user_name ~prefix ~uid =
 let home_directory user = Filename.concat "/Users/" user
 
 (* A build step in macos:
-   - Should be properly sandboxed using sandbox-exec (coming soon...)
+   - Should be properly sandboxed using sandbox-exec (coming soon…)
    - Umask g+w to work across users if restored from a snapshot
    - Set the new home directory of the user to something static and copy in the environment
    - Should be executed by the underlying user (t.uid) *)
@@ -120,7 +120,7 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp =
       if Lwt.is_sleeping proc then (
         match !proc_id with
           | Some pid -> Macos.kill_all_descendants ~pid
-          | None -> Log.warn (fun f -> f "Failed to find pid..."); Lwt.return ()
+          | None -> Log.warn (fun f -> f "Failed to find pid…"); Lwt.return ()
           )
       else Lwt.return_unit  (* Process has already finished *)
     in

lib/zfs_store.ml

@@ -213,8 +213,16 @@ let build t ?base ~id fn =
 let result t id =
   let ds = Dataset.result id in
   let path = Dataset.path t ds ~snapshot:default_snapshot in
-  if Sys.file_exists path then Some path
-  else None
+  if Sys.file_exists path then Lwt.return_some path
+  else Lwt.return_none
+
+let log_file t id =
+  result t id >|= function
+  | Some dir -> Filename.concat dir "log"
+  | None ->
+    let ds = Dataset.result id in
+    let clone = Dataset.path t ds in
+    Filename.concat clone "log"
 
 let get_cache t name =
   match Hashtbl.find_opt t.caches name with

lib_spec/docker.mli

@@ -4,7 +4,7 @@ val dockerfile_of_spec : buildkit:bool -> os:[`Unix | `Windows] -> Spec.t -> str
 
     However, note that:
 
-    - In "(copy (excludes ...) ...)" the excludes part is ignored. You will need to ensure
+    - In "(copy (excludes …) …)" the excludes part is ignored. You will need to ensure
       you have a suitable ".dockerignore" file.
     - The conversion is not robust against malicious input, as the escaping rules are unclear.
 

lib_spec/spec.ml

@@ -6,7 +6,7 @@ type sexp = Sexplib.Sexp.t =
   | Atom of string
   | List of sexp list
 
-(* Convert fields matched by [p] from (name v1 v2 ...) to (name (v1 v2 ...)) *)
+(* Convert fields matched by [p] from (name v1 v2 …) to (name (v1 v2 …)) *)
 let inflate_record p =
   let open Sexplib.Sexp in function
   | Atom _ as x -> Fmt.failwith "Invalid record field: %a" Sexplib.Sexp.pp_hum x
@@ -17,7 +17,7 @@ let inflate_record p =
     in
     List (List.map expand xs)
 
-(* Convert fields matched by [p] from (name (v1 v2 ...)) to (name v1 v2 ...) *)
+(* Convert fields matched by [p] from (name (v1 v2 …)) to (name v1 v2 …) *)
 let deflate_record p =
   let open Sexplib.Sexp in function
   | Atom _ as x -> Fmt.failwith "Invalid record field: %a" Sexplib.Sexp.pp_hum x
@@ -111,7 +111,7 @@ type op = [
 
 (* For some ops, we remove the extra () in the sexp string format,
    formatting them as if they were in-line records. e.g.
-   (copy ((src ...) (dst ...))) becomes (copy (src ...) (dst ...)). *)
+   (copy ((src …) (dst …))) becomes (copy (src …) (dst …)). *)
 let inline = function
   | "run" | "copy" | "user" | "env" -> true
   | _ -> false

stress.sh

@@ -1,12 +1,12 @@
 #!/bin/bash
 set -eu
 if [ "$#" -lt 1 ]; then
-	echo "usage: $0 STORE..."
+	echo "usage: $0 STORE…"
 	echo "e.g. $0 btrfs:/btrfs/stress zfs:stress"
 	exit 1;
 fi;
 stores="$*"
-echo "Remove everything that depends on busybox..."
+echo "Remove everything that depends on busybox…"
 for store in $stores; do
 	echo Clean $store
 	dune exec -- obuilder delete 9d75f0d7c398df565d7ac04c6819b62d6d8f9560f5eb4672596ecd8f7e96ae91 --store=$store