From 1e10d2b73ca71a2e14bcf347e33d581e89e00a65 Mon Sep 17 00:00:00 2001 From: Ryan Gibb Date: Sat, 26 Sep 2026 09:23:02 +0100 Subject: [PATCH] npm: no range, tag, alias or packument silently reads as "*" or as nothing --- lib/npm/archive.ml | 17 +- lib/npm/encoding.ml | 6 +- lib/npm/lookup.ml | 17 +- lib/npm/npm_parse.ml | 320 +++++---------------- lib/npm/npm_version.ml | 165 +++++++---- lib/npm/query.ml | 179 +++++++++++- lib/npm/test_npm_version.ml | 28 +- test/frontends/npm.t/digtag.json | 4 + test/frontends/npm.t/run.t | 56 ++++ test/frontends/npm.t/spec-app/package.json | 15 + 10 files changed, 489 insertions(+), 318 deletions(-) create mode 100644 test/frontends/npm.t/digtag.json create mode 100644 test/frontends/npm.t/spec-app/package.json diff --git a/lib/npm/archive.ml b/lib/npm/archive.ml index d971481..a529a16 100644 --- a/lib/npm/archive.ml +++ b/lib/npm/archive.ml @@ -114,9 +114,16 @@ let download ar n f = let url = "https://registry.npmjs.org/" ^ escape n in ar.n_fetched <- ar.n_fetched + 1; match curl ~url ~out:tmp with - | `Fetched -> - Sys.rename tmp f; - Some f + | `Fetched -> ( + (* a body that is no packument would be read back from the cache on + every later run *) + match P.load tmp with + | Ok _ -> + Sys.rename tmp f; + Some f + | Error e -> + remove tmp; + raise (Fetch_failed (Printf.sprintf "fetching %s: %s" url e))) | `Absent -> remove tmp; None @@ -146,8 +153,8 @@ let add_name ar n vs = let read_packument ar n f = match P.load f with - | None -> [] - | Some pk -> + | Error e -> raise (Fetch_failed (Printf.sprintf "reading %s: %s" f e)) + | Ok pk -> Option.iter (Hashtbl.replace ar.latest n) pk.P.pk_latest; Hashtbl.replace ar.tags n pk.P.pk_tags; (* the name fetched under is authoritative: a manifest's own "name" diff --git a/lib/npm/encoding.ml b/lib/npm/encoding.ml index 7f48194..c7230b5 100644 --- a/lib/npm/encoding.ml +++ b/lib/npm/encoding.ml @@ -7,8 +7,9 @@ module NVerOT = Ot.Make (struct let compare = Npm_version.compare end) -(* SemverMatch: the two tests V.compare cannot express. sameCore takes - the candidate version first and the comparator's constant second. *) +(* SemverMatch: the two tests the version order cannot express. sameCore + takes the candidate version first and the comparator's constant + second. *) module PM = struct let isPre = Npm_version.is_prerelease let sameCore = Npm_version.same_core @@ -24,7 +25,6 @@ let xop : Npm_version.op -> E.cmpOp = function | Npm_version.Le -> E.OpLe | Npm_version.Lt -> E.OpLt | Npm_version.Eq -> E.OpEq - | Npm_version.Ne -> E.OpNe let xcomp : Npm_version.comparator -> Np.coq_Comparator = function | Npm_version.Any -> Np.CAny diff --git a/lib/npm/lookup.ml b/lib/npm/lookup.ml index e2d8d06..17eae6e 100644 --- a/lib/npm/lookup.ml +++ b/lib/npm/lookup.ml @@ -23,18 +23,15 @@ let star_range ar (t : string) (rg : Npm_version.range) : Npm_version.range = (* npm-pick-manifest takes a dist-tag's version exactly, and a tag the packument lacks matches nothing (ETARGET) *) -let tag_range ar ~tag ~star (t : string) (rg : Npm_version.range) : - Npm_version.range = - match tag with - | Some g -> ( +let spec_range ar (t : string) : P.spec -> Npm_version.range = function + | P.Tag g -> ( match A.dist_tag ar t g with | Some v -> [ [ Npm_version.Cmp (Npm_version.Eq, v) ] ] | None -> [ [ Npm_version.Cmp (Npm_version.Lt, "0.0.0") ] ]) - | None when star -> star_range ar t rg - | None -> rg + | P.Star -> star_range ar t [ [ Npm_version.Any ] ] + | P.Range rg -> rg -let own_range ar (d : P.dep) = - tag_range ar ~tag:d.P.d_tag ~star:d.P.d_star d.P.d_target d.P.d_range +let own_range ar (d : P.dep) = spec_range ar d.P.d_target d.P.d_spec let xdep ar (d : P.dep) : Np.coq_Dependency = { @@ -49,9 +46,7 @@ let xdep ar (d : P.dep) : Np.coq_Dependency = let xpeer ar (r : P.peer) : Np.coq_PeerDependency = { Np.p_name = r.P.p_name; - Np.p_range = - xrange - (tag_range ar ~tag:r.P.p_tag ~star:r.P.p_star r.P.p_name r.P.p_range); + Np.p_range = xrange (spec_range ar r.P.p_name r.P.p_spec); (* binds only a copy the declarer's depender holds itself, npm's legacy rule; arborist checks whatever copy the declarer resolves to (edge.js:266-277) *) diff --git a/lib/npm/npm_parse.ml b/lib/npm/npm_parse.ml index 52b88b7..0622050 100644 --- a/lib/npm/npm_parse.ml +++ b/lib/npm/npm_parse.ml @@ -1,25 +1,20 @@ +(* How npa's fromRegistry reads a registry spec: a range where node-semver + reads one, loosely, and otherwise a dist-tag, which only the target's + packument resolves. The literal "*", and the empty range npm reads as + it, is npm's own case apart from every range meaning the same. *) +type spec = Range of Npm_version.range | Star | Tag of string + type dep = { d_dir : string; (* the directory key, i.e. the manifest key *) d_target : string; (* the registry package, differing under npm: *) - d_range : Npm_version.range; + d_spec : spec; d_dev : bool; (* not carried into the calculus: it only tells the solver that this dependency may be abandoned when the registry cannot satisfy it *) d_optional : bool; - (* the range was written as the literal "*" or left empty, which npm - reads apart from every other range that means the same *) - d_star : bool; - (* a dist-tag, which the target's packument turns into a version *) - d_tag : string option; } -type peer = { - p_name : string; - p_range : Npm_version.range; - p_optional : bool; - p_star : bool; - p_tag : string option; -} +type peer = { p_name : string; p_spec : spec; p_optional : bool } type ver = { v_name : string; @@ -58,35 +53,47 @@ let has_sub s sub = let rec go i = i + m <= n && (String.sub s i m = sub || go (i + 1)) in m = 0 || go 0 -let starts p s = - String.length s >= String.length p && String.sub s 0 (String.length p) = p +let starts p s = String.starts_with ~prefix:p s -(* a bare identifier with no digit and no operator is a dist-tag, which - only the registry can resolve -- except "x"/"X", which are semver's - wildcards and mean the same as "*" *) -let looks_like_tag s = - s <> "" && s <> "x" && s <> "X" - && String.for_all - (fun c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '-') - s +(* npa's isAliasSpec, which takes the prefix in any case *) +let is_alias s = starts "npm:" (String.lowercase_ascii s) (* git, file and URL specs, and the link:, workspace:, portal: and patch: - specs npa refuses, are dropped and counted rather than guessed at. No - range semver reads, loose or not, holds a '!', so npa takes one for a - tag name and refuses it (EINVALIDTAGNAME). *) + specs npa refuses, are dropped and counted rather than guessed at. *) let unresolvable s = - String.contains s '!' || has_sub s "://" || starts "$" s || starts "git+" s - || starts "git:" s || starts "file:" s || starts "link:" s - || starts "workspace:" s || starts "portal:" s || starts "patch:" s - || (has_sub s "/" && not (starts "npm:" s)) + has_sub s "://" || starts "$" s || starts "git+" s || starts "git:" s + || starts "file:" s || starts "link:" s || starts "workspace:" s + || starts "portal:" s || starts "patch:" s + || (has_sub s "/" && not (is_alias s)) + +(* encodeURIComponent(s) === s *) +let uri_safe = + String.for_all (fun c -> + (c >= 'a' && c <= 'z') + || (c >= 'A' && c <= 'Z') + || (c >= '0' && c <= '9') + || String.contains "-_.!~*'()" c) + +let is_star rg = + let rg = String.trim rg in + rg = "*" || rg = "" -let tag_of s = if looks_like_tag s then Some s else None +(* a tag must be a name encodeURIComponent leaves alone, and npa refuses + any other (EINVALIDTAGNAME) *) +let spec_of_string (s : string) : spec option = + if is_star s then Some Star + else + match Npm_version.parse_range_opt s with + | Some rg -> Some (Range rg) + | None -> + let t = String.trim s in + if uri_safe t then Some (Tag t) else None (* "npm:bar@^1" and "npm:@scope/bar@^1": npa splits at the first @ past the scope's; this takes the last, which differs only when the range itself holds an @ *) let split_alias (s : string) : (string * string) option = - if not (starts "npm:" s) then None + if not (is_alias s) then None else let body = String.sub s 4 (String.length s - 4) in let n = String.length body in @@ -98,10 +105,6 @@ let split_alias (s : string) : (string * string) option = | -1 -> Some (body, "*") | i -> Some (String.sub body 0 i, String.sub body (i + 1) (n - i - 1)) -let is_star rg = - let rg = String.trim rg in - rg = "*" || rg = "" - let dep_of ~dev ~optional (key, spec) : dep option = let target, rg = match spec with @@ -111,60 +114,62 @@ let dep_of ~dev ~optional (key, spec) : dep option = | None -> (key, Some spec)) | _ -> (key, None) in - match rg with - | Some rg when not (unresolvable rg) -> + match + Option.bind rg (fun rg -> + if unresolvable rg then None else spec_of_string rg) + with + | Some sp -> Some { d_dir = key; d_target = target; - d_range = Npm_version.parse_range rg; + d_spec = sp; d_dev = dev; d_optional = optional; - d_star = is_star rg; - d_tag = tag_of rg; } - | _ -> + | None -> reject (); None +(* A peer names a directory and the calculus reads its range against the + package of that name, so an alias, which puts another package there, is + dropped and counted like a spec no registry lookup resolves. *) let peer_of (meta : (string * Yojson.Safe.t) list) (key, spec) : peer option = + let optional = + match List.assoc_opt key meta with + | Some m -> ( match member "optional" m with `Bool b -> b | _ -> false) + | None -> false + in match spec with - | `String spec -> - let optional = - match List.assoc_opt key meta with - | Some m -> ( - match member "optional" m with `Bool b -> b | _ -> false) - | None -> false - in - if unresolvable spec then ( - reject (); - None) - else - Some - { - p_name = key; - p_range = Npm_version.parse_range spec; - p_optional = optional; - p_star = is_star spec; - p_tag = tag_of spec; - } + | `String spec when not (unresolvable spec || is_alias spec) -> ( + match spec_of_string spec with + | Some sp -> Some { p_name = key; p_spec = sp; p_optional = optional } + | None -> + reject (); + None) | _ -> reject (); None (* npm reads overrides from the root project's package.json; only the - flat "name": "range" form is a static override, so a nested object -- which - is keyed by the parent chain -- is counted and dropped. A value of * - overrides nothing: an edge takes its range from an override only when - the value is not * (arborist edge.js, spec), and OverrideSet reads an - empty value as *. *) + flat "name": "range" form is a static override, so a nested object -- + which is keyed by the parent chain -- is counted and dropped, and so is + a tag or an alias, which replaces the spec rather than the range. A + value of * overrides nothing: an edge takes its range from an override + only when the value is not * (arborist edge.js, spec), and OverrideSet + reads an empty value as *. *) let overrides_of (j : Yojson.Safe.t) : (string * Npm_version.range) list = List.filter_map (fun (k, v) -> match v with | `String ("*" | "") -> None - | `String rg when not (unresolvable rg || looks_like_tag rg) -> - Some (k, Npm_version.parse_range rg) + | `String rg when not (unresolvable rg || is_alias rg) -> ( + match spec_of_string rg with + | Some (Range r) -> Some (k, r) + | Some Star -> Some (k, [ [ Npm_version.Any ] ]) + | Some (Tag _) | None -> + reject (); + None) | _ -> reject (); None) @@ -262,177 +267,10 @@ let of_json (j : Yojson.Safe.t) : packument = in { pk_latest = latest; pk_tags = tags; pk_vers = vers } -let load (path : string) : packument option = +(* A packument that will not parse says nothing about the name's versions, + so it is an error rather than a name with none. *) +let load (path : string) : (packument, string) result = match Yojson.Safe.from_file path with - | exception (Yojson.Json_error _ | Sys_error _) -> - reject (); - None - | j -> Some (of_json j) - -(* The query is a root package: a project's package.json with the - arguments of `npm install` added to it. An argument is read as - npm-package-arg 13.0.2 (npm 11.17.0) reads it, lib/npa.js, and only its - registry forms are accepted: name, name@version, name@range, name@tag - and key@npm:name@range. Anything npa reads as a file, directory, URL or - git spec is refused rather than dropped, because a query missing one of - its arguments asks a different question. *) - -(* /^(?:git[+])?[a-z]+:/i *) -let is_url s = - let s = String.lowercase_ascii s in - let s = if starts "git+" s then String.sub s 4 (String.length s - 4) else s in - let n = String.length s in - let rec go i = - i < n - && if s.[i] = ':' then i > 0 else s.[i] >= 'a' && s.[i] <= 'z' && go (i + 1) - in - go 0 - -(* isPosixFile, /^(?:[.]|~[/]|[/]|[a-zA-Z]:)/, or what npa takes for a file - before it looks for a name: an unscoped name part with a slash or a - tarball's extension *) -let is_path s = - starts "." s || starts "~/" s || starts "/" s - || String.length s >= 2 - && s.[1] = ':' - && Char.lowercase_ascii s.[0] >= 'a' - && Char.lowercase_ascii s.[0] <= 'z' - || (not (starts "@" s)) - && (String.contains s '/' - || List.exists (Filename.check_suffix s) [ ".tgz"; ".tar.gz"; ".tar" ]) - -(* /^[^@]+@[^:.]+\.[^:]+:.+$/, an scp-style git remote *) -let is_git s = - match String.index_opt s '@' with - | Some i when i > 0 -> ( - let rest = String.sub s (i + 1) (String.length s - i - 1) in - match String.index_opt rest ':' with - | Some j -> ( - let host = String.sub rest 0 j in - j + 1 < String.length rest - && - match String.index_opt host '.' with - | Some k -> k > 0 && k + 1 < j - | None -> false) - | None -> false) - | _ -> false - -(* an argument npa would read as a local path, which the query takes for - the project's package.json *) -let is_manifest_arg s = (not (is_url s)) && (not (is_git s)) && is_path s - -(* encodeURIComponent(s) === s *) -let uri_safe = - String.for_all (fun c -> - (c >= 'a' && c <= 'z') - || (c >= 'A' && c <= 'Z') - || (c >= '0' && c <= '9') - || String.contains "-_.!~*'()" c) - -(* validate-npm-package-name 7.0.2's validForOldPackages, which npa - tests: its errors, and none of its warnings *) -let name_ok n = - n <> "" - && (not (starts "." n)) - && (not (starts "-" n)) - && (not (starts "_" n)) - && String.trim n = n - && (not - (List.mem (String.lowercase_ascii n) [ "node_modules"; "favicon.ico" ])) - && (uri_safe n - || - match String.index_opt n '/' with - | Some i when starts "@" n -> - let pkg = String.sub n (i + 1) (String.length n - i - 1) in - i > 1 - && (not (String.contains pkg '/')) - && pkg <> "" - && (not (starts "." pkg)) - && uri_safe (String.sub n 1 (i - 1)) - && uri_safe pkg - | _ -> false) - -(* The key and the raw spec: the name ends at the first @ past a scope's - own, and a bare name or a trailing @ asks for *. Whether a registry - spec is a range or a tag is left to the driver, which has the - packument's dist-tags. *) -let spec_of (arg : string) : (string * string) option = - let n = String.length arg in - let at = if n > 1 then String.index_from_opt arg 1 '@' else None in - let name_part = match at with Some i -> String.sub arg 0 i | None -> arg in - let raw = - match at with - | Some i -> ( - match String.sub arg (i + 1) (n - i - 1) with "" -> "*" | s -> s) - | None -> "*" - in - if is_url arg || is_git arg || is_path name_part || not (name_ok name_part) - then None - else if starts "npm:" (String.lowercase_ascii raw) then - (* fromAlias: the target is read again, and must be a named registry - spec and not itself an alias *) - match split_alias ("npm:" ^ String.sub raw 4 (String.length raw - 4)) with - | Some (t, rg) - when name_ok t - && (not (starts "npm:" (String.lowercase_ascii rg))) - && not (unresolvable rg || looks_like_tag rg) -> - Some (name_part, raw) - | _ -> None - else if is_url raw || is_path raw || has_sub raw "/" then None - else Some (name_part, raw) - -(* arborist's addRmPkgDeps.add, lib/add-rm-pkg-deps.js, for a request with - no --save-* flag: the entry goes to the first field that already names - it, in inferSaveType's order, else to dependencies, and replaces what is - there unless it is *. The fields a save type cannot coexist with lose - the name, and an optional entry is mirrored into dependencies. *) -let add_to (pkg : Yojson.Safe.t) ((name, raw) : string * string) : Yojson.Safe.t - = - let has f = List.mem_assoc name (assoc_of (member f pkg)) in - let target = - List.find_opt has - [ - "devDependencies"; - "optionalDependencies"; - "dependencies"; - "peerDependencies"; - ] - |> Option.value ~default:"dependencies" - in - let drop = - match target with - | "dependencies" -> [ "devDependencies"; "peerDependencies" ] - | "devDependencies" -> [ "dependencies" ] - | "optionalDependencies" -> [ "peerDependencies" ] - | _ -> [ "dependencies"; "optionalDependencies" ] - in - let drop = - if List.mem "peerDependencies" drop then "peerDependenciesMeta" :: drop - else drop - in - (* a JavaScript object keeps a new key last *) - let set k v l = - if List.mem_assoc k l then - List.map (fun (k', x) -> if k' = k then (k, v) else (k', x)) l - else l @ [ (k, v) ] - in - let fields = - List.map - (fun (k, v) -> - if List.mem k drop then (k, `Assoc (List.remove_assoc name (assoc_of v))) - else (k, v)) - (assoc_of pkg) - in - let cur = assoc_of (member target (`Assoc fields)) in - let fields = - if raw <> "*" || not (List.mem_assoc name cur) then - set target (`Assoc (set name (`String raw) cur)) fields - else fields - in - if target = "optionalDependencies" then - let spec = member name (member target (`Assoc fields)) in - set "dependencies" - (`Assoc (set name spec (assoc_of (member "dependencies" (`Assoc fields))))) - fields - |> fun l -> `Assoc l - else `Assoc fields + | exception Sys_error e -> Error e + | `Assoc _ as j -> Ok (of_json j) + | _ | (exception Yojson.Json_error _) -> Error "not a packument" diff --git a/lib/npm/npm_version.ml b/lib/npm/npm_version.ml index 59aa6ea..985a0e8 100644 --- a/lib/npm/npm_version.ml +++ b/lib/npm/npm_version.ml @@ -4,7 +4,7 @@ let compare = V.Loose.compare let is_prerelease = V.Loose.is_prerelease let same_core = V.Loose.same_core -type op = Ge | Gt | Le | Lt | Eq | Ne +type op = Ge | Gt | Le | Lt | Eq type comparator = Any | Cmp of op * string type comp_set = comparator list (* whitespace is conjunction *) type range = comp_set list (* || is disjunction *) @@ -77,7 +77,6 @@ let ineq ~z ~u op (ma, mi, pa, pre) = match op with | Ge -> [ Cmp (Ge, vstr ~pre:lo m n p) ] | Lt -> [ Cmp (Lt, vstr ~pre:up m n p) ] - | Ne -> [ Cmp (Ne, vstr ~pre m n p) ] | Gt -> if has_pa then [ Cmp (Gt, vstr ~pre m n p) ] else if has_mi then [ Cmp (Ge, vstr ~pre:z m (n + 1) 0) ] @@ -113,31 +112,92 @@ let hyphen ~z ~u a b = in match lo @ hi with [] -> [ Any ] | l -> l -let starts p s = - String.length s >= String.length p && String.sub s 0 (String.length p) = p +let is_digit c = c >= '0' && c <= '9' + +let is_ident c = + (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || is_digit c || c = '-' + +let rec skip_while f s i = + if i < String.length s && f s.[i] then skip_while f s (i + 1) else i + +(* dot-separated runs of [is_ident] from i, as semver's prerelease and + build identifiers are: where they end, or None if there is none *) +let idents s i = + let rec go i = + let j = skip_while is_ident s i in + if j = i then None + else if j < String.length s && s.[j] = '.' then + match go (j + 1) with Some k -> Some k | None -> Some j + else Some j + in + go i + +(* the [v=\s]* semver allows before a version, after any operator *) +let strip_v s = + let i = skip_while (fun c -> c = 'v' || c = '=') s 0 in + String.sub s i (String.length s - i) + +(* XRANGEPLAINLOOSE at i (internal/re.js): one to three parts, each + digits, x, X or *, and after three a prerelease, its hyphen optional, + and a build *) +let xrange_plain s i = + let n = String.length s in + let part i = + if i < n && (s.[i] = 'x' || s.[i] = 'X' || s.[i] = '*') then Some (i + 1) + else + let j = skip_while is_digit s i in + if j > i then Some j else None + in + let dotted k i = + match part i with + | None -> false + | Some j -> j = n || (s.[j] = '.' && k (j + 1)) + in + let tail i = + let i = if i < n && s.[i] <> '+' then idents s i else Some i in + match i with + | None -> false + | Some i -> i = n || (s.[i] = '+' && idents s (i + 1) = Some n) + in + dotted + (dotted (fun i -> match part i with Some j -> tail j | None -> false)) + (skip_while (fun c -> c = 'v' || c = '=') s i) + +(* A comparator node-semver keeps in a loose range: parseComparator strips + the first build it finds, and what then matches none of its caret, + tilde and x-range grammars is thrown out of the set. *) +let comparator_ok (tok : string) = + let n = String.length tok in + let tok = + let rec plus i = + match String.index_from_opt tok i '+' with + | Some p when p + 1 < n && is_ident tok.[p + 1] -> ( + match idents tok (p + 1) with + | Some e -> String.sub tok 0 p ^ String.sub tok e (n - e) + | None -> tok) + | Some p -> plus (p + 1) + | None -> tok + in + plus 0 + in + let starts p = String.starts_with ~prefix:p tok in + if starts "^" then xrange_plain tok 1 + else if starts "~>" then xrange_plain tok 2 + else if starts "~" then xrange_plain tok 1 + else xrange_plain tok (if starts "<" || starts ">" then 1 else 0) let comparators_of ~z ~u (tok : string) : comparator list = - let drop k = String.sub tok k (String.length tok - k) in - (* the "v" prefix is allowed on the version part after an operator too, - so "^v1.2.3" is "^1.2.3"; without this the leading v makes the first - component unparseable and the whole comparator widens to "*" *) let spec k = - let s = drop k in - parse_spec - (if starts "v" s || starts "V" s then String.sub s 1 (String.length s - 1) - else s) + parse_spec (strip_v (String.sub tok k (String.length tok - k))) in - if tok = "" then [] - else if starts "^" tok then caret ~z ~u (spec 1) - else if starts "~>" tok then tilde ~u (spec 2) - else if starts "~" tok then tilde ~u (spec 1) - else if starts ">=" tok then ineq ~z ~u Ge (spec 2) - else if starts "<=" tok then ineq ~z ~u Le (spec 2) - else if starts ">" tok then ineq ~z ~u Gt (spec 1) - else if starts "<" tok then ineq ~z ~u Lt (spec 1) - else if starts "==" tok then bare ~z ~u (spec 2) - else if starts "=" tok then bare ~z ~u (spec 1) - else if starts "v" tok then bare ~z ~u (spec 1) + let starts p = String.starts_with ~prefix:p tok in + if starts "^" then caret ~z ~u (spec 1) + else if starts "~>" then tilde ~u (spec 2) + else if starts "~" then tilde ~u (spec 1) + else if starts ">=" then ineq ~z ~u Ge (spec 2) + else if starts "<=" then ineq ~z ~u Le (spec 2) + else if starts ">" then ineq ~z ~u Gt (spec 1) + else if starts "<" then ineq ~z ~u Lt (spec 1) else bare ~z ~u (spec 0) let is_op_only s = @@ -155,39 +215,44 @@ let rec glue = function | a :: rest -> a :: glue rest | [] -> [] -let parse_set ~z ~u (s : string) : comp_set = +(* A set whose every comparator is thrown out is thrown out itself; an + empty one is "*". *) +let parse_set ~z ~u (s : string) : comp_set option = match glue (split_ws s) with - | [] -> [ Any ] - | [ a; "-"; b ] -> hyphen ~z ~u a b + | [] -> Some [ Any ] + | [ a; "-"; b ] when xrange_plain a 0 && xrange_plain b 0 -> + Some (hyphen ~z ~u (strip_v a) (strip_v b)) | toks -> ( - match List.concat_map (comparators_of ~z ~u) toks with - | [] -> [ Any ] - | l -> l) + match List.filter comparator_ok toks with + | [] -> None + | toks -> Some (List.concat_map (comparators_of ~z ~u) toks)) (* the || alternatives are the unit the prerelease rule is scoped to, so they stay separate all the way into the calculus *) let split_alts (s : string) : string list = let n = String.length s in - let out = ref [] and buf = Buffer.create 16 in - let i = ref 0 in - while !i < n do - if !i + 1 < n && s.[!i] = '|' && s.[!i + 1] = '|' then ( - out := Buffer.contents buf :: !out; - Buffer.clear buf; - i := !i + 2) - else ( - Buffer.add_char buf s.[!i]; - incr i) - done; - out := Buffer.contents buf :: !out; - List.rev !out - -(* include_prerelease reads the range as semver's includePrerelease does, - for [holds_pre] *) -let parse_range ?(include_prerelease = false) (s : string) : range = + let rec go start i acc = + if i >= n then List.rev (String.sub s start (n - start) :: acc) + else if i + 1 < n && s.[i] = '|' && s.[i + 1] = '|' then + go (i + 2) (i + 2) (String.sub s start (i - start) :: acc) + else go start (i + 1) acc + in + go 0 0 [] + +(* None where node-semver's Range refuses the string, every set having + been thrown out, and npa then reads the spec as a dist-tag. + include_prerelease reads the range as semver's includePrerelease does, + for [holds_pre]. *) +let parse_range_opt ?(include_prerelease = false) (s : string) : range option = let z = if include_prerelease then "0" else "" in - let s = String.trim s in - if s = "" then [ [ Any ] ] else List.map (parse_set ~z ~u:z) (split_alts s) + match List.filter_map (parse_set ~z ~u:z) (split_alts s) with + | [] -> None + | rg -> Some rg + +(* satisfies catches the TypeError of a range semver refuses and answers + false, so such a range, with no set at all, matches nothing *) +let parse_range ?include_prerelease s = + Option.value ~default:[] (parse_range_opt ?include_prerelease s) let comp_match ct v = match ct with @@ -199,8 +264,7 @@ let comp_match ct v = | Gt -> s > 0 | Le -> s <= 0 | Lt -> s < 0 - | Eq -> s = 0 - | Ne -> s <> 0) + | Eq -> s = 0) let cs_admits cs v = V.Loose.admits v @@ -230,7 +294,6 @@ let string_of_op = function | Le -> "<=" | Lt -> "<" | Eq -> "=" - | Ne -> "!=" let string_of_comparator = function | Any -> "*" diff --git a/lib/npm/query.ml b/lib/npm/query.ml index 00ee7c8..85110ef 100644 --- a/lib/npm/query.ml +++ b/lib/npm/query.ml @@ -1,6 +1,170 @@ module P = Npm_parse let ( let* ) = Result.bind +let starts = P.starts + +(* The query is a root package: a project's package.json with the + arguments of `npm install` added to it. An argument is read as + npm-package-arg 13.0.2 (npm 11.17.0) reads it, lib/npa.js, and only its + registry forms are accepted: name, name@version, name@range, name@tag + and key@npm:name@range. Anything npa reads as a file, directory, URL or + git spec is refused rather than dropped, because a query missing one of + its arguments asks a different question. *) + +(* /^(?:git[+])?[a-z]+:/i *) +let is_url s = + let s = String.lowercase_ascii s in + let s = if starts "git+" s then String.sub s 4 (String.length s - 4) else s in + let n = String.length s in + let rec go i = + i < n + && if s.[i] = ':' then i > 0 else s.[i] >= 'a' && s.[i] <= 'z' && go (i + 1) + in + go 0 + +(* isPosixFile, /^(?:[.]|~[/]|[/]|[a-zA-Z]:)/, or what npa takes for a file + before it looks for a name: an unscoped name part with a slash or a + tarball's extension *) +let is_path s = + starts "." s || starts "~/" s || starts "/" s + || String.length s >= 2 + && s.[1] = ':' + && Char.lowercase_ascii s.[0] >= 'a' + && Char.lowercase_ascii s.[0] <= 'z' + || (not (starts "@" s)) + && (String.contains s '/' + || List.exists (Filename.check_suffix s) [ ".tgz"; ".tar.gz"; ".tar" ]) + +(* /^[^@]+@[^:.]+\.[^:]+:.+$/, an scp-style git remote *) +let is_git s = + match String.index_opt s '@' with + | Some i when i > 0 -> ( + let rest = String.sub s (i + 1) (String.length s - i - 1) in + match String.index_opt rest ':' with + | Some j -> ( + let host = String.sub rest 0 j in + j + 1 < String.length rest + && + match String.index_opt host '.' with + | Some k -> k > 0 && k + 1 < j + | None -> false) + | None -> false) + | _ -> false + +(* an argument npa would read as a local path, which the query takes for + the project's package.json *) +let is_manifest_arg s = (not (is_url s)) && (not (is_git s)) && is_path s + +(* validate-npm-package-name 7.0.2's validForOldPackages, which npa + tests: its errors, and none of its warnings *) +let name_ok n = + n <> "" + && (not (starts "." n)) + && (not (starts "-" n)) + && (not (starts "_" n)) + && String.trim n = n + && (not + (List.mem (String.lowercase_ascii n) [ "node_modules"; "favicon.ico" ])) + && (P.uri_safe n + || + match String.index_opt n '/' with + | Some i when starts "@" n -> + let pkg = String.sub n (i + 1) (String.length n - i - 1) in + i > 1 + && (not (String.contains pkg '/')) + && pkg <> "" + && (not (starts "." pkg)) + && P.uri_safe (String.sub n 1 (i - 1)) + && P.uri_safe pkg + | _ -> false) + +(* The key and the raw spec: the name ends at the first @ past a scope's + own, and a bare name or a trailing @ asks for *. Whether a registry + spec is a range or a tag is left to [classify], which has the + packument's dist-tags. *) +let spec_of (arg : string) : (string * string) option = + let n = String.length arg in + let at = if n > 1 then String.index_from_opt arg 1 '@' else None in + let name_part = match at with Some i -> String.sub arg 0 i | None -> arg in + let raw = + match at with + | Some i -> ( + match String.sub arg (i + 1) (n - i - 1) with "" -> "*" | s -> s) + | None -> "*" + in + if is_url arg || is_git arg || is_path name_part || not (name_ok name_part) + then None + else if P.is_alias raw then + (* fromAlias: the target is read again, and must be a named registry + spec and not itself an alias *) + match P.split_alias raw with + | Some (t, rg) + when name_ok t + && (not (P.is_alias rg)) + && (not (P.unresolvable rg)) + && P.spec_of_string rg <> None -> + Some (name_part, raw) + | _ -> None + else if is_url raw || is_path raw || P.has_sub raw "/" then None + else if P.spec_of_string raw = None then None + else Some (name_part, raw) + +(* arborist's addRmPkgDeps.add, lib/add-rm-pkg-deps.js, for a request with + no --save-* flag: the entry goes to the first field that already names + it, in inferSaveType's order, else to dependencies, and replaces what is + there unless it is *. The fields a save type cannot coexist with lose + the name, and an optional entry is mirrored into dependencies. *) +let add_to (pkg : Yojson.Safe.t) ((name, raw) : string * string) : Yojson.Safe.t + = + let member = P.member and assoc_of = P.assoc_of in + let has f = List.mem_assoc name (assoc_of (member f pkg)) in + let target = + List.find_opt has + [ + "devDependencies"; + "optionalDependencies"; + "dependencies"; + "peerDependencies"; + ] + |> Option.value ~default:"dependencies" + in + let drop = + match target with + | "dependencies" -> [ "devDependencies"; "peerDependencies" ] + | "devDependencies" -> [ "dependencies" ] + | "optionalDependencies" -> [ "peerDependencies" ] + | _ -> [ "dependencies"; "optionalDependencies" ] + in + let drop = + if List.mem "peerDependencies" drop then "peerDependenciesMeta" :: drop + else drop + in + (* a JavaScript object keeps a new key last *) + let set k v l = + if List.mem_assoc k l then + List.map (fun (k', x) -> if k' = k then (k, v) else (k', x)) l + else l @ [ (k, v) ] + in + let fields = + List.map + (fun (k, v) -> + if List.mem k drop then (k, `Assoc (List.remove_assoc name (assoc_of v))) + else (k, v)) + (assoc_of pkg) + in + let cur = assoc_of (member target (`Assoc fields)) in + let fields = + if raw <> "*" || not (List.mem_assoc name cur) then + set target (`Assoc (set name (`String raw) cur)) fields + else fields + in + if target = "optionalDependencies" then + let spec = member name (member target (`Assoc fields)) in + set "dependencies" + (`Assoc (set name spec (assoc_of (member "dependencies" (`Assoc fields))))) + fields + |> fun l -> `Assoc l + else `Assoc fields let manifest (paths : string list) : (Yojson.Safe.t, string) result = match paths with @@ -20,15 +184,18 @@ let not_registry s = (* npm refuses a dist-tag that is a range, so a spec the packument tags is a tag, and one it does not is a range unless it can only be a tag *) let classify ar s : ([ `Plain | `Tagged ] * (string * string), string) result = - match P.spec_of s with + match spec_of s with | None -> not_registry s - | Some (k, r) when P.split_alias r <> None || r = "*" -> Ok (`Plain, (k, r)) + | Some (k, r) when P.is_alias r || r = "*" -> Ok (`Plain, (k, r)) | Some (k, r) -> ( let r' = String.trim r in match Archive.dist_tag ar k r' with | Some v -> Ok (`Tagged, (k, v)) - | None when P.looks_like_tag r' -> Error (s ^ ": no such dist-tag") - | None -> Ok (`Plain, (k, r))) + | None -> ( + match P.spec_of_string r with + | Some (P.Tag _) -> Error (s ^ ": no such dist-tag") + | Some (P.Range _ | P.Star) -> Ok (`Plain, (k, r)) + | None -> not_registry s)) (* arborist's #add resolves a tag to its version only after an await, so the other specs are all added first, in order. *) @@ -73,8 +240,8 @@ let root_of pkg = | None -> Error "not a package.json" let root ar (args : string list) : (P.ver, string) result = - let paths, specs = List.partition P.is_manifest_arg args in + let paths, specs = List.partition is_manifest_arg args in let* pkg = manifest paths in let* specs = resolve_specs ar specs in let* () = check_published ar specs in - root_of (List.fold_left P.add_to pkg specs) + root_of (List.fold_left add_to pkg specs) diff --git a/lib/npm/test_npm_version.ml b/lib/npm/test_npm_version.ml index 5d71f57..238cdaa 100644 --- a/lib/npm/test_npm_version.ml +++ b/lib/npm/test_npm_version.ml @@ -8,7 +8,11 @@ let check a b exp = incr fail) let rng s exp = - let got = Npm_version.string_of_range (Npm_version.parse_range s) in + let got = + match Npm_version.parse_range_opt s with + | Some rg -> Npm_version.string_of_range rg + | None -> "invalid" + in if got <> exp then ( Printf.printf "FAIL parse_range %S = %S, want %S\n" s got exp; incr fail) @@ -112,6 +116,28 @@ let () = rng "1.2 - 2.3.4" ">=1.2.0 <=2.3.4"; rng "1.2.3 - 2.3" ">=1.2.3 <2.4.0"; rng "1.2.3 - 2" ">=1.2.3 <3.0.0"; + (* the [v=]* semver allows before a version, a hyphen range's ends + included; its v is lowercase only *) + rng "v1.2.3 - v2.3.4" ">=1.2.3 <=2.3.4"; + rng "=1.2.3 - v2" ">=1.2.3 <3.0.0"; + rng ">==v1.2.3" ">=1.2.3"; + rng "V1.2.3" "invalid"; + rng "^V1.2.3" "invalid"; + (* a comparator no grammar reads is thrown out of its set, and a set left + empty out of the range; a range with none left is no range, which npa + reads as a dist-tag *) + rng "beta2" "invalid"; + rng "next-11" "invalid"; + rng "ts4.9" "invalid"; + rng "latest" "invalid"; + rng "1.2.3 beta2" "=1.2.3"; + rng "beta2 || ^1" ">=1.0.0 <2.0.0"; + rng "1.2.3 - beta" "=1.2.3"; + rng "1.2+build.1" ">=1.2.0 <1.3.0"; + rng "1.2.3.4" "invalid"; + rng "1.2foo" "invalid"; + rng ">" "invalid"; + rng "|| 1.2.3" "* || =1.2.3"; (* satisfaction, and the prerelease rule: a prerelease is admitted only by a comparator set that names one at the same release core *) diff --git a/test/frontends/npm.t/digtag.json b/test/frontends/npm.t/digtag.json new file mode 100644 index 0000000..6f3b5e6 --- /dev/null +++ b/test/frontends/npm.t/digtag.json @@ -0,0 +1,4 @@ +{"name":"digtag","dist-tags":{"latest":"2.0.0","beta2":"1.0.0"}, + "versions":{ + "1.0.0":{"name":"digtag","version":"1.0.0"}, + "2.0.0":{"name":"digtag","version":"2.0.0"}}} diff --git a/test/frontends/npm.t/run.t b/test/frontends/npm.t/run.t index 85578a3..7ebf218 100644 --- a/test/frontends/npm.t/run.t +++ b/test/frontends/npm.t/run.t @@ -763,6 +763,42 @@ nothing, so alpha, whose optional entry asks for nosuch, is abandoned: encoded solution: 3 core nodes (6 lookups) loaded: 3 names, 4 versions, 0 packuments fetched, 1 of 1 optionalDependencies (target, range) pairs dropped +A spec is a range where semver, reading loosely, finds one, and a dist-tag +otherwise, as npa reads it; nothing unread becomes *. spec-app's +devprod is a hyphen range between v-prefixed versions, 1.0.0 to 1.9.0; +digtag's beta2 is no range, so it is the tag, and 1.0.0 rather than the +latest 2.0.0; and kit is an alias however its prefix is cased, so it holds +util-lib 1.0.0. A peer or an override that is an alias puts another +package under the name, which a peer's range and an override's cannot +say, so both are dropped and counted: + + $ ../../../bin/main.exe npm --offline --cache . ./spec-app/package.json | sed -E '/^(parse|solve) [0-9.]+s$/d' + root spec-app 1.0.0 + packages (4): + devprod 1.0.0 + digtag 1.0.0 + util-lib 1.0.0 at kit + spec-app 1.0.0 + encoded solution: 7 core nodes (14 lookups) + loaded: 4 names, 7 versions, 0 packuments fetched + parser dropped 2 declarations + +The same on the command line, where the alias prefix is cased as npa +allows and a spec that is neither a range nor a name a tag may have is +refused: + + $ ../../../bin/main.exe npm --offline --cache . kit@NPM:util-lib@1.0.0 digtag@beta2 | sed -E '/^(parse|solve) [0-9.]+s$/d' + root . + packages (3): + . + digtag 1.0.0 + util-lib 1.0.0 at kit + encoded solution: 5 core nodes (10 lookups) + loaded: 3 names, 5 versions, 0 packuments fetched + $ ../../../bin/main.exe npm --offline --cache . 'digtag@^beta' + error: digtag@^beta: not a registry spec (name, name@range, name@tag, key@npm:name@range) + [2] + The cases from here to the fetch race pin where we deliberately differ from npm; each states npm's answer, taken from npm 11.17.0 over the same fixtures. @@ -1013,3 +1049,23 @@ and with it unreachable, or failing, there is no answer at all. [3] $ ls partial plugin.json + +A packument that does not parse says no more about the name's versions, +so it stops the run with status 3 too, whether it is fetched, when it is +not cached, or already in the cache: + + $ mkdir junk corrupt + $ printf '#!/bin/sh\nwhile [ $# -gt 0 ]; do case $1 in -o) o=$2; shift;; esac; shift; done\nprintf "" > "$o"; printf 200\n' > junk/curl + $ chmod +x junk/curl + $ PATH=$PWD/junk:$PATH ../../../bin/main.exe npm --cache partial plugin + root . + error: fetching https://registry.npmjs.org/core: not a packument + [3] + $ ls partial + plugin.json + $ cp plugin.json corrupt/ + $ printf '' > corrupt/core.json + $ ../../../bin/main.exe npm --offline --cache corrupt plugin + root . + error: reading corrupt/core.json: not a packument + [3] diff --git a/test/frontends/npm.t/spec-app/package.json b/test/frontends/npm.t/spec-app/package.json new file mode 100644 index 0000000..9363666 --- /dev/null +++ b/test/frontends/npm.t/spec-app/package.json @@ -0,0 +1,15 @@ +{ + "name": "spec-app", + "version": "1.0.0", + "dependencies": { + "devprod": "v1.0.0 - v1.9.0", + "digtag": "beta2", + "kit": "NPM:util-lib@1.0.0" + }, + "peerDependencies": { + "theme": "npm:theme@^1" + }, + "overrides": { + "tok": "npm:mark@3.0.2" + } +} -- 2.51.2