apply path assertions to existing path related commands

palps.rkt

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