From c22ca23b4cfe7d1a03ac4c80ebf3d661618090d5 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 1 Jul 2015 17:19:47 +0100 Subject: [PATCH 1/6] Support for tools needing Cygwin paths Various Cygwin tools (notably tar and rsync) don't recognise Windows bashslash-style paths and need to have the path converted using the cygpath utility. Add two functions to OpamSystem to support this: 1. OpamSystem.is_cygwin_variant uses cygcheck to determine if a given program is the Cygwin-compiled version (cygcheck shows DLLs linked, so the presence of cygwin1.dll is taken to imply a Cygwin-based command). Note that for a Cygwin build of OPAM (and indeed for any other Unix-like build), this function always returns false. For a native Cygwin build, the user should specify Cygwin-style paths. 2. OpamSystem.apply_cygpath converts its argument to a Cygwin-style path using the cygpath utility Signed-off-by: David Allsopp --- src/core/opamStd.ml | 38 ++++++++++++++++++++++++++++++++++++++ src/core/opamStd.mli | 6 ++++++ src/core/opamSystem.ml | 22 ++++++++++++++++++++++ src/core/opamSystem.mli | 5 +++++ 4 files changed, 71 insertions(+) diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index 3bac95752da..48791ea5045 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -845,6 +845,44 @@ module OpamSys = struct (fun f -> try f () with _ -> ()) !registered_at_exit + let is_cygwin_variant = + if Sys.win32 then + let results = Hashtbl.create 17 in + let requires_cygwin name = + let cmd = Printf.sprintf "cygcheck \"%s\"" name in + let ((c, _, _) as process) = Unix.open_process_full cmd (Unix.environment ()) in + let rec f a = + match input_line c with + | x -> + if OpamString.ends_with ~suffix:"cygwin1.dll" (String.trim x) then + if OpamString.starts_with ~prefix:" " x then + f `Cygwin + else if a <> `Cygwin then + f `CygLinked + else + f a + else + f a + | exception _ -> + Unix.close_process_full process |> ignore; + a + in + f `Native + in + fun name -> + if Filename.is_relative name then + requires_cygwin name + else + try + Hashtbl.find results name + with Not_found -> + let result = requires_cygwin name + in + Hashtbl.add results name result; + result + else + fun _ -> `Native + exception Exit of int exception Exec of string * string array * string array diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index 4a623d03088..31114b2ac52 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -407,6 +407,12 @@ module Sys : sig Optional argument [clean] permits to keep those empty strings. *) val split_path_variable: ?clean:bool -> string -> string list + (** For native Windows builds, returns [`Cygwin] if the command is a Cygwin- + compiled executable, [`CygLinked] if the command links to a library which is + itself Cygwin-compiled or [`Native] otherwise. + Note that this returns [`Native] on a Cygwin-build of opam! *) + val is_cygwin_variant: string -> [ `Native | `Cygwin | `CygLinked ] + (** {3 Exit handling} *) (** Like Pervasives.at_exit but with the possibility to call manually diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 43f74569d60..6e3fb123598 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -384,6 +384,28 @@ let resolve_command = fun ?(env=default_env) ?dir name -> resolve env ?dir name +let apply_cygpath name = + let r = + OpamProcess.run + (OpamProcess.command ~name:(temp_file "command") ~verbose:false "cygpath" [name]) + in + OpamProcess.cleanup ~force:true r; + if OpamProcess.is_success r then + List.hd r.OpamProcess.r_stdout + else + OpamConsole.error_and_exit `Internal_error "Could not apply cygpath to %s" name + +let get_cygpath_function = + if Sys.win32 then + fun ~command -> + lazy (if OpamStd.(Option.map_default Sys.is_cygwin_variant `Native (resolve_command command)) = `Cygwin then + apply_cygpath + else + fun x -> x) + else + let f = Lazy.from_val (fun x -> x) in + fun ~command:_ -> f + let runs = ref [] let print_stats () = match !runs with diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index 20bcd98d914..3f0724d4c09 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -157,6 +157,11 @@ type command = string list if found in PATH) *) val resolve_command: ?env:string array -> ?dir:string -> string -> string option +(** Returns a function which should be applied to arguments for a given command + by determining if the command is the Cygwin variant of the command. Returns + the identity function otherwise. *) +val get_cygpath_function: command:string -> (string -> string) lazy_t + (** [command cmd] executes the command [cmd] in the correct OPAM environment. *) val command: ?verbose:bool -> ?env:string array -> ?name:string -> From 5684fd56591ee0ec6f5c3406eb23c9dda78a0dcf Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 1 Jul 2015 17:24:15 +0100 Subject: [PATCH 2/6] Support Cygwin tar on Windows Cygwin tar needs paths to be translated. With this patch, opam init can succesfully download and initialise ~/.opam using wget. Signed-off-by: David Allsopp --- src/core/opamSystem.ml | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 6e3fb123598..fe1515ba41b 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -650,18 +650,21 @@ module Tar = struct Some (Printf.sprintf "Tar needs %s to extract the archive" cmd) else None) - let extract_command file = - OpamStd.Option.Op.( - get_type file >>| fun typ -> - let tar_cmd = - match OpamStd.Sys.os () with - | OpamStd.Sys.OpenBSD -> "gtar" - | _ -> "tar" - in - let command c dir = - make_command tar_cmd [ Printf.sprintf "xf%c" c ; file; "-C" ; dir ] - in - command (extract_option typ)) + let extract_command = + let tar_cmd = + match OpamStd.Sys.os () with + | OpamStd.Sys.OpenBSD -> "gtar" + | _ -> "tar" + in + let f = get_cygpath_function ~command:tar_cmd in + fun file -> + OpamStd.Option.Op.( + get_type file >>| fun typ -> + let f = Lazy.force f in + let command c dir = + make_command tar_cmd [ Printf.sprintf "xf%c" c ; f file; "-C" ; f dir ] + in + command (extract_option typ)) end module Zip = struct From 49fe9975acaee8517edbb19458b7141a1d2fd273 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 17 Mar 2018 11:54:28 +0100 Subject: [PATCH 3/6] Support Cygwin Git on Windows file:// URLs need to be translated to use Cygwin PATHs. --- src/core/opamUrl.ml | 6 ++++++ src/core/opamUrl.mli | 4 ++++ src/repository/opamGit.ml | 10 ++++++++-- 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/core/opamUrl.ml b/src/core/opamUrl.ml index d2e2115dfa0..566e4e50fff 100644 --- a/src/core/opamUrl.ml +++ b/src/core/opamUrl.ml @@ -238,6 +238,12 @@ let to_json url = `String (to_string url) type url = t +let map_file_url f url = + if url.transport = "file" then + {url with path = f url.path} + else + url + module O = struct type t = url let to_string = to_string diff --git a/src/core/opamUrl.mli b/src/core/opamUrl.mli index ee9de12ae09..16d8f21d6f3 100644 --- a/src/core/opamUrl.mli +++ b/src/core/opamUrl.mli @@ -66,6 +66,10 @@ val local_file: t -> OpamFilename.t option to an existing local path, check for version-control clues at that path *) val guess_version_control: string -> [> version_control ] option +(** [map_file_url f url] applies [f] to the [path] portion of [url] if + [transport] is ["file"]. *) +val map_file_url : (string -> string) -> t -> t + module Op: sig (** Appends at the end of an URL path with '/' separator. Gets back to the diff --git a/src/repository/opamGit.ml b/src/repository/opamGit.ml index 8ea157b5c11..23b982c4664 100644 --- a/src/repository/opamGit.ml +++ b/src/repository/opamGit.ml @@ -22,10 +22,15 @@ module VCS : OpamVCS.VCS = struct OpamFilename.exists_dir (repo_root / ".git") || OpamFilename.exists (repo_root // ".git") + let cygpath = OpamSystem.get_cygpath_function ~command:"git" + let git repo_root = let dir = OpamFilename.Dir.to_string repo_root in - fun ?verbose ?env ?stdout args -> - OpamSystem.make_command ~dir ?verbose ?env ?stdout "git" args + (* If the ?env arg is restored here, then the caching for the Cygwin-ness + of git will need to change, as altering PATH could select a different + Git *) + fun ?verbose ?stdout args -> + OpamSystem.make_command ~dir ?verbose ?stdout "git" args let init repo_root repo_url = OpamFilename.mkdir repo_root; @@ -56,6 +61,7 @@ module VCS : OpamVCS.VCS = struct else Done (Some dir) | _ -> Done None) @@+ fun global_cache -> + let repo_url = OpamUrl.map_file_url (Lazy.force cygpath) repo_url in let origin = OpamUrl.base_url repo_url in let branch = OpamStd.Option.default "HEAD" repo_url.OpamUrl.hash in let opam_ref = remote_ref repo_url in From a9dfab1c5340ebf0dc31fd66b8d4f7f909dbb099 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 9 Nov 2015 11:30:57 +0000 Subject: [PATCH 4/6] rsync/local support on Windows Patch the rsync/local backend to use Cygpath when calling rsync. Enables the backend. Signed-off-by: David Allsopp --- src/repository/opamLocal.ml | 9 +++++++-- src/repository/opamVCS.ml | 4 +++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index 71f32b2e2e2..ae42b9d7039 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -25,6 +25,9 @@ let rsync_trim = function | _ :: _ :: _ :: l -> List.filter ((<>) "./") l | _ -> [] +let convert_path = + OpamSystem.get_cygpath_function ~command:"rsync" + let call_rsync check args = OpamSystem.make_command "rsync" args @@> fun r -> @@ -79,9 +82,10 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = Done (Not_available (None, src))) else ( OpamSystem.mkdir dst; + let convert_path = Lazy.force convert_path in call_rsync (fun () -> not (OpamSystem.dir_is_empty dst)) ( rsync_arg :: args @ exclude_args @ - [ "--delete"; "--delete-excluded"; src; dst; ]) + [ "--delete"; "--delete-excluded"; convert_path src; convert_path dst; ]) @@| function | None -> Not_available (None, src) | Some [] -> Up_to_date [] @@ -115,8 +119,9 @@ let rsync_file ?(args=[]) url dst = Done (Up_to_date dst) else (OpamFilename.mkdir (OpamFilename.dirname dst); + let convert_path = Lazy.force convert_path in call_rsync (fun () -> Sys.file_exists dst_s) - ( rsync_arg :: args @ [ src_s; dst_s ]) + ( rsync_arg :: args @ [ convert_path src_s; convert_path dst_s ]) @@| function | None -> Not_available (None, src_s) | Some [] -> Up_to_date dst diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index cc3941779b5..00d66ca1274 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -29,6 +29,8 @@ module type VCS = sig val is_dirty: dirname -> bool OpamProcess.job end +let convert_path = + OpamSystem.get_cygpath_function ~command:"rsync" module Make (VCS: VCS) = struct @@ -123,7 +125,7 @@ module Make (VCS: VCS) = struct OpamStd.String.Set.mem basename fset) then OpamFilename.remove f) (OpamFilename.rec_files repo_root); - OpamLocal.rsync_dirs ~args:["--files-from"; stdout_file] + OpamLocal.rsync_dirs ~args:["--files-from"; (Lazy.force convert_path) stdout_file] ~exclude_vcdirs:false repo_url repo_root @@+ fun result -> From dc3d3c7427e8e5173e6db25253e84ad9cc875cf2 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 17 May 2016 07:55:33 +0100 Subject: [PATCH 5/6] Extend OpamProcess to run scripts and Cygwin bins Invoking processes on Windows is fundamentally different from Unix since Windows processes receive a single-string command line, rather than an argv array. Windows has a set of conventions for quoting these (totally independent of the Command Processor cmd.exe and unambiguously allowing any argv array to be encoded) which OCaml already follows in the Unix module. Cygwin, for various reasons, does not follow these conventions and various different shims are required, particularly to avoid Cygwin's globbing operations. Armed with the ability to call Cygwin executables, OpamProcess is also to locate a script processor, meaning it can handle #! scripts directly. This is less error prone than trying to run them using sh -c which on Cygwin has even more complex escaping rules which have to be navigated. Signed-off-by: David Allsopp --- src/core/opamProcess.ml | 250 +++++++++++++++++++++++++++++++++++- src/core/opamProcess.mli | 4 + src/core/opamStd.ml | 25 +++- src/core/opamStd.mli | 4 + src/core/opamStubs.ml.dummy | 1 + src/core/opamStubs.ml.win32 | 4 + src/core/opamStubs.mli | 4 + src/core/opamSystem.ml | 3 + 8 files changed, 291 insertions(+), 4 deletions(-) diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index 42ff6ad61b5..76abce8762f 100644 --- a/src/core/opamProcess.ml +++ b/src/core/opamProcess.ml @@ -9,9 +9,188 @@ (* *) (**************************************************************************) +open OpamCompat + let log ?level fmt = OpamConsole.log "PROC" ?level fmt +let cygwin_create_process_env prog args env fd1 fd2 fd3 = + (* + * Unix.create_process_env correctly converts arguments to a command line for + * native Windows execution, but it does not correctly handle Cygwin's quoting + * requirements. + * + * The process followed here is based on an analysis of the sources for the + * Cygwin DLL (git://sourceware.org/git/newlib-cygwin.git, + * winsup/cygwin/dcrt0.cc) and a lack of refutation on the Cygwin mailing list + * in May 2016! + * + * In case this seems terminally stupid, it's worth noting that Cygwin's + * implementation of the exec system calls do not pass argv using the Windows + * command line, these weird and wonderful rules exist for corner cases and, + * as here, for invocations from native Windows processes. + * + * There are two forms of escaping which can apply, controlled by the CYGWIN + * environment variable option noglob. + * + * If none of the strings in argv contains the double-quote character, then + * the process should be invoked with the noglob option (to ensure that no + * characters are unexpectedly expanded). In this mode of escaping, it is + * necessary to protect any whitespace characters (\r, \n, \t, and space + * itself) by surrounding sequences of them with double-quotes). Additionally, + * if any string in argv begins with the @ sign, this should be double-quoted. + * + * If any one of the strings in argv does contain a double-quote character, + * then the process should be invoked with the glob option (this is the + * default). Every string in argv should have double-quotes put around it. Any + * double-quote characters within the string should be translated to "'"'". + * + * The reason for supporting both mechanisms is that the noglob method has + * shorter command lines and Windows has an upper limit of 32767 characters + * for the command line. + * + * COMBAK If the command line does exceed 32767 characters, then Cygwin allows + * a parameter beginning @ to refer to a file from which to read the + * rest of the command line. This support is not implemented at this + * time in OPAM. + * + * [This stray " is here to terminate a previous part of the comment!] + *) + let make_args argv = + let b = Buffer.create 128 in + let gen_quote ~quote ~pre ?(post = pre) s = + log ~level:3 "gen_quote: %S" s; + Buffer.clear b; + let l = String.length s in + let rec f i = + let j = + try + OpamStd.String.find_from (fun c -> try String.index quote c >= 0 with Not_found -> false) s (succ i) + with Not_found -> + l in + Buffer.add_string b (String.sub s i (j - i)); + if j < l then begin + Buffer.add_string b pre; + let i = j in + let j = + try + OpamStd.String.find_from (fun c -> try String.index quote c < 0 with Not_found -> true) s (succ i) + with Not_found -> + l in + Buffer.add_string b (String.sub s i (j - i)); + Buffer.add_string b post; + if j < l then + f j + else + Buffer.contents b + end else + Buffer.contents b in + let r = + if s = "" then + "\"\"" + else + f 0 + in + log ~level:3 "result: %S" r; r in + if List.exists (fun s -> try String.index s '"' >= 0 with Not_found -> false) argv then + ("\"" ^ String.concat "\" \"" (List.map (gen_quote ~quote:"\"" ~pre:"\"'" ~post:"'\"") argv) ^ "\"", false) + else + (String.concat " " (List.map (gen_quote ~quote:"\b\r\n " ~pre:"\"") argv), true) in + let (command_line, no_glob) = make_args (Array.to_list args) in + log "cygvoke(%sglob): %s" (if no_glob then "no" else "") command_line; + let env = Array.to_list env in + let set = ref false in + let f item = + let (key, value) = + match OpamStd.String.cut_at item '=' with + Some pair -> pair + | None -> (item, "") in + match String.lowercase_ascii key with + | "cygwin" -> + let () = + if key = "CYGWIN" then + set := true in + let settings = OpamStd.String.split value ' ' in + let set = ref false in + let f setting = + let setting = String.trim setting in + let setting = + match OpamStd.String.cut_at setting ':' with + Some (setting, _) -> setting + | None -> setting in + match setting with + "glob" -> + if no_glob then begin + log ~level:2 "Removing glob from %s" key; + false + end else begin + log ~level:2 "Leaving glob in %s" key; + set := true; + true + end + | "noglob" -> + if no_glob then begin + log ~level:2 "Leaving noglob in %s" key; + set := true; + true + end else begin + log ~level:2 "Removing noglob from %s" key; + false + end + | _ -> + true in + let settings = List.filter f settings in + let settings = + if not !set && no_glob then begin + log ~level:2 "Setting noglob in %s" key; + "noglob"::settings + end else + settings in + if settings = [] then begin + log ~level:2 "Removing %s completely" key; + None + end else + Some (key ^ "=" ^ String.concat " " settings) + | "path" -> + let path_dirs = OpamStd.Sys.split_path_variable item in + let winsys = Filename.concat (OpamStd.Sys.system ()) "." |> String.lowercase_ascii in + let rec f prefix suffix = function + | dir::dirs -> + let contains_cygpath = Sys.file_exists (Filename.concat dir "cygpath.exe") in + if suffix = [] then + if String.lowercase_ascii (Filename.concat dir ".") = winsys then + f prefix [dir] dirs + else + if contains_cygpath then + path_dirs + else + f (dir::prefix) [] dirs + else + if contains_cygpath then begin + log ~level:2 "Moving %s to after %s in PATH" dir (List.hd prefix); + List.rev_append prefix (dir::(List.rev_append suffix dirs)) + end else + f prefix (dir::suffix) dirs + | [] -> + assert false + in + Some (String.concat ";" (f [] [] path_dirs)) + | _ -> + Some item in + let env = OpamStd.List.filter_map f env in + let env = + if !set then + env + else + if no_glob then begin + log ~level:2 "Adding CYGWIN=noglob"; + "CYGWIN=noglob"::env + end else + env in + OpamStubs.win_create_process prog command_line + (Some(String.concat "\000" env ^ "\000")) + fd1 fd2 fd3 + (** Shell commands *) type command = { cmd: string; @@ -127,6 +306,15 @@ let string_of_info ?(color=`yellow) info = (OpamConsole.colorise color k) v) info; Buffer.contents b +let resolve_command_fn = ref (fun ?env:_ ?dir:_ _ -> None) +let set_resolve_command = + let called = ref false in + fun resolve_command -> + if !called then invalid_arg "Just what do you think you're doing, Dave?"; + called := true; + resolve_command_fn := resolve_command +let resolve_command cmd = !resolve_command_fn cmd + (** [create cmd args] create a new process to execute the command [cmd] with arguments [args]. If [stdout_file] or [stderr_file] are set, the channels are redirected to the corresponding files. The @@ -191,8 +379,68 @@ let create ?info_file ?env_file ?(allow_stdin=true) ?stdout_file ?stderr_file ?e close_out chan in let pid = + let cmd, args = + if Sys.win32 then + try + let actual_command = + if Sys.file_exists cmd then + cmd + else if Sys.file_exists (cmd ^ ".exe") then + cmd ^ ".exe" + else + raise Exit in + let actual_image, args = + let c = open_in actual_command in + set_binary_mode_in c true; + try + if really_input_string c 2 = "#!" then begin + (* The input_line will only fail for a 2-byte file consisting of exactly #! (with no \n), which is acceptable! *) + let l = String.trim (input_line c) in + let cmd, arg = + try + let i = String.index l ' ' in + let cmd = Filename.basename (String.trim (String.sub l 0 i)) in + let arg = String.trim (String.sub l i (String.length l - i)) in + if cmd = "env" then + arg, None + else + cmd, Some arg + with Not_found -> + Filename.basename l, None in + close_in c; + try + let cmd = OpamStd.Option.default cmd (resolve_command cmd) in + (*Printf.eprintf "Deduced %s => %s to be executed via %s\n%!" cmd actual_command cmd;*) + let args = actual_command::args in + cmd, OpamStd.Option.map_default (fun arg -> arg::args) args arg + with Not_found -> + (* Script interpreter isn't available - fall back *) + raise Exit + end else begin + close_in c; + actual_command, args + end + with End_of_file -> + close_in c; + (* A two-byte image can't be executable! *) + raise Exit in + (*Printf.eprintf "Final deduction: %s -> %s\n%!" cmd actual_image;*) + actual_image, args + with Exit -> + (* Fall back to default behaviour if anything went wrong - almost certainly means a broken package *) + cmd, args + else + cmd, args in + let create_process, cmd, args = + if Sys.win32 then + if OpamStd.Sys.is_cygwin_variant cmd = `Cygwin then + cygwin_create_process_env, cmd, args + else + Unix.create_process_env, cmd, args + else + Unix.create_process_env, cmd, args in try - Unix.create_process_env + create_process cmd (Array.of_list (cmd :: args)) env diff --git a/src/core/opamProcess.mli b/src/core/opamProcess.mli index a7bed9ff888..d8fee5a42d8 100644 --- a/src/core/opamProcess.mli +++ b/src/core/opamProcess.mli @@ -210,3 +210,7 @@ module Job: sig end type 'a job = 'a Job.Op.job + +(**/**) +val set_resolve_command : + (?env:string array -> ?dir:string -> string -> string option) -> unit diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index 48791ea5045..b60553aed46 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -435,6 +435,21 @@ module OpamString = struct with Not_found -> false + let find_from f s i = + let l = String.length s in + if i < 0 || i > l then + invalid_arg "find_from" + else + let rec g i = + if i < l then + if f s.[i] then + i + else + g (succ i) + else + raise Not_found in + g i + let map f s = let len = String.length s in let b = Bytes.create len in @@ -597,9 +612,9 @@ module OpamSys = struct if Sys.win32 then fun path -> let length = String.length path in let rec f acc index current last normal = - if index = length - then let current = current ^ String.sub path last (index - last) in - if current <> "" then current::acc else acc + if index = length then + let current = current ^ String.sub path last (index - last) in + List.rev (if current <> "" then current::acc else acc) else let c = path.[index] and next = succ index in if c = ';' && normal || c = '"' then @@ -708,6 +723,10 @@ module OpamSys = struct Hashtbl.add memo arg r; r + let system () = + (* CSIDL_SYSTEM = 0x25 *) + OpamStubs.(shGetFolderPath 0x25 SHGFP_TYPE_CURRENT) + type os = | Darwin | Linux diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index 31114b2ac52..f94d52196e4 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -224,6 +224,7 @@ module String : sig val contains_char: string -> char -> bool val contains: sub:string -> string -> bool val exact_match: Re.re -> string -> bool + val find_from: (char -> bool) -> string -> int -> int (** {3 Manipulation} *) @@ -368,6 +369,9 @@ module Sys : sig (** The /etc directory *) val etc: unit -> string + (** The system directory (Windows only) *) + val system: unit -> string + type os = Darwin | Linux | FreeBSD diff --git a/src/core/opamStubs.ml.dummy b/src/core/opamStubs.ml.dummy index 3ab003abb38..a7afdee2874 100644 --- a/src/core/opamStubs.ml.dummy +++ b/src/core/opamStubs.ml.dummy @@ -35,3 +35,4 @@ let shGetFolderPath _ = that's_a_no_no let sendMessageTimeout _ _ _ _ _ = that's_a_no_no let getParentProcessID = that's_a_no_no let getConsoleAlias _ = that's_a_no_no +let win_create_process _ _ _ _ _ = that's_a_no_no diff --git a/src/core/opamStubs.ml.win32 b/src/core/opamStubs.ml.win32 index 05c868791c7..22792c62461 100644 --- a/src/core/opamStubs.ml.win32 +++ b/src/core/opamStubs.ml.win32 @@ -11,3 +11,7 @@ include OpamStubsTypes include OpamWin32Stubs let getpid () = Int32.to_int (getCurrentProcessID ()) + +external win_create_process : string -> string -> string option -> + Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int + = "win_create_process" "win_create_process_native" diff --git a/src/core/opamStubs.mli b/src/core/opamStubs.mli index b4d057bcd60..1f95183133d 100644 --- a/src/core/opamStubs.mli +++ b/src/core/opamStubs.mli @@ -128,3 +128,7 @@ val getConsoleAlias : string -> string -> string (** Windows only. [getConsoleAlias alias exeName] retrieves the value for a given executable or [""] if the alias is not defined. See https://docs.microsoft.com/en-us/windows/console/getconsolealias *) + +val win_create_process : string -> string -> string option -> Unix.file_descr -> + Unix.file_descr -> Unix.file_descr -> int +(** Windows only. Provided by OCaml's win32unix library. *) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index fe1515ba41b..084446472d1 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -1292,3 +1292,6 @@ let init () = Sys.catch_break true; try Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> ())) with Invalid_argument _ -> () + +let () = + OpamProcess.set_resolve_command resolve_command From 40e14ff2629314d0076a7b7abe4d131720b76700 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 27 Jun 2016 20:23:33 +0100 Subject: [PATCH 6/6] Disable noglob cygvoke mode This preferred mode of invocation of Cygwin programs is intended to keep the command line length down, but it's causing problems for ocamlbuild. Signed-off-by: David Allsopp --- src/core/opamProcess.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index 76abce8762f..6252403150e 100644 --- a/src/core/opamProcess.ml +++ b/src/core/opamProcess.ml @@ -92,7 +92,10 @@ let cygwin_create_process_env prog args env fd1 fd2 fd3 = f 0 in log ~level:3 "result: %S" r; r in - if List.exists (fun s -> try String.index s '"' >= 0 with Not_found -> false) argv then + (* Setting noglob is causing some problems for ocamlbuild invoking Cygwin's + find. The reason for using it is to try to keep command line lengths + below the maximum, but for now disable the use of noglob. *) + if true || List.exists (fun s -> try String.index s '"' >= 0 with Not_found -> false) argv then ("\"" ^ String.concat "\" \"" (List.map (gen_quote ~quote:"\"" ~pre:"\"'" ~post:"'\"") argv) ^ "\"", false) else (String.concat " " (List.map (gen_quote ~quote:"\b\r\n " ~pre:"\"") argv), true) in