apply path assertions to existing path related commands

This commit is contained in:
2025-09-10 12:20:02 -07:00
parent 9b492b52fe
commit 0eb1282af7

View File

@@ -121,6 +121,11 @@
(session)))) (session))))
(define (session) (define (session)
(with-handlers
([exn:fail:contract:illegal-path?
(λ (exn)
(displayln "cannot traverse higher than root"))])
(display "palps > ") (display "palps > ")
(flush-output) (flush-output)
@@ -132,21 +137,21 @@
(flush-output)] (flush-output)]
[(list _ "ed" name) [(list _ "ed" name)
(let ([path (build-path (current-directory) (assert-confined-to-call-dir name)
(string->path-element name))])
(let ([path (if (file-exists? path) (let ([path (if (file-exists? name)
(ed (our-make-temporary-file path)) (ed (our-make-temporary-file name))
(ed))]) (ed))])
(copy-file path name #:exists-ok? #t)))] (copy-file path name #:exists-ok? #t))]
[(list _ "rm" name) [(list _ "rm" name)
(let ([path (build-path (current-directory) (assert-confined-to-call-dir name)
(string->path-element name))])
(if (file-exists? path) (if (file-exists? name)
(delete-file path) (delete-file name)
(displayln "file does not exist")) (displayln "file does not exist"))
(flush-output))] (flush-output)]
[(or (list _ "bye" _) [(or (list _ "bye" _)
(list _ "b" _) (list _ "b" _)
@@ -158,8 +163,8 @@
[else [else
(displayln "no such command") (displayln "no such command")
(flush-output)]) (flush-output)]))
(session)) (session))
(session-startup) ;(session-startup)