From 8beedadc021557c93e33076e7f1cbe1f33ea0d5b Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sun, 22 Mar 2026 15:31:48 +0100 Subject: [PATCH 1/5] Migrate from mdx to mdexp for documentation testing Replace the mdx-based documentation testing with mdexp. Convert both doc files (path-normalization and migration-0.4.0) to mdexp .ml files with inline expect tests that verify the documented behavior and generate the markdown output. Co-Authored-By: Claude Opus 4.6 (1M context) --- doc/explanation/dune | 36 ++++- doc/explanation/path-normalization.md | 57 ++++---- doc/explanation/path_normalization.ml | 121 +++++++++++++++++ doc/explanation/path_normalization.mli | 5 + doc/explanation/prelude.txt | 2 - doc/guides/dune | 36 ++++- doc/guides/migration-0.4.0.md | 77 ++++------- doc/guides/migration_0_4_0.ml | 179 +++++++++++++++++++++++++ doc/guides/migration_0_4_0.mli | 5 + doc/guides/prelude.txt | 2 - dune-project | 4 - fpath-base-dev.opam | 1 - 12 files changed, 428 insertions(+), 97 deletions(-) create mode 100644 doc/explanation/path_normalization.ml create mode 100644 doc/explanation/path_normalization.mli delete mode 100644 doc/explanation/prelude.txt create mode 100644 doc/guides/migration_0_4_0.ml create mode 100644 doc/guides/migration_0_4_0.mli delete mode 100644 doc/guides/prelude.txt diff --git a/doc/explanation/dune b/doc/explanation/dune index 5403375..2c6bedf 100644 --- a/doc/explanation/dune +++ b/doc/explanation/dune @@ -3,8 +3,36 @@ (env-vars (OCAMLRUNPARAM b=0)))) -(mdx +(library + (name path_normalization) (package fpath-base-dev) - (deps - (package fpath-sexp0)) - (preludes prelude.txt)) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Fpath_sexp0) + (libraries fpath fpath_sexp0) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess + (pps ppx_expect))) + +(rule + (target path-normalization.md.gen) + (deps path_normalization.ml) + (action + (with-stdout-to + %{target} + (run mdexp pp %{deps})))) + +(rule + (package fpath-base-dev) + (alias runtest) + (action + (diff path-normalization.md path-normalization.md.gen))) diff --git a/doc/explanation/path-normalization.md b/doc/explanation/path-normalization.md index 6b5856d..5f556b3 100644 --- a/doc/explanation/path-normalization.md +++ b/doc/explanation/path-normalization.md @@ -2,63 +2,57 @@ ## Overview -Starting in version 0.4.0, `Relative_path.t` rejects paths that escape above their starting point. +Starting in version 0.4.0, `Relative_path.t` rejects paths that escape +above their starting point. **The process:** -1. Paths are normalized using `Fpath.normalize` (resolves `.` and `..` segments) -2. If the normalized path has leading `..` segments, it's rejected by `Relative_path.t` +1. Paths are normalized using `Fpath.normalize` (resolves `.` and `..` +segments) +2. If the normalized path has leading `..` segments, it's rejected by +`Relative_path.t` ## What Gets Rejected Paths that escape above their starting point: ```ocaml -# Relative_path.v ".." ;; -Exception: -Invalid_argument "Relative_path.v: path \"..\" escapes above starting point". -# Relative_path.v "../config" ;; -Exception: -Invalid_argument - "Relative_path.v: path \"../config\" escapes above starting point". -# Relative_path.v "a/../.." ;; -Exception: -Invalid_argument - "Relative_path.v: path \"a/../..\" escapes above starting point". +Relative_path.v ".." +=> Error: path ".." escapes above starting point + +Relative_path.v "../config" +=> Error: path "../config" escapes above starting point + +Relative_path.v "a/../.." +=> Error: path "a/../.." escapes above starting point ``` Paths that stay within bounds are accepted: ```ocaml -# Relative_path.to_string (Relative_path.v "a/..") ;; -- : string = "./" -# Relative_path.to_string (Relative_path.v "a/b/../c") ;; -- : string = "a/c" +Relative_path.v "a/.." => "./" +Relative_path.v "a/b/../c" => "a/c" ``` ## Why This Matters ### Prevents Memory Growth -Before v0.4.0, calling `parent` repeatedly could grow memory unboundedly: - - -```ocaml -(* Before: Starting from "./" *) -parent "./" (* -> "../" *) -parent "../" (* -> "../../" *) -parent "../../" (* -> "../../../" ... forever *) -``` +Before v0.4.0, calling `parent` repeatedly could grow memory unboundedly. +Starting from `"./"`: +- `parent "./"` returned `"../"` +- `parent "../"` returned `"../../"` +- `parent "../../"` returned `"../../../"` — and so on forever After v0.4.0: ```ocaml -# Relative_path.parent Relative_path.empty ;; -- : Relative_path.t option = None +Relative_path.parent Relative_path.empty => None ``` ### Type Safety Guarantee -`Relative_path.t` now guarantees the path won't escape above its starting point, making it safe for: +`Relative_path.t` now guarantees the path won't escape above its starting +point, making it safe for: - Sandbox operations (can't escape sandbox root) - Archive extraction (can't write outside target directory) - Path concatenation (stays within base directory) @@ -68,8 +62,7 @@ After v0.4.0: If you need paths with leading `..` segments, use `Fpath.t` directly: ```ocaml -# let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize ;; -val path : Fpath.t = +let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize ``` ## Type Selection Guide diff --git a/doc/explanation/path_normalization.ml b/doc/explanation/path_normalization.ml new file mode 100644 index 0000000..11ea659 --- /dev/null +++ b/doc/explanation/path_normalization.ml @@ -0,0 +1,121 @@ +(*********************************************************************************) +(* fpath-base: Extending [Fpath] to use alongside [Sexplib0] and/or [Base] *) +(* SPDX-FileCopyrightText: 2023-2025 Mathieu Barbin *) +(* SPDX-License-Identifier: MIT *) +(*********************************************************************************) + +(* @mdexp + + # Path Normalization and Escaping Prevention + + ## Overview + + Starting in version 0.4.0, `Relative_path.t` rejects paths that escape + above their starting point. + + **The process:** + 1. Paths are normalized using `Fpath.normalize` (resolves `.` and `..` + segments) + 2. If the normalized path has leading `..` segments, it's rejected by + `Relative_path.t` + + ## What Gets Rejected + + Paths that escape above their starting point: *) + +let%expect_test "rejected paths" = + let show str = + Printf.printf "Relative_path.v %S\n" str; + match Relative_path.of_string str with + | Ok _ -> print_endline "=> Ok" + | Error (`Msg msg) -> Printf.printf "=> Error: %s\n\n" msg + in + show ".."; + show "../config"; + show "a/../.."; + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect + {| + Relative_path.v ".." + => Error: path ".." escapes above starting point + + Relative_path.v "../config" + => Error: path "../config" escapes above starting point + + Relative_path.v "a/../.." + => Error: path "a/../.." escapes above starting point + |}] +;; + +(* @mdexp + + Paths that stay within bounds are accepted: *) + +let%expect_test "accepted paths" = + let show str = + Printf.printf + "Relative_path.v %S => %S\n" + str + (Relative_path.to_string (Relative_path.v str)) + in + show "a/.."; + show "a/b/../c"; + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect + {| + Relative_path.v "a/.." => "./" + Relative_path.v "a/b/../c" => "a/c" + |}] +;; + +(* @mdexp + + ## Why This Matters + + ### Prevents Memory Growth + + Before v0.4.0, calling `parent` repeatedly could grow memory unboundedly. + Starting from `"./"`: + - `parent "./"` returned `"../"` + - `parent "../"` returned `"../../"` + - `parent "../../"` returned `"../../../"` — and so on forever + + After v0.4.0: *) + +let%expect_test "parent of empty" = + Printf.printf + "Relative_path.parent Relative_path.empty => %s\n" + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some p -> Printf.sprintf "Some %S" (Relative_path.to_string p)); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect {| Relative_path.parent Relative_path.empty => None |}] +;; + +(* @mdexp + + ### Type Safety Guarantee + + `Relative_path.t` now guarantees the path won't escape above its starting + point, making it safe for: + - Sandbox operations (can't escape sandbox root) + - Archive extraction (can't write outside target directory) + - Path concatenation (stays within base directory) + + ## When You Need Escaping Paths + + If you need paths with leading `..` segments, use `Fpath.t` directly: + + ```ocaml + let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize + ``` + + ## Type Selection Guide + + ``` + Does the path escape above its starting point (has leading ".." after normalization)? + ├─ YES → Use Fpath.t + └─ NO → Does it start from filesystem root? + ├─ YES → Use Absolute_path.t + └─ NO → Use Relative_path.t + ``` *) diff --git a/doc/explanation/path_normalization.mli b/doc/explanation/path_normalization.mli new file mode 100644 index 0000000..9b18179 --- /dev/null +++ b/doc/explanation/path_normalization.mli @@ -0,0 +1,5 @@ +(*_********************************************************************************) +(*_ fpath-base: Extending [Fpath] to use alongside [Sexplib0] and/or [Base] *) +(*_ SPDX-FileCopyrightText: 2023-2025 Mathieu Barbin *) +(*_ SPDX-License-Identifier: MIT *) +(*_********************************************************************************) diff --git a/doc/explanation/prelude.txt b/doc/explanation/prelude.txt deleted file mode 100644 index b0e1657..0000000 --- a/doc/explanation/prelude.txt +++ /dev/null @@ -1,2 +0,0 @@ -#require "fpath-sexp0" ;; -open Fpath_sexp0 ;; diff --git a/doc/guides/dune b/doc/guides/dune index 5403375..95e3596 100644 --- a/doc/guides/dune +++ b/doc/guides/dune @@ -3,8 +3,36 @@ (env-vars (OCAMLRUNPARAM b=0)))) -(mdx +(library + (name migration_0_4_0) (package fpath-base-dev) - (deps - (package fpath-sexp0)) - (preludes prelude.txt)) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Fpath_sexp0) + (libraries fpath fpath_sexp0) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess + (pps ppx_expect))) + +(rule + (target migration-0.4.0.md.gen) + (deps migration_0_4_0.ml) + (action + (with-stdout-to + %{target} + (run mdexp pp %{deps})))) + +(rule + (package fpath-base-dev) + (alias runtest) + (action + (diff migration-0.4.0.md migration-0.4.0.md.gen))) diff --git a/doc/guides/migration-0.4.0.md b/doc/guides/migration-0.4.0.md index c3f4cd1..0be7f6b 100644 --- a/doc/guides/migration-0.4.0.md +++ b/doc/guides/migration-0.4.0.md @@ -2,33 +2,33 @@ ## Summary -Version 0.4.0 makes `Relative_path.t` reject paths that escape above their starting point (paths with leading `..` segments after normalization). +Version 0.4.0 makes `Relative_path.t` reject paths that escape above their +starting point (paths with leading `..` segments after normalization). ## Breaking Changes ### Construction Functions -All construction functions (`v`, `of_string`, `of_fpath`) now reject escaping paths: +All construction functions (`v`, `of_string`, `of_fpath`) now reject +escaping paths: ```ocaml -# Relative_path.v "../config" ;; -Exception: -Invalid_argument - "Relative_path.v: path \"../config\" escapes above starting point". +Relative_path.v "../config" raises: +Invalid_argument "Relative_path.v: path \"../config\" escapes above starting point" ``` **Migration options:** Use `Absolute_path.t` for explicit paths: + ```ocaml -# let path = Absolute_path.v "/path/to/parent/config" ;; -val path : Absolute_path.t = +let path = Absolute_path.v "/path/to/parent/config" ``` Or use `Fpath.t` for paths that may escape: + ```ocaml -# let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize ;; -val path : Fpath.t = +let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize ``` ### Parent Function @@ -36,20 +36,13 @@ val path : Fpath.t = Returns `None` for the empty path (previously returned `"../"`): ```ocaml -# Relative_path.parent Relative_path.empty ;; -- : Relative_path.t option = None +Relative_path.parent Relative_path.empty => None ``` This fixes infinite loops in upward navigation: ```ocaml -# let rec navigate_to_root path = - match Relative_path.parent path with - | None -> path - | Some p -> navigate_to_root p ;; -val navigate_to_root : Relative_path.t -> Relative_path.t = -# Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c")) ;; -- : string = "./" +navigate_to_root (Relative_path.v "a/b/c") => "./" ``` ### Extend Function @@ -57,10 +50,8 @@ val navigate_to_root : Relative_path.t -> Relative_path.t = Raises `Invalid_argument` if extending creates an escaping path: ```ocaml -# Relative_path.extend Relative_path.empty (Fsegment.v "..") ;; -Exception: -Invalid_argument - "Relative_path.extend: path \"./..\" escapes above starting point". +Relative_path.extend Relative_path.empty (Fsegment.v "..") raises: +Invalid_argument "Relative_path.extend: path \"./..\" escapes above starting point" ``` **Migration:** Use `Fpath.t` if segments might create escaping paths. @@ -70,10 +61,7 @@ Invalid_argument Empty prefix/suffix now returns `Some path` (previously `None`): ```ocaml -# match Relative_path.chop_prefix (Relative_path.v "foo/bar") ~prefix:Relative_path.empty with - | None -> "no match" - | Some p -> Relative_path.to_string p ;; -- : string = "foo/bar" +chop_prefix (Relative_path.v "foo/bar") ~prefix:empty => "foo/bar" ``` ## Common Migration Patterns @@ -83,13 +71,7 @@ Empty prefix/suffix now returns `Some path` (previously `None`): Validate paths and handle rejections: ```ocaml -# let load_relative_file filename = - match Relative_path.of_string filename with - | Error (`Msg err) -> Error err - | Ok path -> Ok path ;; -val load_relative_file : string -> (Relative_path.t, string) result = -# load_relative_file "config/settings.conf" ;; -- : (Relative_path.t, string) result = Ok +load_relative_file "config/settings.conf" => Ok "config/settings.conf" ``` ### Upward Navigation @@ -97,23 +79,22 @@ val load_relative_file : string -> (Relative_path.t, string) result = Use absolute paths for upward traversal: ```ocaml -# let find_project_root has_marker current_path = - let rec search path = - if has_marker path then Some path - else - match Absolute_path.parent path with - | None -> None - | Some parent -> search parent - in - search current_path ;; -val find_project_root : - (Absolute_path.t -> bool) -> Absolute_path.t -> Absolute_path.t option = - +let find_project_root has_marker current_path = + let rec search path = + if has_marker path then Some path + else + match Absolute_path.parent path with + | None -> None + | Some parent -> search parent + in + search current_path ``` ## Why These Changes 1. **Improve type safety** - `Relative_path.t` guarantees non-escaping -2. **Less error-prone APIs** for sandbox operations and recursive parent traversal +2. **Less error-prone APIs** for sandbox operations and recursive parent +traversal -See [Path Normalization](../explanation/path-normalization.md) for more details. +See [Path Normalization](../explanation/path-normalization.md) for more +details. diff --git a/doc/guides/migration_0_4_0.ml b/doc/guides/migration_0_4_0.ml new file mode 100644 index 0000000..e1df7d2 --- /dev/null +++ b/doc/guides/migration_0_4_0.ml @@ -0,0 +1,179 @@ +(*********************************************************************************) +(* fpath-base: Extending [Fpath] to use alongside [Sexplib0] and/or [Base] *) +(* SPDX-FileCopyrightText: 2023-2025 Mathieu Barbin *) +(* SPDX-License-Identifier: MIT *) +(*********************************************************************************) + +(* @mdexp + + # Migration Guide: Version 0.4.0 + + ## Summary + + Version 0.4.0 makes `Relative_path.t` reject paths that escape above their + starting point (paths with leading `..` segments after normalization). + + ## Breaking Changes + + ### Construction Functions + + All construction functions (`v`, `of_string`, `of_fpath`) now reject + escaping paths: *) + +let%expect_test "construction rejects escaping" = + (try ignore (Relative_path.v "../config" : Relative_path.t) with + | Invalid_argument msg -> + Printf.printf "Relative_path.v \"../config\" raises:\nInvalid_argument %S\n" msg); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect + {| + Relative_path.v "../config" raises: + Invalid_argument "Relative_path.v: path \"../config\" escapes above starting point" + |}] +;; + +(* @mdexp + + **Migration options:** + + Use `Absolute_path.t` for explicit paths: + + ```ocaml + let path = Absolute_path.v "/path/to/parent/config" + ``` + + Or use `Fpath.t` for paths that may escape: + + ```ocaml + let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize + ``` + + ### Parent Function + + Returns `None` for the empty path (previously returned `"../"`): *) + +let%expect_test "parent of empty" = + Printf.printf + "Relative_path.parent Relative_path.empty => %s\n" + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some p -> Printf.sprintf "Some %S" (Relative_path.to_string p)); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect {| Relative_path.parent Relative_path.empty => None |}] +;; + +(* @mdexp + + This fixes infinite loops in upward navigation: *) + +let%expect_test "navigate to root" = + let rec navigate_to_root path = + match Relative_path.parent path with + | None -> path + | Some p -> navigate_to_root p + in + Printf.printf + "navigate_to_root (Relative_path.v \"a/b/c\") => %S\n" + (Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c"))); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect {| navigate_to_root (Relative_path.v "a/b/c") => "./" |}] +;; + +(* @mdexp + + ### Extend Function + + Raises `Invalid_argument` if extending creates an escaping path: *) + +let%expect_test "extend rejects escaping" = + (try + ignore (Relative_path.extend Relative_path.empty (Fsegment.v "..") : Relative_path.t) + with + | Invalid_argument msg -> + Printf.printf + "Relative_path.extend Relative_path.empty (Fsegment.v \"..\") raises:\n\ + Invalid_argument %S\n" + msg); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect + {| + Relative_path.extend Relative_path.empty (Fsegment.v "..") raises: + Invalid_argument "Relative_path.extend: path \"./..\" escapes above starting point" + |}] +;; + +(* @mdexp + + **Migration:** Use `Fpath.t` if segments might create escaping paths. + + ### Chop Prefix/Suffix + + Empty prefix/suffix now returns `Some path` (previously `None`): *) + +let%expect_test "chop prefix with empty" = + let result = + match + Relative_path.chop_prefix (Relative_path.v "foo/bar") ~prefix:Relative_path.empty + with + | None -> "no match" + | Some p -> Relative_path.to_string p + in + Printf.printf "chop_prefix (Relative_path.v \"foo/bar\") ~prefix:empty => %S\n" result; + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect {| chop_prefix (Relative_path.v "foo/bar") ~prefix:empty => "foo/bar" |}] +;; + +(* @mdexp + + ## Common Migration Patterns + + ### Dynamic Path Construction + + Validate paths and handle rejections: *) + +let%expect_test "dynamic path construction" = + let load_relative_file filename = + match Relative_path.of_string filename with + | Error (`Msg err) -> Error err + | Ok path -> Ok path + in + (match load_relative_file "config/settings.conf" with + | Ok p -> + Printf.printf + "load_relative_file \"config/settings.conf\" => Ok %S\n" + (Relative_path.to_string p) + | Error err -> + Printf.printf "load_relative_file \"config/settings.conf\" => Error %S\n" err); + (* @mdexp.snapshot { lang: "ocaml" } *) + [%expect + {| + load_relative_file "config/settings.conf" => Ok "config/settings.conf" + |}] +;; + +(* @mdexp + + ### Upward Navigation + + Use absolute paths for upward traversal: + + ```ocaml + let find_project_root has_marker current_path = + let rec search path = + if has_marker path then Some path + else + match Absolute_path.parent path with + | None -> None + | Some parent -> search parent + in + search current_path + ``` + + ## Why These Changes + + 1. **Improve type safety** - `Relative_path.t` guarantees non-escaping + 2. **Less error-prone APIs** for sandbox operations and recursive parent + traversal + + See [Path Normalization](../explanation/path-normalization.md) for more + details. *) diff --git a/doc/guides/migration_0_4_0.mli b/doc/guides/migration_0_4_0.mli new file mode 100644 index 0000000..9b18179 --- /dev/null +++ b/doc/guides/migration_0_4_0.mli @@ -0,0 +1,5 @@ +(*_********************************************************************************) +(*_ fpath-base: Extending [Fpath] to use alongside [Sexplib0] and/or [Base] *) +(*_ SPDX-FileCopyrightText: 2023-2025 Mathieu Barbin *) +(*_ SPDX-License-Identifier: MIT *) +(*_********************************************************************************) diff --git a/doc/guides/prelude.txt b/doc/guides/prelude.txt deleted file mode 100644 index b0e1657..0000000 --- a/doc/guides/prelude.txt +++ /dev/null @@ -1,2 +0,0 @@ -#require "fpath-sexp0" ;; -open Fpath_sexp0 ;; diff --git a/dune-project b/dune-project index e6955a1..b4de86a 100644 --- a/dune-project +++ b/dune-project @@ -15,8 +15,6 @@ (documentation "https://mbarbin.github.io/fpath-base/") -(using mdx 0.4) - ;; The value for the [implicit_transitive_deps] option is set during the CI ;; depending on the OCaml compiler version. ;; @@ -106,8 +104,6 @@ (= :version)) (fpath-sexp0 (= :version)) - (mdx - (>= 2.4)) (ppx_js_style (>= v0.17)) (ppxlib diff --git a/fpath-base-dev.opam b/fpath-base-dev.opam index e72d110..45ca106 100644 --- a/fpath-base-dev.opam +++ b/fpath-base-dev.opam @@ -17,7 +17,6 @@ depends: [ "fpath-base" {= version} "fpath-base-tests" {= version} "fpath-sexp0" {= version} - "mdx" {>= "2.4"} "ppx_js_style" {>= "v0.17"} "ppxlib" {>= "0.33"} "sherlodoc" {>= "0.2"} From 772bf60552c1afc40a2f2225e59d4b05e4eef43e Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 25 Mar 2026 09:06:26 +0100 Subject: [PATCH 2/5] Add rule to setup mdexp --- .github/workflows/ci.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 509b751..903c7a7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -31,6 +31,12 @@ jobs: - name: Checkout code uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2 + - name: Setup mdexp + uses: mbarbin/mdexp-actions/setup-mdexp@42da13e622de9559da363ef5906ffde63a982efd # v1.0.0-alpha.1 + with: + mdexp-version: 0.0.20260315 + mdexp-digest: sha256:f4fc53bcaa50c9dd979b968804c38322b9b7e6aa699d9d6d2d1f101965332018 + - name: Environment setup run: | echo "DUNE_WORKSPACE=$PWD/dune-workspace-${{ matrix.ocaml-version }}" >> "$GITHUB_ENV" From e36af92bbe1d7c327b642de472287fb7653a2684 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 25 Mar 2026 09:06:40 +0100 Subject: [PATCH 3/5] mdexp rule in fpath-base-dev pkg --- doc/explanation/dune | 1 + doc/guides/dune | 1 + 2 files changed, 2 insertions(+) diff --git a/doc/explanation/dune b/doc/explanation/dune index 2c6bedf..553cb0b 100644 --- a/doc/explanation/dune +++ b/doc/explanation/dune @@ -25,6 +25,7 @@ (rule (target path-normalization.md.gen) + (package fpath-base-dev) (deps path_normalization.ml) (action (with-stdout-to diff --git a/doc/guides/dune b/doc/guides/dune index 95e3596..85b5e4b 100644 --- a/doc/guides/dune +++ b/doc/guides/dune @@ -25,6 +25,7 @@ (rule (target migration-0.4.0.md.gen) + (package fpath-base-dev) (deps migration_0_4_0.ml) (action (with-stdout-to From 807e4cbce2445bf85dd06643a79649a0e96eeb57 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 25 Mar 2026 09:15:04 +0100 Subject: [PATCH 4/5] Remove not needed runtime env var --- doc/explanation/dune | 5 ----- doc/guides/dune | 5 ----- 2 files changed, 10 deletions(-) diff --git a/doc/explanation/dune b/doc/explanation/dune index 553cb0b..2612218 100644 --- a/doc/explanation/dune +++ b/doc/explanation/dune @@ -1,8 +1,3 @@ -(env - (_ - (env-vars - (OCAMLRUNPARAM b=0)))) - (library (name path_normalization) (package fpath-base-dev) diff --git a/doc/guides/dune b/doc/guides/dune index 85b5e4b..62e5eb7 100644 --- a/doc/guides/dune +++ b/doc/guides/dune @@ -1,8 +1,3 @@ -(env - (_ - (env-vars - (OCAMLRUNPARAM b=0)))) - (library (name migration_0_4_0) (package fpath-base-dev) From 25a11310b48bbb8f0ad77de95d15e5420652ecfe Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 25 Mar 2026 10:07:30 +0100 Subject: [PATCH 5/5] Improve mdexp documents --- doc/explanation/path-normalization.md | 44 +++++--- doc/explanation/path_normalization.ml | 81 ++++++--------- doc/guides/migration-0.4.0.md | 70 ++++++++++--- doc/guides/migration_0_4_0.ml | 142 ++++++++++++-------------- 4 files changed, 187 insertions(+), 150 deletions(-) diff --git a/doc/explanation/path-normalization.md b/doc/explanation/path-normalization.md index 5f556b3..1caeffe 100644 --- a/doc/explanation/path-normalization.md +++ b/doc/explanation/path-normalization.md @@ -13,24 +13,36 @@ segments) ## What Gets Rejected -Paths that escape above their starting point: - ```ocaml -Relative_path.v ".." -=> Error: path ".." escapes above starting point +let test s = + match Relative_path.of_string s with + | Ok p -> Printf.printf "%s => Ok %s\n" s (Relative_path.to_string p) + | Error (`Msg m) -> Printf.printf "%s => Error: %s\n" s m +;; +``` -Relative_path.v "../config" -=> Error: path "../config" escapes above starting point +Paths that escape above their starting point: -Relative_path.v "a/../.." -=> Error: path "a/../.." escapes above starting point +```ocaml +let%expect_test "escaping paths are rejected" = + test ".."; + [%expect {| .. => Error: path ".." escapes above starting point |}]; + test "../config"; + [%expect {| ../config => Error: path "../config" escapes above starting point |}]; + test "a/../.."; + [%expect {| a/../.. => Error: path "a/../.." escapes above starting point |}] +;; ``` -Paths that stay within bounds are accepted: +Paths that stay within bounds are accepted and normalized: ```ocaml -Relative_path.v "a/.." => "./" -Relative_path.v "a/b/../c" => "a/c" +let%expect_test "non-escaping paths are normalized" = + test "a/.."; + [%expect {| a/.. => Ok ./ |}]; + test "a/b/../c"; + [%expect {| a/b/../c => Ok a/c |}] +;; ``` ## Why This Matters @@ -43,10 +55,16 @@ Starting from `"./"`: - `parent "../"` returned `"../../"` - `parent "../../"` returned `"../../../"` — and so on forever -After v0.4.0: +After v0.4.0, `parent` returns `None` when there's nothing left: ```ocaml -Relative_path.parent Relative_path.empty => None +let%expect_test "parent stops at root" = + print_string + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some _ -> assert false); + [%expect {| None |}] +;; ``` ### Type Safety Guarantee diff --git a/doc/explanation/path_normalization.ml b/doc/explanation/path_normalization.ml index 11ea659..2c89c82 100644 --- a/doc/explanation/path_normalization.ml +++ b/doc/explanation/path_normalization.ml @@ -21,51 +21,37 @@ ## What Gets Rejected - Paths that escape above their starting point: *) - -let%expect_test "rejected paths" = - let show str = - Printf.printf "Relative_path.v %S\n" str; - match Relative_path.of_string str with - | Ok _ -> print_endline "=> Ok" - | Error (`Msg msg) -> Printf.printf "=> Error: %s\n\n" msg - in - show ".."; - show "../config"; - show "a/../.."; - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect - {| - Relative_path.v ".." - => Error: path ".." escapes above starting point - - Relative_path.v "../config" - => Error: path "../config" escapes above starting point - - Relative_path.v "a/../.." - => Error: path "a/../.." escapes above starting point - |}] + @mdexp.code *) +let test s = + match Relative_path.of_string s with + | Ok p -> Printf.printf "%s => Ok %s\n" s (Relative_path.to_string p) + | Error (`Msg m) -> Printf.printf "%s => Error: %s\n" s m ;; (* @mdexp - Paths that stay within bounds are accepted: *) - -let%expect_test "accepted paths" = - let show str = - Printf.printf - "Relative_path.v %S => %S\n" - str - (Relative_path.to_string (Relative_path.v str)) - in - show "a/.."; - show "a/b/../c"; - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect - {| - Relative_path.v "a/.." => "./" - Relative_path.v "a/b/../c" => "a/c" - |}] + Paths that escape above their starting point: + + @mdexp.code *) +let%expect_test "escaping paths are rejected" = + test ".."; + [%expect {| .. => Error: path ".." escapes above starting point |}]; + test "../config"; + [%expect {| ../config => Error: path "../config" escapes above starting point |}]; + test "a/../.."; + [%expect {| a/../.. => Error: path "a/../.." escapes above starting point |}] +;; + +(* @mdexp + + Paths that stay within bounds are accepted and normalized: + + @mdexp.code *) +let%expect_test "non-escaping paths are normalized" = + test "a/.."; + [%expect {| a/.. => Ok ./ |}]; + test "a/b/../c"; + [%expect {| a/b/../c => Ok a/c |}] ;; (* @mdexp @@ -80,16 +66,15 @@ let%expect_test "accepted paths" = - `parent "../"` returned `"../../"` - `parent "../../"` returned `"../../../"` — and so on forever - After v0.4.0: *) + After v0.4.0, `parent` returns `None` when there's nothing left: -let%expect_test "parent of empty" = - Printf.printf - "Relative_path.parent Relative_path.empty => %s\n" + @mdexp.code *) +let%expect_test "parent stops at root" = + print_string (match Relative_path.parent Relative_path.empty with | None -> "None" - | Some p -> Printf.sprintf "Some %S" (Relative_path.to_string p)); - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect {| Relative_path.parent Relative_path.empty => None |}] + | Some _ -> assert false); + [%expect {| None |}] ;; (* @mdexp diff --git a/doc/guides/migration-0.4.0.md b/doc/guides/migration-0.4.0.md index 0be7f6b..b27220e 100644 --- a/doc/guides/migration-0.4.0.md +++ b/doc/guides/migration-0.4.0.md @@ -13,8 +13,12 @@ All construction functions (`v`, `of_string`, `of_fpath`) now reject escaping paths: ```ocaml -Relative_path.v "../config" raises: -Invalid_argument "Relative_path.v: path \"../config\" escapes above starting point" +let%expect_test "construction rejects escaping" = + (match Relative_path.v "../config" with + | (_ : Relative_path.t) -> assert false + | exception Invalid_argument msg -> print_endline msg); + [%expect {| Relative_path.v: path "../config" escapes above starting point |}] +;; ``` **Migration options:** @@ -36,13 +40,27 @@ let path : Fpath.t = Fpath.v "../config" |> Fpath.normalize Returns `None` for the empty path (previously returned `"../"`): ```ocaml -Relative_path.parent Relative_path.empty => None +let%expect_test "parent of empty" = + print_string + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some _ -> assert false); + [%expect {| None |}] +;; ``` This fixes infinite loops in upward navigation: ```ocaml -navigate_to_root (Relative_path.v "a/b/c") => "./" +let%expect_test "navigate to root" = + let rec navigate_to_root path = + match Relative_path.parent path with + | None -> path + | Some p -> navigate_to_root p + in + print_string (Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c"))); + [%expect {| ./ |}] +;; ``` ### Extend Function @@ -50,8 +68,12 @@ navigate_to_root (Relative_path.v "a/b/c") => "./" Raises `Invalid_argument` if extending creates an escaping path: ```ocaml -Relative_path.extend Relative_path.empty (Fsegment.v "..") raises: -Invalid_argument "Relative_path.extend: path \"./..\" escapes above starting point" +let%expect_test "extend rejects escaping" = + (match Relative_path.extend Relative_path.empty (Fsegment.v "..") with + | (_ : Relative_path.t) -> assert false + | exception Invalid_argument msg -> print_endline msg); + [%expect {| Relative_path.extend: path "./.." escapes above starting point |}] +;; ``` **Migration:** Use `Fpath.t` if segments might create escaping paths. @@ -61,7 +83,15 @@ Invalid_argument "Relative_path.extend: path \"./..\" escapes above starting poi Empty prefix/suffix now returns `Some path` (previously `None`): ```ocaml -chop_prefix (Relative_path.v "foo/bar") ~prefix:empty => "foo/bar" +let%expect_test "chop prefix with empty" = + print_string + (match + Relative_path.chop_prefix (Relative_path.v "foo/bar") ~prefix:Relative_path.empty + with + | None -> assert false + | Some p -> Relative_path.to_string p); + [%expect {| foo/bar |}] +;; ``` ## Common Migration Patterns @@ -71,7 +101,21 @@ chop_prefix (Relative_path.v "foo/bar") ~prefix:empty => "foo/bar" Validate paths and handle rejections: ```ocaml -load_relative_file "config/settings.conf" => Ok "config/settings.conf" +let try_load filename = + match Relative_path.of_string filename with + | Ok p -> Printf.printf "%s => Ok %s\n" filename (Relative_path.to_string p) + | Error (`Msg msg) -> Printf.printf "%s => Error: %s\n" filename msg +;; +``` + +```ocaml +let%expect_test "validate user input" = + try_load "config/settings.conf"; + [%expect {| config/settings.conf => Ok config/settings.conf |}]; + try_load "../../../etc/passwd"; + [%expect + {| ../../../etc/passwd => Error: path "../../../etc/passwd" escapes above starting point |}] +;; ``` ### Upward Navigation @@ -79,15 +123,17 @@ load_relative_file "config/settings.conf" => Ok "config/settings.conf" Use absolute paths for upward traversal: ```ocaml -let find_project_root has_marker current_path = +let find_project_root ~has_marker current_path = let rec search path = - if has_marker path then Some path - else + if has_marker path + then Some path + else ( match Absolute_path.parent path with | None -> None - | Some parent -> search parent + | Some parent -> search parent) in search current_path +;; ``` ## Why These Changes diff --git a/doc/guides/migration_0_4_0.ml b/doc/guides/migration_0_4_0.ml index e1df7d2..f957b6d 100644 --- a/doc/guides/migration_0_4_0.ml +++ b/doc/guides/migration_0_4_0.ml @@ -18,18 +18,14 @@ ### Construction Functions All construction functions (`v`, `of_string`, `of_fpath`) now reject - escaping paths: *) + escaping paths: + @mdexp.code *) let%expect_test "construction rejects escaping" = - (try ignore (Relative_path.v "../config" : Relative_path.t) with - | Invalid_argument msg -> - Printf.printf "Relative_path.v \"../config\" raises:\nInvalid_argument %S\n" msg); - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect - {| - Relative_path.v "../config" raises: - Invalid_argument "Relative_path.v: path \"../config\" escapes above starting point" - |}] + (match Relative_path.v "../config" with + | (_ : Relative_path.t) -> assert false + | exception Invalid_argument msg -> print_endline msg); + [%expect {| Relative_path.v: path "../config" escapes above starting point |}] ;; (* @mdexp @@ -50,56 +46,44 @@ let%expect_test "construction rejects escaping" = ### Parent Function - Returns `None` for the empty path (previously returned `"../"`): *) + Returns `None` for the empty path (previously returned `"../"`): + @mdexp.code *) let%expect_test "parent of empty" = - Printf.printf - "Relative_path.parent Relative_path.empty => %s\n" + print_string (match Relative_path.parent Relative_path.empty with | None -> "None" - | Some p -> Printf.sprintf "Some %S" (Relative_path.to_string p)); - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect {| Relative_path.parent Relative_path.empty => None |}] + | Some _ -> assert false); + [%expect {| None |}] ;; (* @mdexp - This fixes infinite loops in upward navigation: *) + This fixes infinite loops in upward navigation: + @mdexp.code *) let%expect_test "navigate to root" = let rec navigate_to_root path = match Relative_path.parent path with | None -> path | Some p -> navigate_to_root p in - Printf.printf - "navigate_to_root (Relative_path.v \"a/b/c\") => %S\n" - (Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c"))); - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect {| navigate_to_root (Relative_path.v "a/b/c") => "./" |}] + print_string (Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c"))); + [%expect {| ./ |}] ;; (* @mdexp ### Extend Function - Raises `Invalid_argument` if extending creates an escaping path: *) + Raises `Invalid_argument` if extending creates an escaping path: + @mdexp.code *) let%expect_test "extend rejects escaping" = - (try - ignore (Relative_path.extend Relative_path.empty (Fsegment.v "..") : Relative_path.t) - with - | Invalid_argument msg -> - Printf.printf - "Relative_path.extend Relative_path.empty (Fsegment.v \"..\") raises:\n\ - Invalid_argument %S\n" - msg); - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect - {| - Relative_path.extend Relative_path.empty (Fsegment.v "..") raises: - Invalid_argument "Relative_path.extend: path \"./..\" escapes above starting point" - |}] + (match Relative_path.extend Relative_path.empty (Fsegment.v "..") with + | (_ : Relative_path.t) -> assert false + | exception Invalid_argument msg -> print_endline msg); + [%expect {| Relative_path.extend: path "./.." escapes above starting point |}] ;; (* @mdexp @@ -108,19 +92,17 @@ let%expect_test "extend rejects escaping" = ### Chop Prefix/Suffix - Empty prefix/suffix now returns `Some path` (previously `None`): *) + Empty prefix/suffix now returns `Some path` (previously `None`): + @mdexp.code *) let%expect_test "chop prefix with empty" = - let result = - match - Relative_path.chop_prefix (Relative_path.v "foo/bar") ~prefix:Relative_path.empty - with - | None -> "no match" - | Some p -> Relative_path.to_string p - in - Printf.printf "chop_prefix (Relative_path.v \"foo/bar\") ~prefix:empty => %S\n" result; - (* @mdexp.snapshot { lang: "ocaml" } *) - [%expect {| chop_prefix (Relative_path.v "foo/bar") ~prefix:empty => "foo/bar" |}] + print_string + (match + Relative_path.chop_prefix (Relative_path.v "foo/bar") ~prefix:Relative_path.empty + with + | None -> assert false + | Some p -> Relative_path.to_string p); + [%expect {| foo/bar |}] ;; (* @mdexp @@ -129,26 +111,24 @@ let%expect_test "chop prefix with empty" = ### Dynamic Path Construction - Validate paths and handle rejections: *) + Validate paths and handle rejections: -let%expect_test "dynamic path construction" = - let load_relative_file filename = - match Relative_path.of_string filename with - | Error (`Msg err) -> Error err - | Ok path -> Ok path - in - (match load_relative_file "config/settings.conf" with - | Ok p -> - Printf.printf - "load_relative_file \"config/settings.conf\" => Ok %S\n" - (Relative_path.to_string p) - | Error err -> - Printf.printf "load_relative_file \"config/settings.conf\" => Error %S\n" err); - (* @mdexp.snapshot { lang: "ocaml" } *) + @mdexp.code *) +let try_load filename = + match Relative_path.of_string filename with + | Ok p -> Printf.printf "%s => Ok %s\n" filename (Relative_path.to_string p) + | Error (`Msg msg) -> Printf.printf "%s => Error: %s\n" filename msg +;; + +(* @mdexp.end *) + +(* @mdexp.code *) +let%expect_test "validate user input" = + try_load "config/settings.conf"; + [%expect {| config/settings.conf => Ok config/settings.conf |}]; + try_load "../../../etc/passwd"; [%expect - {| - load_relative_file "config/settings.conf" => Ok "config/settings.conf" - |}] + {| ../../../etc/passwd => Error: path "../../../etc/passwd" escapes above starting point |}] ;; (* @mdexp @@ -157,17 +137,25 @@ let%expect_test "dynamic path construction" = Use absolute paths for upward traversal: - ```ocaml - let find_project_root has_marker current_path = - let rec search path = - if has_marker path then Some path - else - match Absolute_path.parent path with - | None -> None - | Some parent -> search parent - in - search current_path - ``` + @mdexp.code *) + +let find_project_root ~has_marker current_path = + let rec search path = + if has_marker path + then Some path + else ( + match Absolute_path.parent path with + | None -> None + | Some parent -> search parent) + in + search current_path +;; + +(* @mdexp.end *) + +let _ = find_project_root + +(* @mdexp ## Why These Changes