Display a warning when dune builds via RPC

When an instance of dune is already running, invoking `dune build` will
still build the target, howwever other command line arguments are
silently ignored by dune as the current RPC interface is too limited to
express them. This may change over time, but currently it's unusual UX
for `dune build` to behave differently depending on whether or not
another instance of `dune build` is already running. To more accurately
set user expectations, print a warning when dune is running with this
reduced functionality.

Signed-off-by: Stephen Sherratt <stephen@sherra.tt>

Author: gridbugs

bin/build_cmd.ml

@@ -207,7 +207,7 @@ let build =
        state of the lock could otherwise change between checking it and taking
        it. *)
     match Dune_util.Global_lock.lock ~timeout:None with
-    | Error () ->
+    | Error lock_held_by ->
       (* This case is reached if dune detects that another instance of dune
          is already running. Rather than performing the build itself, the
          current instance of dune will instruct the already-running instance to
@@ -217,6 +217,16 @@ let build =
          perform the RPC call.
       *)
       Scheduler.go_without_rpc_server ~common ~config (fun () ->
+        if not (Common.Builder.equal builder Common.Builder.default)
+        then
+          User_warning.emit
+            [ Pp.textf
+                "Your build request is being forwarded to a running Dune instance%s. \
+                 Note that certain command line arguments may be ignored."
+                (match (lock_held_by : Dune_util.Global_lock.Lock_held_by.t) with
+                 | Unknown -> ""
+                 | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid)
+            ];
         build_via_rpc_server targets)
     | Ok () ->
       let request setup =

doc/changes/11836.md

@@ -0,0 +1 @@
+- Print a warning when `dune build` runs over RPC (#11836, @gridbugs)

src/dune_util/global_lock.ml

@@ -66,6 +66,30 @@ end
 
 let locked = ref false
 
+module Lock_held_by = struct
+  type t =
+    | Pid_from_lockfile of int
+    | Unknown
+
+  let read_lock_file () =
+    match Io.read_file (Path.build lock_file) with
+    | exception _ -> Unknown
+    | pid ->
+      (match int_of_string_opt pid with
+       | Some pid -> Pid_from_lockfile pid
+       | None ->
+         User_error.raise
+           [ Pp.textf
+               "Unexpected contents of build directory global lock file (%s). Expected \
+                an integer PID. Found: %s"
+               (Path.Build.to_string_maybe_quoted lock_file)
+               pid
+           ]
+           ~hints:
+             [ Pp.textf "Try deleting %s" (Path.Build.to_string_maybe_quoted lock_file) ])
+  ;;
+end
+
 let lock ~timeout =
   match Config.(get global_lock) with
   | `Disabled -> Ok ()
@@ -90,20 +114,22 @@ let lock ~timeout =
       | `Success ->
         locked := true;
         Ok ()
-      | `Failure -> Error ())
+      | `Failure ->
+        let lock_held_by = Lock_held_by.read_lock_file () in
+        Error lock_held_by)
 ;;
 
 let lock_exn ~timeout =
   match lock ~timeout with
   | Ok () -> ()
-  | Error () ->
+  | Error lock_held_by ->
     User_error.raise
       [ Pp.textf
           "A running dune%s instance has locked the build directory. If this is not the \
-           case, please delete %s"
-          (match Io.read_file (Path.build lock_file) with
-           | exception _ -> ""
-           | pid -> sprintf " (pid: %s)" pid)
+           case, please delete %S."
+          (match lock_held_by with
+           | Unknown -> ""
+           | Pid_from_lockfile pid -> sprintf " (pid: %d)" pid)
           (Path.Build.to_string_maybe_quoted lock_file)
       ]
 ;;

src/dune_util/global_lock.mli

@@ -2,10 +2,16 @@
 
     Before starting rpc, writing to the build dir, this lock should be locked. *)
 
-(** attempt to acquire a lock. once a lock is locked, subsequent locks always
+module Lock_held_by : sig
+  type t =
+    | Pid_from_lockfile of int
+    | Unknown
+end
+
+(** Attempt to acquire a lock. once a lock is locked, subsequent locks always
     succeed. Returns [Ok ()] if the lock is acquired within [timeout] seconds,
     and [Error ()] otherwise. *)
-val lock : timeout:float option -> (unit, unit) result
+val lock : timeout:float option -> (unit, Lock_held_by.t) result
 
 val lock_exn : timeout:float option -> unit
 

test/blackbox-tests/test-cases/watching/watching-eager-concurrent-build-command.t

@@ -9,6 +9,7 @@ Build the project once before starting the watch server so the watch server star
   $ dune build --watch &
   Success, waiting for filesystem changes...
   Success, waiting for filesystem changes...
+  Success, waiting for filesystem changes...
   File "foo.ml", line 1, characters 9-21:
   1 | let () = print_endlin "Hello, World!"
                ^^^^^^^^^^^^
@@ -26,6 +27,13 @@ Demonstrate that we can run "dune build" while the watch server is running.
   $ dune build
   Success
 
+Demonstrate that a warning is displayed when extra arguments are passed to
+"dune build", since those arguments will be ignored.
+  $ dune build --auto-promote 2>&1 | sed 's/pid: [0-9]*/pid: PID/g'
+  Warning: Your build request is being forwarded to a running Dune instance
+  (pid: PID). Note that certain command line arguments may be ignored.
+  Success
+
 Demonstrate that error messages are still printed by "dune build" when it's
 acting as an RPC client while running concurrently with an RPC server.
   $ echo 'let () = print_endlin "Hello, World!"' > foo.ml
@@ -40,3 +48,4 @@ acting as an RPC client while running concurrently with an RPC server.
 
   $ dune shutdown
   $ wait
+