From 96bb119393d8606d9408d72aa5cb468702bef625 Mon Sep 17 00:00:00 2001
From: Daniil Baturin <daniil@baturin.org>
Date: Fri, 4 Nov 2022 15:29:03 +0000
Subject: T4798: add a file path validator

---
 debian/rules              |  2 ++
 debian/vyos-utils.install |  3 ++-
 src/file_path.ml          | 48 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 52 insertions(+), 1 deletion(-)
 create mode 100644 src/file_path.ml

diff --git a/debian/rules b/debian/rules
index c6e8920..09cdd65 100755
--- a/debian/rules
+++ b/debian/rules
@@ -9,12 +9,14 @@ override_dh_auto_build:
 	eval `opam env`
 	mkdir -p _build
 	ocamlfind ocamlopt -o _build/numeric -package pcre -linkpkg src/numeric.ml
+	ocamlfind ocamlopt -o _build/file-path -package fileutils -linkpkg src/file_path.ml
 	ocamlfind ocamlopt -o _build/validate-value -package pcre,unix,containers -linkpkg src/validate_value.ml
 
 override_dh_auto_install:
 	mkdir -p $(DIR)/usr/libexec/vyos/validators
 	cp _build/numeric $(DIR)/usr/libexec/vyos/validators
 	cp _build/validate-value $(DIR)/usr/libexec/vyos/
+	cp _build/file-path $(DIR)/usr/libexec/vyos/validators
 
 override_dh_auto_test:
 	echo "No tests yet"
diff --git a/debian/vyos-utils.install b/debian/vyos-utils.install
index 77ea559..a67b3f8 100644
--- a/debian/vyos-utils.install
+++ b/debian/vyos-utils.install
@@ -1,2 +1,3 @@
-usr/libexec/vyos/validators/numeric
 usr/libexec/vyos/validate-value
+usr/libexec/vyos/validators/numeric
+usr/libexec/vyos/validators/file-path
diff --git a/src/file_path.ml b/src/file_path.ml
new file mode 100644
index 0000000..8c05ffd
--- /dev/null
+++ b/src/file_path.ml
@@ -0,0 +1,48 @@
+type opts = {
+  must_be_file : bool;
+  parent : string option;
+  strict : bool; 
+}
+
+let default_opts = {
+  must_be_file = true;
+  parent = None;
+  strict = false
+}
+
+let opts = ref default_opts
+
+let path_arg = ref ""
+
+let args = [
+    ("--file", Arg.Unit (fun () -> opts := {!opts with must_be_file=true}), "Path must point to a file and not a directory (default)");
+    ("--directory", Arg.Unit (fun () -> opts := {!opts with must_be_file=false}), "Path must point to a directory");
+    ("--parent-dir", Arg.String (fun s -> opts := {!opts with parent=(Some s)}), "Path must be inside specific parent directory");
+    ("--strict", Arg.Unit (fun () -> opts := {!opts with strict=true}), "Treat warnings as errors");
+]
+let usage = Printf.sprintf "Usage: %s [OPTIONS] <path>" Sys.argv.(0)
+
+let () = if Array.length Sys.argv = 1 then (Arg.usage args usage; exit 1)
+let () = Arg.parse args (fun s -> path_arg := s) usage
+
+let fail msg =
+  let () = print_endline msg in
+  exit 1
+
+let () =
+  let path = !path_arg in
+  let opts = !opts in
+  (* First, check if the file/dir path exists at all. *)
+  let exists = FileUtil.test FileUtil.Exists path in
+  if not exists then Printf.ksprintf fail {|Incorrect path %s: no such file or directory|} path else
+  (* If yes, check if it's of the correct type: file or directory. *)
+  let is_file =	FileUtil.test FileUtil.Is_file path in
+  if ((not is_file) && opts.must_be_file) then Printf.ksprintf fail {|%s is a directory, not a file|} path else 
+  if (is_file && (not opts.must_be_file)) then Printf.ksprintf fail {|%s is a file, not a directory|} path else
+  match opts.parent with
+  | None ->
+    exit 0
+  | Some parent ->
+    if not (FilePath.is_subdir (FilePath.reduce path) (FilePath.reduce parent)) then
+    let msg = Printf.sprintf {|Path %s is not under %s directory|} path parent in
+    if opts.strict then fail msg else Printf.printf "Warning: %s\n" msg
-- 
cgit v1.2.3