client.clj

(ns de.mpg.shh.util-webdav.client
  (require [clojure.tools.logging :refer [info error]]
           [clojure.string :as str]
           [clojure.edn :as edn])
  (import [java.util Collections]
          [java.nio.file Files]
          [com.github.sardine.impl SardineImplWithTransaction SardineException]
          [com.github.sardine.util SardineUtil]
          [javax.xml.namespace QName]))

(defn- file-to-byte-array
  "Converts a java.io.File to a byte[]"
  [file]
  (Files/readAllBytes (.toPath file)))

(defn- http-ns->attr-ns
  [n-space]
  (-> (if-let [protocol (re-find #"^[a-zA-Z]+:/{0,2}" n-space)]
        (subs n-space (count protocol))
        n-space)
      (str/replace #"/$" "")
      (str/replace #"/" ".")))

(defn- qname->keyword
  [^QName qname]
  (keyword (str (-> qname (.getNamespaceURI) http-ns->attr-ns) "/" (.getLocalPart qname))))

(defn- apache-prop->val
  [ap]
  (get {"F" false
        "T" true} ap ap))

(defn- extract-properties
  [accumulator [k v]]
  (let [q-ns (.getNamespaceURI k)
        q-local-part (.getLocalPart k)]
    (cond
      (= q-ns "http://apache.org/dav/props/")
      (assoc-in accumulator [:props (qname->keyword k)] (apache-prop->val v))
      (= q-ns SardineUtil/CUSTOM_NAMESPACE_URI)
      (update accumulator :custom conj [q-local-part (if (re-matches #"^de\.mpg\.shh\.webdav\.(?:key|value)\.[0-9]+" q-local-part)
                                                       (edn/read-string v)
                                                       v)])
      :else (assoc accumulator k v))))

(defn- sort-on-kv-num
  [kv-name]
  (-> kv-name first (str/split #"\.") last Long/valueOf))


(defn- gather-custom-props
  [custom-props]
  (zipmap (->> custom-props
               (filter #(re-matches #"^de\.mpg\.shh\.webdav\.key\.[0-9]+" (first %)))
               (sort-by sort-on-kv-num)
               (map second))
          (->> custom-props
               (filter #(re-matches #"^de\.mpg\.shh\.webdav\.value\.[0-9]+" (first %)))
               (sort-by sort-on-kv-num)
               (map second))))

(defn relative-path
  [base-url path]
  (loop [base-url-split (reverse (str/split base-url #"/"))
         path-split (str/split path #"/")]
    (cond
      (empty? path-split)
      ""
      (str/blank? (first path-split))
      (recur base-url-split (rest path-split))
      (= (first path-split) (first base-url-split))
      (recur (rest base-url-split) (rest path-split))
      :else (str/join "/" path-split))))

(defn- extract-dav-resource
  [base-url dav-resource]
  ;;(info "extract-dav-resource .getCustomProps: " (pr-str (.getCustomProps dav-resource)))
  ;;(info "extract-dav-resource .getCustomPropsNS: " (pr-str (.getCustomPropsNS dav-resource)))
  (let [gathered-props (reduce extract-properties {:custom [] :props {}} (.getCustomPropsNS dav-resource))
        custom-props (gather-custom-props (:custom gathered-props))]
    {:file-name (.getName dav-resource)
     :path (.getPath dav-resource)
     :relative-path (relative-path base-url (.getPath dav-resource))
     :dir? (.isDirectory dav-resource)
     :content-type (.getContentType dav-resource)
     :content-length (.getContentLength dav-resource)
     :modified (.getModified dav-resource)
     :created (.getCreation dav-resource)
     :properties (merge (:props gathered-props) custom-props)}))

(defn conn [opts]
  (let [sardine (SardineImplWithTransaction. (:user-name opts) (:password opts))
        ;;_ (info "sardine: " sardine)
        conn {:sardine sardine
              :base-url (:base-url opts)}]
    conn))

(defn get-file
  [{sardine :sardine
    base-url :base-url} file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.get url))
      (catch SardineException se
        (throw (ex-info "Failed to fetch file" {:cause (.getMessage se)}))))))

(defn list-dir
  [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (map (partial extract-dav-resource base-url) (-> sardine (.list url 1)))
      (catch SardineException se
        (throw (ex-info "Failed to list file" {:cause (.getMessage se)}))))))

(defn list-file
  [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (first (map (partial extract-dav-resource base-url) (-> sardine (.list url 0))))
      (catch SardineException se
        (throw (ex-info "Failed to list file" {:cause (.getMessage se)}))))))

(defn put-file
  [{sardine :sardine
    base-url :base-url}
   file
   file-path]
  (let [url (str/join "/" [base-url file-path])
        ba (file-to-byte-array file)]
    (try
      (-> sardine (.put url ba))
      (catch SardineException se
        (throw (ex-info "Failed to put file" {:cause (.getMessage se)}))))))

(defn put-stream
  [{sardine :sardine
    base-url :base-url}
   i-stream
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.put url i-stream))
      (catch SardineException se
        (throw (ex-info "Failed to put stream" {:cause (.getMessage se)}))))))

(defn delete-file
  [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.delete url))
      (catch SardineException se
        (throw (ex-info "Failed to delete file" {:cause (.getMessage se)}))))))

(defn delete-dir
  [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path ""])]
    (try
      (-> sardine (.delete url))
      (catch SardineException se
        (throw (ex-info "Failed to delete file" {:cause (.getMessage se)}))))))

(defn create-directory
    [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.createDirectory url))
      (catch SardineException se
        (throw (ex-info "Failed to create directory" {:cause (.getMessage se)}))))))

