From 9b492b52fef481c73740c9c6fb9b181478ea9d9b Mon Sep 17 00:00:00 2001 From: w6vvn Date: Wed, 10 Sep 2025 11:55:39 -0700 Subject: [PATCH] assertion for path validation --- palps.rkt | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/palps.rkt b/palps.rkt index 879099e..8f99020 100755 --- a/palps.rkt +++ b/palps.rkt @@ -75,6 +75,26 @@ path]))) (loop)) +;; raised by assert-confined-to-call-dir when attemping to traverse +;; outside of (call-dir) +(struct exn:fail:contract:illegal-path exn:fail:contract () + #:extra-constructor-name make-exn:fail:contract:illegal-path + #:transparent) + +;; check if path, once resolved, is a child of base +(define (confined-path? base path) + (string-prefix? + (path->string (simplify-path (build-path base path))) + (path->string (simplify-path base)))) + +;; asserts that path is within (call-dir), and raises +;; exn:fail:contract:illegal-path otherwise. +(define (assert-confined-to-call-dir path) + (when (not (confined-path? (call-dir) path)) + (raise (make-exn:fail:contract:illegal-path + "assert-confined-to-call-dir: traversed outside of root" + (current-continuation-marks))))) + ;; "main" procedure to be executed in an interactive context i.e. for ;; BPQ (define (session-startup)