new fn append-path in anoia

complains if you try to ../../../

pkgs/anoia/assert.fnl

@@ -3,7 +3,6 @@
 
 ;; e.g. (import-macros { : expect= } :anoia.assert)
 
-
 (fn expect [assertion]
   (let [msg (.. "expectation failed: " (view assertion))]
     `(when (not ,assertion)

pkgs/anoia/fs.fnl

@@ -82,7 +82,6 @@
   (let [p (find-executable "yes" (os.getenv "PATH"))]
     (expect (string.match p "coreutils.+bin/yes$"))))
 
-
 {
  : mktree
  : rmtree

pkgs/anoia/init.fnl

@@ -1,8 +1,4 @@
-;; importing assert.fnl macros here would be circular, so we can't use
-;; the full test functionality
-(macro define-tests [& body]
-  (when _G.RUNNING_TESTS
-    `(do ,(unpack body))))
+(import-macros { :  define-tests : expect : expect= } :anoia.assert)
 
 (fn assoc [tbl k v & more]
   (tset tbl k v)
@@ -32,6 +28,18 @@
 (fn dirname [path]
   (string.match path "(.*)/[^/]-$"))
 
+(fn append-path [dirname filename]
+  (let [base (or (string.match dirname "(.*)/$") dirname)
+        result []]
+    (each [component (string.gmatch filename "([^/]+)")]
+      (if (and (= component "..") (> (# result) 0))
+          (table.remove result)
+          (= component "..")
+          (error "path traversal attempt")
+          true
+          (table.insert result component)))
+    (.. base "/" (table.concat result "/"))))
+
 (fn system [s]
   (match (os.execute s)
     res (do (print (.. "Executed \"" s "\", exit code " (tostring res)))  res)
@@ -59,16 +67,26 @@
              (and present (. a k))))))
 
 (define-tests
- (assert (table= {:a 1 :b 2} {:b 2 :a 1}))
- (assert (not (table= {:a 1 :b 2 :k :l}  {:b 2 :a 1})))
- (assert (not (table= {:a 1 :b 2}  {:b 2 :a 1 :k :l})))
+ (expect (table= {:a 1 :b 2} {:b 2 :a 1}))
+ (expect (not (table= {:a 1 :b 2 :k :l}  {:b 2 :a 1})))
+ (expect (not (table= {:a 1 :b 2}  {:b 2 :a 1 :k :l})))
 
- (assert (table= {:a 1 :b {:l 17}} {:b {:l 17} :a 1}))
- (assert (table= {:a [4 5 6 7] } {:a [4 5 6 7]}))
- (assert (not (table= {:a [4 5 6 7] } {:a [4 5 6 7 8]})))
- (assert (not (table= {:a [4 5 7 6] } {:a [4 5 6 7 ]})))
+ (expect (table= {:a 1 :b {:l 17}} {:b {:l 17} :a 1}))
+ (expect (table= {:a [4 5 6 7] } {:a [4 5 6 7]}))
+ (expect (not (table= {:a [4 5 6 7] } {:a [4 5 6 7 8]})))
+ (expect (not (table= {:a [4 5 7 6] } {:a [4 5 6 7 ]})))
 
- (assert (table= {} {}))
+ (expect (table= {} {}))
+
+ (let [traps (fn [b p]
+               (match (pcall append-path b p)
+                 (true f) (error "didn't trap path traversal")
+                 (false err) (expect (string.match err "path traversal"))))]
+   (expect= (append-path "/tmp" "hello") "/tmp/hello")
+   (expect= (append-path "/tmp/" "hello") "/tmp/hello")
+   (traps "/tmp/" "../hello")
+   (expect= (append-path "/tmp/" "hello/../goodbye") "/tmp/goodbye")
+   (traps "/tmp/" "hello/../../goodbye"))
  )
 
 (fn dig [tree path]
@@ -177,17 +195,17 @@
         b64 (base64 :url)]
 
     (let [a (b64:decode "YWxsIHlvdXIgYmFzZQ==")]
-      (assert (= a "all your base") (view a)))
+      (expect= a "all your base"))
     (let [a (b64:decode "ZmVubmVsIHRoaW5n")]
-      (assert (= a "fennel thing")  a))
+      (expect= a "fennel thing"))
     (let [a (b64:decode "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms=")]
-      (assert (= a "Many hands make light work") (view  a)))
+      (expect= a "Many hands make light work"))
     (let [a (b64:encode "hello world")]
-      (assert (= a "aGVsbG8gd29ybGQ=") a))
+      (expect= a "aGVsbG8gd29ybGQ="))
 
     (fn check [plain enc]
-      (let [a (b64:encode plain)] (assert (= a enc) (.. "encode " a)))
-      (let [a (b64:decode enc)] (assert (= a plain) (.. "decode " a))))
+      (let [a (b64:encode plain)] (expect (= a enc) (.. "encode " a)))
+      (let [a (b64:decode enc)] (expect (= a plain) (.. "decode " a))))
 
     (check ""  "")
     (check "f"  "Zg==")
@@ -198,12 +216,10 @@
     (check "foobar"  "Zm9vYmFy")
 
     (let [x (b64:decode "REtOdUtNS05BNEJWLXdfcUhtNU9YV2liOUxkX3RTdVJTQWVUR0dkWldBdVEyaURObDZ2b3pSbEJwMzlzOEltdkhWdmpzZmMiLCJ5IjoiQVlDY1QwOGZrNFZWZ2lZSVIxbkU4UlJGaGZOSGdBUEFzckRITmJtRGNfUGtWZmdDR0xTMTIweU5SNncwdjd5RUY4WDN1OGpvazhkU0pqN0hnWjZCZHAzcSJ9LCJraWQiOiJlalVDaXBCUE9BeDRWQ1dQdUtkVGlYNDNadW5XTDNjSWN6V1h1RVZyTVNFIn0")]
-      (assert (string.match x "}$") x))
+      (expect (string.match x "}$") x))
 
     ))
 
-
-
     ;; doesn't work if the padding is missing
     ;; (let [a (from-base64 "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms")]
     ;;   (assert (= a "Many hands make light work") (view  a)))
@@ -212,6 +228,7 @@
 
 
 {
+ : append-path
  : assoc
  : base64
  : base64url

pkgs/watch-ssh-keys/watch-ssh-keys.fnl

@@ -1,4 +1,4 @@
-(local { : system : assoc : split : dup : table= : dig } (require :anoia))
+(local { : system : assoc : split : dup : table= : dig : append-path } (require :anoia))
 (local svc (require :anoia.svc))
 (import-macros { :  define-tests : expect : expect= } :anoia.assert)
 
@@ -13,14 +13,14 @@
   (when (not (table= old-tree new-tree))
     (io.stderr:write "new ssh keys\n")
     (each [username pubkeys (pairs new-tree)]
-      (with-open [f (assert (io.open (.. path "/" username) :w))]
+      (with-open [f (assert (io.open (append-path path username) :w))]
         ;;  the keys are "1" "2" "3" etc, so pairs not ipairs
         (each [_ k (pairs pubkeys)]
           (f:write k)
           (f:write "\n")))))
   (each [k v (pairs old-tree)]
     (when (not (. new-tree k))
-      (os.remove (.. path "/" k))))
+      (os.remove (append-path path k))))
   new-tree)
 
 (define-tests