From b52e2090670b20007788d01e24a0fb9bf1cae148 Mon Sep 17 00:00:00 2001
From: sneeker <s@cpl0.zip>
Date: Wed, 20 Jul 2022 17:50:41 +0000
Subject: [PATCH] feat(exec): spill long command lines into response files

---
 lib/build.ml |  5 +++--
 lib/exec.ml  | 36 ++++++++++++++++++++++++++++++++++++
 lib/graph.ml |  8 ++++++--
 lib/sched.ml |  9 ++++++++-
 4 files changed, 53 insertions(+), 5 deletions(-)

diff --git a/lib/build.ml b/lib/build.ml
index 9ac79e3..c6182aa 100644
--- a/lib/build.ml
+++ b/lib/build.ml
@@ -123,7 +123,7 @@ let of_project p =
             let tag = if lang_of src = Cxx then "c++" else "cc" in
             add
               (Graph.make ~id:!n ~tag ~label:src ~cmd ~outs:[ obj ] ~ins:[ src ]
-                 ~depfile:(obj ^ ".d") ~ords:gen_headers ());
+                 ~depfile:(obj ^ ".d") ~ords:gen_headers ~rsp:(obj ^ ".rsp") ());
             obj)
           (all_srcs t)
       in
@@ -132,7 +132,8 @@ let of_project p =
       let ins = objs @ List.map (fun (d : target) -> out_of p d) (deps_of p t) in
       let label = match t.kind with Lib | Shared -> Filename.basename out | _ -> t.name in
       let outs = out :: Option.to_list (implib_of p t) in
-      add (Graph.make ~id:!n ~tag ~label ~cmd:(link_cmd p t objs) ~outs ~ins ());
+      add
+        (Graph.make ~id:!n ~tag ~label ~cmd:(link_cmd p t objs) ~outs ~ins ~rsp:(out ^ ".rsp") ());
       Hashtbl.replace outputs t.name (!n - 1))
     p.targets;
   { g = Graph.build (List.rev !nodes); outputs; p }
diff --git a/lib/exec.ml b/lib/exec.ml
index f2af1c3..ba5c9b8 100644
--- a/lib/exec.ml
+++ b/lib/exec.ml
@@ -82,3 +82,39 @@ let which name =
     | Some path ->
         String.split_on_char ':' path
         |> List.exists (fun dir -> dir <> "" && Sys.file_exists (Filename.concat dir name))
+
+(* execve measures the arguments and the environment together against ARG_MAX,
+   so what a command line may use is the limit less the environment it inherits.
+   Staying under a fraction of that leaves room for the pointer table and for an
+   environment that grows between the check and the spawn. *)
+let arg_max =
+  lazy
+    (match capture [| "getconf"; "ARG_MAX" |] with
+    | 0, out -> ( match int_of_string_opt (String.trim out) with Some n when n > 0 -> n | _ -> 131072)
+    | _ -> 131072
+    | exception _ -> 131072)
+
+let entry_size s = String.length s + 1 + 8
+
+let budget =
+  lazy
+    (let env = Array.fold_left (fun n s -> n + entry_size s) 0 (Unix.environment ()) in
+     max 8192 ((Lazy.force arg_max - env) * 7 / 8))
+
+let too_long cmd = Array.fold_left (fun n s -> n + entry_size s) 0 cmd > Lazy.force budget
+
+(* A GNU response file holds one argument per line, quoted so that spaces and
+   backslashes in a path survive the second round of parsing. The compiler
+   drivers and binutils expand @file before they read anything else, so the tool
+   sees the same argument list either way. *)
+let quote_arg s =
+  let b = Buffer.create (String.length s + 2) in
+  Buffer.add_char b '"';
+  String.iter (fun c -> if c = '"' || c = '\\' then Buffer.add_char b '\\'; Buffer.add_char b c) s;
+  Buffer.add_char b '"';
+  Buffer.contents b
+
+let response path cmd =
+  let args = Array.to_list (Array.sub cmd 1 (Array.length cmd - 1)) in
+  Fs.write path (String.concat "\n" (List.map quote_arg args) ^ "\n");
+  [| cmd.(0); "@" ^ path |]
diff --git a/lib/graph.ml b/lib/graph.ml
index badc0e4..b81b0a7 100644
--- a/lib/graph.ml
+++ b/lib/graph.ml
@@ -8,13 +8,17 @@ type node = {
   depfile : string option;
   ords : string list;
   pool : string;
+  (* where to spill the arguments when the command line will not fit; only set
+     for commands meowc composes itself, since an arbitrary program from a rule
+     need not understand @file *)
+  rsp : string option;
   mutable deps : int list;
 }
 
 type t = { nodes : node array; by_output : (string, int) Hashtbl.t }
 
-let make ~id ~tag ~label ~cmd ~outs ~ins ?depfile ?(ords = []) ?(pool = "default") () =
-  { id; tag; label; cmd; outs; ins; depfile; ords; pool; deps = [] }
+let make ~id ~tag ~label ~cmd ~outs ~ins ?depfile ?(ords = []) ?(pool = "default") ?rsp () =
+  { id; tag; label; cmd; outs; ins; depfile; ords; pool; rsp; deps = [] }
 
 let build specs =
   let nodes = Array.of_list specs in
diff --git a/lib/sched.ml b/lib/sched.ml
index c5cf0eb..210920e 100644
--- a/lib/sched.ml
+++ b/lib/sched.ml
@@ -51,6 +51,13 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
   in
   let spawn (v : Graph.node) =
     List.iter (fun o -> Fs.mkdir_p (Filename.dirname o)) v.outs;
+    (* The node keeps the command it means, which is what the cache key and
+       every report are built from, and only the spawn goes through @file. *)
+    let argv =
+      match v.rsp with
+      | Some path when Exec.too_long v.cmd -> Exec.response path v.cmd
+      | _ -> v.cmd
+    in
     let tmp = Filename.temp_file "meowc" ".log" in
     let fd = Unix.openfile tmp [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
     let nul = Exec.devnull () in
@@ -65,7 +72,7 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
              Unix.dup2 fd Unix.stderr;
              Unix.close fd;
              Unix.close nul;
-             Unix.execvp v.cmd.(0) v.cmd
+             Unix.execvp argv.(0) argv
            with _ -> ());
           Unix._exit 127
       | pid -> pid