*

1 files changed, 159 insertions, 0 deletions

diff --git a/clj/webdav.clj b/clj/webdav.clj
new file mode 100644
index 0000000..a2dd649
--- /dev/null
+++ b/clj/webdav.clj
@@ -0,0 +1,159 @@
+;; from https://gist.github.com/jackrusher/af3528564355691dda9db327cd2b185d
+; To try it out on MacOS:
+
+; - download it
+; - bb webdav.clj
+; - use ⌘-K in Finder to connect to localhost:8080 (any username and password you like, it doesn't matter)
+; 
+; The filesystem will be mounted at:
+;     /Volumes/localhost
+
+(ns webdav
+  (:require [clojure.string :as str]
+            [clojure.data.xml :as xml]
+            [org.httpkit.server :as hk-server]))
+
+;; add the XML namespace that we'll use later
+(xml/alias-uri 'd "DAV:")
+
+(defn dissoc-in
+  "Should be in the standard library..."
+  [m [k & ks]]
+  (if-not ks
+    (dissoc m k)
+    (assoc m k (dissoc-in (m k) ks))))
+
+(def tree
+  "The filesystem tree, empty but for the root directory."
+  (let [now (java.util.Date.)]
+    (atom {:ctime now :mtime now})))
+
+(defn update-path-timestamps
+  "Update ctime/mtime for every file/dir in path."
+  [now path]
+  (doseq [sub-path (mapv #(vec (drop-last % path)) (range (count path)))]
+    (swap! tree assoc-in (conj sub-path :mtime) now)
+    (when-not (get-in @tree (conj sub-path :ctime))
+      (swap! tree assoc-in (conj sub-path :ctime) now))))
+
+(defn write-file
+  "Create if needed, including parent path."
+  [path content]
+  (swap! tree assoc-in (conj path :content) content)
+  (update-path-timestamps (java.util.Date.) path))
+
+(defn delete-file [path]
+  (swap! tree dissoc-in path))
+
+(defn move-file [old-path new-path]
+  (let [current-file (get-in @tree (conj old-path))]
+    (if-let [content (:content current-file)]
+      (write-file new-path content)
+      (do (swap! tree assoc-in new-path current-file)
+          (update-path-timestamps (java.util.Date.) new-path))))
+  (delete-file old-path))
+
+(defn mkdir [path]
+  (update-path-timestamps (java.util.Date.) path))
+
+(defn date->str
+  "The only date format I'm sure works with WebDAV."
+  [d]
+  (.format (java.text.SimpleDateFormat. "E, dd MMM yyyy H:m:s z") d))
+
+(defn props-for-file [uri file]
+  (let [is-file? (:content file)] ; otherwise, directory
+    [::d/reponse
+     [::d/href (if is-file?
+                 uri
+                 (if (.endsWith uri "/") ; ensure directories have trailing slash
+                   uri
+                   (str uri "/")))]
+     [::d/propstat
+      [::d/prop
+       [::d/creationdate (date->str (:ctime file))]
+       [::d/getlastmodified (date->str (:mtime file))]
+       (if is-file?
+         [::d/resourcetype]
+         [::d/resourcetype [::d/collection]])]
+      [::d/status "HTTP/1.1 200 OK"]]]))
+
+(defn parse-lock-spec [lock-spec]
+  (->> (xml/parse-str lock-spec {:namespace-aware false})
+       :content
+       flatten
+       (remove string?)
+       (reduce (fn [m thing]
+                 (let [tag (:tag thing)]
+                   (assoc m tag (if (= tag :D:owner)
+                                  (-> thing :content second :content first)
+                                  (-> thing :content first :tag)))))
+               {})))
+
+(defn handler [req]
+  (let [uri (:uri req)
+        path (vec (rest (str/split uri #"/")))
+        file (get-in @tree path)]
+;;    (println req)
+    (if file ; path exists
+      (condp = (:request-method req)
+        :options {:status  204
+                  :headers {"Allow" "OPTIONS,PROPFIND,GET,PUT,LOCK,UNLOCK,DELETE,MKCOL,MOVE" ; COPY?
+                            "DAV" "2"}}
+        :propfind {:body (xml/indent-str
+                          (xml/sexp-as-element
+                           (if (:content file) ; is a plain file                        
+                             [::d/multistatus
+                              (props-for-file uri file)]
+                             (into [::d/multistatus
+                                    (props-for-file uri file)]
+                                   (map (fn [[k v]]
+                                          (props-for-file (str (if (.endsWith uri "/") uri (str uri "/"))
+                                                               k)
+                                                          v))
+                                        (dissoc file :ctime :mtime))))))
+                   :status 207
+                   :headers {"Content-Type" "application/xml"}}
+        ;; XXX lock/unlock is currently a no-op! 😱
+        :lock (let [lock-req (parse-lock-spec (slurp (:body req)))
+                    lock-token (str "urn:uuid:" (str (java.util.UUID/randomUUID)))]
+                {:body (xml/indent-str
+                        (xml/sexp-as-element
+                         [::d/prop
+                          [::d/lockdiscovery
+                           [::d/activelock
+                            [::d/locktype [::d/write]]      ; both of these should come from the
+                            [::d/lockscope [::d/exclusive]] ; lock spec, but this'll do for now
+                            [::d/depth "infinity"]
+                            [::d/owner [::d/href (:D:owner lock-req)]]
+                            [::d/timeout "Second-604800"]
+                            [::d/locktoken [::d/href lock-token]]
+                            [::d/lockroot [::d/href (:uri req)]]]]]))
+                 :headers {"Lock-Token" lock-token
+                           "Content-Type" "application/xml"}})
+        :unlock {:status 204}
+        :get {:body (:content file)
+              :headers {"Content-Length" (str (count (:content file)))}} ; TODO content-type!
+        ;; overwrite existing file
+        :put (do (if (nil? (:body req))
+                   (byte-array 0)
+                   (.readAllBytes (:body req))) 
+                 {:status 201})
+        :delete (do (delete-file path)
+                    {:status 204})
+        :move (do (move-file path (vec (rest (str/split (get (-> req :headers) "destination") #"/"))))
+                  {:status 201}))
+      ;; path doesn't exist -- if it's a req to create it, we'll try. otherwise 404
+      (condp = (:request-method req)
+        :mkcol (do (mkdir path) ; XXX should return 409 (Conflict) if the rest of the path doesn't exist
+                   {:status 201})
+        :put (do (write-file path (if (nil? (:body req))
+                                    (byte-array 0)
+                                    (.readAllBytes (:body req))))
+                 {:status 201})
+        {:status 404}))))
+
+(def server ; start server
+  (hk-server/run-server #'handler {:port 8080}))
+
+@(promise) ; don't exit