Fix parsing of OPAMFETCH (support quotes / proper POSIX shell syntax)

opam-client.opam

@@ -33,6 +33,7 @@ depends: [
   "opam-repository" {= version}
   "re" {>= "1.9.0"}
   "cmdliner" {>= "1.1.0"}
+  "astring" {>= "0.8.0"}
   "dune" {>= "2.0.0"}
 ]
 conflicts: [

src/client/dune

@@ -4,7 +4,7 @@
   (synopsis    "OCaml Package Manager client and CLI library")
   (modules     (:standard \ opamMain get_git_version))
   ; TODO: Remove (re_export ...) when CI uses the OCaml version that includes https://github.com/ocaml/ocaml/pull/11989
-  (libraries   opam-state opam-solver (re_export opam-repository) re base64 cmdliner)
+  (libraries   opam-state opam-solver (re_export opam-repository) re base64 cmdliner astring)
   (flags       (:standard
                (:include ../ocaml-flags-standard.sexp)
                (:include ../ocaml-flags-configure.sexp)

src/client/opamArg.ml

@@ -202,7 +202,7 @@ let environment_variables =
       "CURL", cli_original, (fun v -> CURL (env_string v)),
       "can be used to select a given 'curl' program. See $(i,OPAMFETCH) for \
        more options.";
-      "FETCH", cli_original, (fun v -> FETCH (env_string v)),
+      "FETCH", cli_original, (fun v -> FETCH (Option.map OpamCmd.of_string (env_string v))),
       "specifies how to download files: either `wget', `curl' or a custom \
        command where variables $(b,%{url}%), $(b,%{out}%), $(b,%{retry}%), \
        $(b,%{compress}%) and $(b,%{checksum}%) will be replaced. Overrides the \

src/client/opamCmd.ml

@@ -0,0 +1,89 @@
+open Astring
+
+(* NOTE: Copied from @dbuenzli's bos library (module Bos_cmd) *)
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+let parse_cmdline s =
+  try
+    let err_unclosed kind s =
+      failwith @@
+      Format.sprintf "%d: unclosed %s quote delimited string"
+        (String.Sub.start_pos s) kind
+    in
+    let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in
+    let tok_sep c = c = '\'' || c = '\"' || Char.Ascii.is_white c in
+    let tok_char c = not (tok_sep c) in
+    let not_squote c = c <> '\'' in
+    let parse_squoted s =
+      let tok, rem = String.Sub.span ~sat:not_squote (String.Sub.tail s) in
+      if not (String.Sub.is_empty rem) then tok, String.Sub.tail rem else
+      err_unclosed "single" s
+    in
+    let parse_dquoted acc s =
+      let is_data = function '\\' | '"' -> false | _ -> true in
+      let rec loop acc s =
+        let data, rem = String.Sub.span ~sat:is_data s in
+        match String.Sub.head rem with
+        | Some '"' -> (data :: acc), (String.Sub.tail rem)
+        | Some '\\' ->
+            let rem = String.Sub.tail rem in
+            begin match String.Sub.head rem with
+            | Some ('"' | '\\' | '$' | '`' as c) ->
+                let acc = String.(sub (of_char c)) :: data :: acc in
+                loop acc (String.Sub.tail rem)
+            | Some ('\n') -> loop (data :: acc) (String.Sub.tail rem)
+            | Some _c ->
+                let acc = String.Sub.extend ~max:2 data :: acc in
+                loop acc (String.Sub.tail rem)
+            | None ->
+                err_unclosed "double" s
+            end
+        | None -> err_unclosed "double" s
+        | Some _ -> assert false
+      in
+      loop acc (String.Sub.tail s)
+    in
+    let parse_token s =
+      let ret acc s = String.Sub.(to_string @@ concat (List.rev acc)), s in
+      let rec loop acc s = match String.Sub.head s with
+      | None -> ret acc s
+      | Some c when Char.Ascii.is_white c -> ret acc s
+      | Some '\'' ->
+          let tok, rem = parse_squoted s in loop (tok :: acc) rem
+      | Some '\"' ->
+          let acc, rem = parse_dquoted acc s in loop acc rem
+      | Some _c ->
+          let sat = tok_char in
+          let tok, rem = String.Sub.span ~sat s in loop (tok :: acc) rem
+      in
+      loop [] s
+    in
+    let rec loop acc s =
+      if String.Sub.is_empty s then acc else
+      let token, s = parse_token s in
+      loop (token :: acc) (skip_white s)
+    in
+    Ok (loop [] (skip_white (String.sub s)))
+  with Failure err ->
+    Error (Format.asprintf "command line %a:%s" String.dump s err)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The bos programmers
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
+
+let of_string s =
+  match parse_cmdline s with
+  | Ok x -> List.rev x
+  | Error msg -> OpamConsole.error_and_exit `Bad_arguments "%s" msg

src/client/opamCmd.mli

@@ -0,0 +1 @@
+val of_string : string -> string list

src/client/opamInitDefaults.ml

@@ -104,8 +104,7 @@ let req_dl_tools () =
   let open OpamStd.Option.Op in
   let cmd =
     (OpamRepositoryConfig.E.fetch_t ()
-     >>= fun s ->
-     match OpamStd.String.split s ' ' with
+     >>= function
      | c::_ -> Some c
      | _ -> None)
     >>+ fun () -> OpamRepositoryConfig.E.curl_t ()
@@ -118,8 +117,8 @@ let req_dl_tools () =
 let dl_tool () =
   let open OpamStd.Option.Op in
   (OpamRepositoryConfig.E.fetch_t ()
-   >>+ fun () -> OpamRepositoryConfig.E.curl_t ())
-  >>| fun cmd -> [(CString cmd), None]
+   >>+ fun () -> Option.map (fun x -> [x]) (OpamRepositoryConfig.E.curl_t ()))
+  >>| fun cmd -> List.map (fun x -> (CString x, None)) cmd
 
 let recommended_tools () =
   let make = OpamStateConfig.(Lazy.force !r.makecmd) in

src/repository/opamRepositoryConfig.ml

@@ -14,7 +14,7 @@ module E = struct
 
   type OpamStd.Config.E.t +=
     | CURL of string option
-    | FETCH of string option
+    | FETCH of string list option
     | NOCHECKSUMS of bool option
     | REPOSITORYTARRING of bool option
     | REQUIRECHECKSUMS of bool option
@@ -109,9 +109,7 @@ let update ?noop:_ = setk (fun cfg () -> r := cfg) !r
 let initk k =
   let open OpamStd.Option.Op in
   let download_tool =
-    E.fetch () >>= (fun s ->
-        let args = OpamStd.String.split s ' ' in
-        match args with
+    E.fetch () >>= (function
         | cmd::a ->
           let cmd, kind =
             if OpamStd.String.ends_with ~suffix:"curl" cmd then

src/repository/opamRepositoryConfig.mli

@@ -14,19 +14,19 @@
 module E : sig
   type OpamStd.Config.E.t +=
     | CURL of string option
-    | FETCH of string option
+    | FETCH of string list option
     | NOCHECKSUMS of bool option
     | REPOSITORYTARRING of bool option
     | REQUIRECHECKSUMS of bool option
     | RETRIES of int option
     | VALIDATIONHOOK of string option
 
   val curl: unit -> string option
-  val fetch: unit -> string option
+  val fetch: unit -> string list option
 
  (* Non lazy access *)
   val curl_t: unit -> string option
-  val fetch_t: unit -> string option
+  val fetch_t: unit -> string list option
 end
 
 (** Toggles parsing of the tool's output to detect errors

src_ext/Makefile

@@ -32,7 +32,7 @@ URL_PKG_$(1) = $(URL_$(1))
 MD5_PKG_$(1) = $(MD5_$(1))
 endef
 
-SRC_EXTS = cppo base64 extlib re cmdliner ocamlgraph cudf dose3 opam-file-format seq stdlib-shims spdx_licenses opam-0install-cudf 0install-solver uutf jsonm sha swhid_core
+SRC_EXTS = cppo base64 extlib re cmdliner ocamlgraph cudf dose3 opam-file-format seq stdlib-shims spdx_licenses opam-0install-cudf 0install-solver uutf jsonm sha swhid_core astring
 PKG_EXTS = $(SRC_EXTS) dune-local findlib ocamlbuild topkg mccs
 
 ifeq ($(MCCS_ENABLED),true)

src_ext/Makefile.sources

@@ -105,3 +105,8 @@ URL_swhid_core = https://github.com/OCamlPro/swhid_core/archive/refs/tags/0.1.ta
 MD5_swhid_core = 77d88d4b1d96261c866f140c64d89af8
 
 $(call PKG_SAME,swhid_core)
+
+URL_astring = https://erratique.ch/software/astring/releases/astring-0.8.5.tbz
+MD5_astring = e148907c24157d1df43bec89b58b3ec8
+
+$(call PKG_SAME,astring)