new fn append-path in anoia

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

pkgs/anoia/init.fnl

@@ -28,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)
@@ -65,6 +77,16 @@
  (expect (not (table= {:a [4 5 7 6] } {:a [4 5 6 7 ]})))
 
  (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]
@@ -206,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