A minimal webdav server/synthetic filesystem that works with JVM Clojure and babashka. See comments for instructions!

webdav.clj

(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.time.ZonedDateTime/now)]
    (atom {:ctime now
           :mtime now
           "time" {:ctime now
                   :mtime now
                   :content (fn [] (str (java.time.ZonedDateTime/now) "\n"))}})))

(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.time.ZonedDateTime/now) 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.time.ZonedDateTime/now) new-path))))
  (delete-file old-path))

(defn mkdir [path]
  (update-path-timestamps (java.time.ZonedDateTime/now) path))

(defn date->str
  "Make it ISO 8601/UTC."
  [d]
  (.format d java.time.format.DateTimeFormatter/ISO_INSTANT))

(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 (if (fn? (:content file)) ; fn-backed files are always fresh
                              (date->str (java.time.ZonedDateTime/now))
                              (date->str (:mtime file)))]
       [::d/getcontentlength (if (fn? (:content file)) ; fn-backed files have 0 length
                               0
                               (:content 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 (:headers 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" "1,2"}}
        :propfind (do
                    ;; (println (slurp (:body req)))
                    {:body (xml/indent-str
                            (xml/sexp-as-element
                             (if (:content file) ; not a directory
                               [::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 (let [content (:content file)
                   body (if (fn? content) ; files backed by functions return the result
                          (content)     ; of calling the function
                          content)]
               {:body body
                :headers {"Content-Length" (str (count body))}})
         ; TODO content-type!
        ;; overwrite existing file
        :put (let [content (:content file)
                   payload (if (nil? (:body req))
                             (byte-array 0)
                             (.readAllBytes (:body req)))]
               (if (fn? content)
                 (content payload)
                 (write-file path payload))
               {: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

@bsless This two character fix may have done it (works with davfs under Linux, anyway)

I found a couple of issues with it:

• if you rename a file, the file completely disappears
• I tried copying a relatively large file into it (~400kB), and it failed (Error code -36). After that all files (even newly copied files) appear to have zero length.