apply path assertions to existing path related commands
This commit is contained in:
29
palps.rkt
29
palps.rkt
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user