w6vvn/palps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

relocate path assertion definitions for more appropriate organisation

Browse Source
This commit is contained in:
w6vvn
2025-09-10 12:20:37 -07:00
parent 0eb1282af7
commit df188a31f6
1 changed files with 20 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
palps.rkt
View File

@@ -9,6 +9,26 @@
;; directory of the current user of the program ;; directory of the current user of the program
(define call-dir (make-parameter (string->path "/nobody"))) (define call-dir (make-parameter (string->path "/nobody")))
;; 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)))))
(define (call-valid? call) (define (call-valid? call)
(and (and
(<= (string-length call) 9) (<= (string-length call) 9)
@@ -75,26 +95,6 @@
path]))) path])))
(loop)) (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 ;; "main" procedure to be executed in an interactive context i.e. for
;; BPQ ;; BPQ
(define (session-startup) (define (session-startup)