diff --git a/opam-client.opam b/opam-client.opam index 5807b44166b..8efb1dae349 100644 --- a/opam-client.opam +++ b/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: [ diff --git a/src/client/dune b/src/client/dune index b3d4b7d516f..2aa079fcc6a 100644 --- a/src/client/dune +++ b/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) diff --git a/src/client/opamArg.ml b/src/client/opamArg.ml index c51fe05c359..2ec557056a3 100644 --- a/src/client/opamArg.ml +++ b/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 \ diff --git a/src/client/opamCmd.ml b/src/client/opamCmd.ml new file mode 100644 index 00000000000..27e9aefdbd5 --- /dev/null +++ b/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 diff --git a/src/client/opamCmd.mli b/src/client/opamCmd.mli new file mode 100644 index 00000000000..89bb7f0cb78 --- /dev/null +++ b/src/client/opamCmd.mli @@ -0,0 +1 @@ +val of_string : string -> string list diff --git a/src/client/opamInitDefaults.ml b/src/client/opamInitDefaults.ml index 6fa8dafb024..14e999109e5 100644 --- a/src/client/opamInitDefaults.ml +++ b/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 diff --git a/src/repository/opamRepositoryConfig.ml b/src/repository/opamRepositoryConfig.ml index 373177e9f20..ebbf4c0c1c1 100644 --- a/src/repository/opamRepositoryConfig.ml +++ b/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 diff --git a/src/repository/opamRepositoryConfig.mli b/src/repository/opamRepositoryConfig.mli index ddcdb9522a8..cb75b0c95bd 100644 --- a/src/repository/opamRepositoryConfig.mli +++ b/src/repository/opamRepositoryConfig.mli @@ -14,7 +14,7 @@ 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 @@ -22,11 +22,11 @@ module E : sig | 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 diff --git a/src_ext/Makefile b/src_ext/Makefile index b4d6c165bfe..96776106a6a 100644 --- a/src_ext/Makefile +++ b/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) diff --git a/src_ext/Makefile.sources b/src_ext/Makefile.sources index 038ed683799..ed16372cccf 100644 --- a/src_ext/Makefile.sources +++ b/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) diff --git a/src_ext/dune-astring-src b/src_ext/dune-astring-src new file mode 100644 index 00000000000..636facd5b93 --- /dev/null +++ b/src_ext/dune-astring-src @@ -0,0 +1,13 @@ +(library + (name astring) + (public_name astring) + (modules + astring_unsafe + astring_base + astring_escape + astring_char + astring_sub + astring_string + astring) + (flags :standard -w -3) + (wrapped false))