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" diff --git a/doc/explanation/dune b/doc/explanation/dune index 5403375..2612218 100644 --- a/doc/explanation/dune +++ b/doc/explanation/dune @@ -1,10 +1,34 @@ -(env - (_ - (env-vars - (OCAMLRUNPARAM b=0)))) +(library + (name path_normalization) + (package fpath-base-dev) + (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) + (package fpath-base-dev) + (deps path_normalization.ml) + (action + (with-stdout-to + %{target} + (run mdexp pp %{deps})))) -(mdx +(rule (package fpath-base-dev) - (deps - (package fpath-sexp0)) - (preludes prelude.txt)) + (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..1caeffe 100644 --- a/doc/explanation/path-normalization.md +++ b/doc/explanation/path-normalization.md @@ -2,63 +2,75 @@ ## 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 +```ocaml +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 +;; +``` + 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". +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.to_string (Relative_path.v "a/..") ;; -- : string = "./" -# Relative_path.to_string (Relative_path.v "a/b/../c") ;; -- : string = "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 ### 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: +After v0.4.0, `parent` returns `None` when there's nothing left: ```ocaml -# Relative_path.parent Relative_path.empty ;; -- : Relative_path.t option = 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 -`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 +80,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..2c89c82 --- /dev/null +++ b/doc/explanation/path_normalization.ml @@ -0,0 +1,106 @@ +(*********************************************************************************) +(* 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 + + @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 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 + + ## 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, `parent` returns `None` when there's nothing left: + + @mdexp.code *) +let%expect_test "parent stops at root" = + print_string + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some _ -> assert false); + [%expect {| 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..62e5eb7 100644 --- a/doc/guides/dune +++ b/doc/guides/dune @@ -1,10 +1,34 @@ -(env - (_ - (env-vars - (OCAMLRUNPARAM b=0)))) +(library + (name migration_0_4_0) + (package fpath-base-dev) + (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) + (package fpath-base-dev) + (deps migration_0_4_0.ml) + (action + (with-stdout-to + %{target} + (run mdexp pp %{deps})))) -(mdx +(rule (package fpath-base-dev) - (deps - (package fpath-sexp0)) - (preludes prelude.txt)) + (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..b27220e 100644 --- a/doc/guides/migration-0.4.0.md +++ b/doc/guides/migration-0.4.0.md @@ -2,33 +2,37 @@ ## 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". +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:** 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 +40,27 @@ val path : Fpath.t = Returns `None` for the empty path (previously returned `"../"`): ```ocaml -# Relative_path.parent Relative_path.empty ;; -- : Relative_path.t option = 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 -# let rec navigate_to_root path = +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 ;; -val navigate_to_root : Relative_path.t -> Relative_path.t = -# Relative_path.to_string (navigate_to_root (Relative_path.v "a/b/c")) ;; -- : string = "./" + | 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 @@ -57,10 +68,12 @@ 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". +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. @@ -70,10 +83,15 @@ 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" +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 @@ -83,13 +101,21 @@ 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 +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 @@ -97,23 +123,24 @@ 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..f957b6d --- /dev/null +++ b/doc/guides/migration_0_4_0.ml @@ -0,0 +1,167 @@ +(*********************************************************************************) +(* 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: + + @mdexp.code *) +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 |}] +;; + +(* @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 `"../"`): + + @mdexp.code *) +let%expect_test "parent of empty" = + print_string + (match Relative_path.parent Relative_path.empty with + | None -> "None" + | Some _ -> assert false); + [%expect {| None |}] +;; + +(* @mdexp + + 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 + 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: + + @mdexp.code *) +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 |}] +;; + +(* @mdexp + + **Migration:** Use `Fpath.t` if segments might create escaping paths. + + ### Chop Prefix/Suffix + + Empty prefix/suffix now returns `Some path` (previously `None`): + + @mdexp.code *) +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 |}] +;; + +(* @mdexp + + ## Common Migration Patterns + + ### Dynamic Path Construction + + Validate paths and handle rejections: + + @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 + {| ../../../etc/passwd => Error: path "../../../etc/passwd" escapes above starting point |}] +;; + +(* @mdexp + + ### Upward Navigation + + Use absolute paths for upward traversal: + + @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 + + 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"}