(defn prop->sardine
  [accumulator [k v]]
  (let [qname-key (SardineUtil/createQNameWithCustomNamespace (str "de.mpg.shh.webdav.key." (count accumulator)))
        qname-value (SardineUtil/createQNameWithCustomNamespace (str "de.mpg.shh.webdav.value." (count accumulator)))
        element-key (SardineUtil/createElement qname-key)
        _ (.setTextContent element-key (pr-str k))
        element-value (SardineUtil/createElement qname-value)
        _ (.setTextContent element-value (pr-str v))]
    (conj accumulator element-key element-value)))

(defn assoc-props
  ([conn
    file-path
    props]
    (assoc-props conn file-path props nil))
  ([{sardine :sardine
     base-url :base-url}
    file-path
    props
    if-header]
  (let [url (str/join "/" [base-url file-path])
        sardine-props (reduce prop->sardine [] props)]
    (try
      (map (partial extract-dav-resource base-url) (-> sardine (.patchTx url sardine-props (Collections/emptyList) if-header)))
      (catch SardineException se
        (throw (ex-info "Failed to add props" {:cause (.getMessage se)})))))))

(defn- filter-custom-keys
  [[k v]]
  (let [q-ns (.getNamespaceURI k)
        q-local-part (.getLocalPart k)]
    (and (= q-ns SardineUtil/CUSTOM_NAMESPACE_URI)
         (re-matches #"^de\.mpg\.shh\.webdav\.key\.[0-9]+" q-local-part))))

(defn- extract-custom-key
  [[k v]]
  [(edn/read-string v) (.getLocalPart k)])

(defn dissoc-props
  [{sardine :sardine
    base-url :base-url}
   file-path
   prop-key-set]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (let [current-key-lookup (into {} (map extract-custom-key (filter filter-custom-keys (-> sardine (.list url 0) first (.getCustomPropsNS)))))
            dissoc-qnames (map #(SardineUtil/createQNameWithCustomNamespace %) (vals (select-keys current-key-lookup prop-key-set)))]
        (-> sardine (.patch url (Collections/emptyMap) dissoc-qnames)))
      (catch SardineException se
        (throw (ex-info "Failed to add props" {:cause (.getMessage se)}))))))

(defn lock
  [{sardine :sardine
    base-url :base-url}
   file-path]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.lock url))
      (catch SardineException se
        (throw (ex-info "Failed to obtain lock" {:cause (.getMessage se)}))))))

(defn unlock
  [{sardine :sardine
    base-url :base-url}
   file-path
   lock-token]
  (let [url (str/join "/" [base-url file-path])]
    (try
      (-> sardine (.unlock url lock-token))
      (catch SardineException se
        (throw (ex-info "Failed to release lock" {:cause (.getMessage se)}))))))