From 3db131bf5470a852d1d3200c90ab6198762e3f50 Mon Sep 17 00:00:00 2001
From: Stephen Clayton <clayton@shh.mpg.de>
Date: Thu, 3 Aug 2017 16:16:21 +0200
Subject: [PATCH] inital import of webdav client

---
 project.clj                                   |  16 ++
 .../clojure/de/mpg/shh/util_webdav/client.clj | 213 +++++++++++++++++
 src/test/clojure/util_webdav/client_test.clj  | 215 ++++++++++++++++++
 src/test/clojure/util_webdav/config.clj       |  25 ++
 src/test/clojure/util_webdav/test.clj         |   5 +
 test-resources/log4j2.properties              |   9 +
 6 files changed, 483 insertions(+)
 create mode 100644 project.clj
 create mode 100644 src/main/clojure/de/mpg/shh/util_webdav/client.clj
 create mode 100644 src/test/clojure/util_webdav/client_test.clj
 create mode 100644 src/test/clojure/util_webdav/config.clj
 create mode 100644 src/test/clojure/util_webdav/test.clj
 create mode 100644 test-resources/log4j2.properties

diff --git a/project.clj b/project.clj
new file mode 100644
index 0000000..00218d4
--- /dev/null
+++ b/project.clj
@@ -0,0 +1,16 @@
+(defproject de.mpg.shh/webdav "0.0.1"
+  :description "LIMS for ssh"
+  :url "http://www.shh.mpg.de/"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/tools.logging "0.3.1"]
+                 [org.apache.logging.log4j/log4j-api "2.5"]
+                 [org.apache.logging.log4j/log4j-core "2.5"]
+                 [org.apache.logging.log4j/log4j-1.2-api "2.5"]
+                 [org.slf4j/slf4j-log4j12 "1.6.4"]
+                 [com.github.lookfirst/sardine "5.7"]]
+  :source-paths ["src/main/clojure"]
+  :profiles {:test {:test-paths ["src/test/clojure"]
+                    :resource-paths ["test-resources"]
+                    :dependencies [[de.mpg.shh/util-properties "0.0.1"]]}})
diff --git a/src/main/clojure/de/mpg/shh/util_webdav/client.clj b/src/main/clojure/de/mpg/shh/util_webdav/client.clj
new file mode 100644
index 0000000..cab1d1b
--- /dev/null
+++ b/src/main/clojure/de/mpg/shh/util_webdav/client.clj
@@ -0,0 +1,213 @@
+(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]
+          [java.io ByteArrayInputStream]
+          [org.apache.http.conn.ssl SSLContextBuilder]
+          [org.apache.http.impl.client HttpClients]
+          [com.github.sardine.impl SardineImpl SardineException SardineRedirectStrategy]
+          [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- extract-dav-resource
+  [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)
+     :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 (SardineImpl. (: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 extract-dav-resource (-> 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
+      (map extract-dav-resource (-> 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
+  [{sardine :sardine
+    base-url :base-url}
+   file-path
+   props]
+  (let [url (str/join "/" [base-url file-path])
+        sardine-props (reduce prop->sardine [] props)]
+    (try
+      (map extract-dav-resource (-> sardine (.patch url sardine-props (Collections/emptyList))))
+      (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)}))))))
diff --git a/src/test/clojure/util_webdav/client_test.clj b/src/test/clojure/util_webdav/client_test.clj
new file mode 100644
index 0000000..374cd1c
--- /dev/null
+++ b/src/test/clojure/util_webdav/client_test.clj
@@ -0,0 +1,215 @@
+(ns util-webdav.client-test
+  (:require [clojure.tools.logging :refer [info error]]
+            [clojure.string :as str]
+            [clojure.java.io :as io]
+            [clojure.test :refer [deftest is]]
+            [util-webdav.config :as config]
+            [de.mpg.shh.util-webdav.client :as client])
+  (:import [java.nio.file Files Paths StandardCopyOption]
+           [java.nio.file.attribute FileAttribute]
+           [java.io File IOException]))
+
+(def dav-prefix (config/get-in [:test :dav-prefix] ""))
+
+(def default-opts
+  {:base-url (config/get-in [:base-url])
+   :user-name (config/get-in [:user-name])
+   :password (config/get-in [:password])})
+
+(defn temp-dir
+  []
+  (try
+    (Files/createTempDirectory "clj-util-webdav" (into-array FileAttribute []))
+    (catch IOException ioe
+      (throw (ex-info "IOException creating tmp dir" {:cause (.getMessage ioe)})))))
+
+(defn simple-dav-map
+  [m]
+  (dissoc m
+          :modified
+          :created))
+
+(deftest conn
+  (let [conn (client/conn default-opts)
+        expected #{:sardine :base-url}]
+    (is (= (into #{} (keys conn)) expected))))
+
+(deftest get-file-not-found-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        result (try
+                 (client/get-file conn file-name)
+                 (catch Exception e
+                   (ex-data e)))]
+    (is (= result {:cause "Unexpected response (404 Not Found)"}))))
+
+(deftest get-file-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        result (try
+                 (client/put-stream conn i-stream file-name)
+                 (slurp (client/get-file conn file-name))
+                 (catch Exception e
+                   (ex-data e)))
+        _ (client/delete-file conn file-name)]
+    (is (= result "My dog spot\n"))))
+
+(deftest put-file-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        tmp-dir-path (temp-dir)
+        tmp-file-path (Paths/get (.toString tmp-dir-path) (into-array String ["foo.txt"]))
+        result (try
+                 (Files/copy i-stream tmp-file-path (into-array StandardCopyOption [StandardCopyOption/REPLACE_EXISTING]))
+                 (client/put-file conn (.toFile tmp-file-path) file-name)
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-file conn file-name)]
+    (is (nil? result))))
+
+(deftest put-stream-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        result (try
+                 (client/put-stream conn i-stream file-name)
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-file conn file-name)]
+    (is (nil? result))))
+
+(deftest create-directory-test
+  (let [conn (client/conn default-opts)
+        file-name "bar"
+        result (try
+                 (client/create-directory conn file-name)
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-dir conn file-name)]
+    (is (or (nil? result)
+            (= result {:cause "Unexpected response (301 Moved Permanently)"})))))
+
+(deftest list-dir-test
+  (let [conn (client/conn default-opts)
+        i-stream (io/input-stream (io/resource "foo.txt"))
+        _ (client/put-stream conn i-stream "foo.txt")
+        _ (client/create-directory conn "bar")
+        result (try
+                 (vec (client/list-dir conn ""))
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-file conn "foo.txt")
+        _ (client/delete-dir conn "bar")
+        expected [{:file-name (str/replace dav-prefix #"/$" "")
+                   :path (str "/" dav-prefix)
+                   :dir? true
+                   :content-type "httpd/unix-directory"
+                   :content-length -1
+                   :properties {}}
+                  {:file-name "bar"
+                   :path (str "/" dav-prefix "bar/")
+                   :dir? true
+                   :content-type "httpd/unix-directory"
+                   :content-length -1
+                   :properties {}}
+                  {:file-name "foo.txt"
+                   :path (str "/" dav-prefix "foo.txt")
+                   :dir? false
+                   :content-type "text/plain"
+                   :content-length 12
+                   :properties {:apache.org.dav.props/executable false}}]]
+    (is (= (vec (sort-by :file-name expected)) (vec (sort-by :file-name (map simple-dav-map result)))))))
+
+(deftest list-file-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource  file-name))
+        _ (client/put-stream conn i-stream file-name)
+        result (try
+                 (vec (client/list-file conn file-name))
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-file conn file-name)
+        expected [{:file-name "foo.txt"
+                   :path (str "/" dav-prefix "foo.txt")
+                   :dir? false
+                   :content-type "text/plain"
+                   :content-length 12
+                   :properties {:apache.org.dav.props/executable false}}]]
+    (is (= (vec (sort-by :file-name expected)) (vec (sort-by :file-name (map simple-dav-map result)))))))
+
+(deftest delete-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        _ (client/put-stream conn i-stream file-name)
+        result (try
+                 (client/delete-file conn file-name)
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))]
+    (is (nil? result))))
+
+(deftest assoc-props-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        _ (client/put-stream conn i-stream file-name)
+        props {:huricane/katrina true
+               :huricane/bob false}
+        _ (try
+              (client/assoc-props conn file-name props)
+              (catch Exception e
+                (error "caught exception e: " e)
+                (ex-data e)))
+        result (vec (client/list-file conn file-name))
+        _ (client/delete-file conn "foo.txt")
+        expected [{:file-name "foo.txt"
+                   :path (str "/" dav-prefix "foo.txt")
+                   :dir? false
+                   :content-type "text/plain"
+                   :content-length 12
+                   :properties {:apache.org.dav.props/executable false
+                                :huricane/katrina true
+                                :huricane/bob false}}]]
+      (is (= expected (vec (map simple-dav-map result))))))
+
+(deftest dissoc-props-test
+  (let [conn (client/conn default-opts)
+        file-name "foo.txt"
+        i-stream (io/input-stream (io/resource file-name))
+        _ (client/put-stream conn i-stream file-name)
+        props {:huricane/katrina true
+               :huricane/bob false}
+        _ (try
+              (client/assoc-props conn file-name props)
+              (catch Exception e
+                (error "caught exception e: " e)
+                (ex-data e)))
+        _ (try
+              (client/dissoc-props conn file-name #{:huricane/katrina})
+              (catch Exception e
+                (error "caught exception e: " e)
+                (ex-data e)))
+        result (try
+                 (vec (client/list-file conn file-name))
+                 (catch Exception e
+                   (error "caught exception e: " e)
+                   (ex-data e)))
+        _ (client/delete-file conn "foo.txt")
+        expected [{:file-name "foo.txt"
+                   :path (str "/" dav-prefix "foo.txt")
+                   :dir? false
+                   :content-type "text/plain"
+                   :content-length 12
+                   :properties {:apache.org.dav.props/executable false
+                                :huricane/bob true}}]]
+    (is (= expected (vec (map simple-dav-map result))))))
+
diff --git a/src/test/clojure/util_webdav/config.clj b/src/test/clojure/util_webdav/config.clj
new file mode 100644
index 0000000..6ab010f
--- /dev/null
+++ b/src/test/clojure/util_webdav/config.clj
@@ -0,0 +1,25 @@
+(ns util-webdav.config
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [de.mpg.shh.util-properties.properties :refer [load-properties]])
+  (:refer-clojure :exclude [get-in]))
+
+(def ^{:private true} config-file "webdav.properties")
+
+(def ^{:private true} config (atom nil))
+
+
+(def transform-map {})
+
+(defn read-and-cache-config!
+  "Read `config-file`, apply `config-transformers` and cache in an atom"
+  []
+  (let [new-config (load-properties config-file transform-map)]
+    (reset! config new-config)))
+
+(defn get-in
+  ([ks]
+     (get-in ks nil))
+  ([ks default]
+     (when (nil? @config) (read-and-cache-config!))
+     (clojure.core/get-in @config ks default)))
diff --git a/src/test/clojure/util_webdav/test.clj b/src/test/clojure/util_webdav/test.clj
new file mode 100644
index 0000000..61636e6
--- /dev/null
+++ b/src/test/clojure/util_webdav/test.clj
@@ -0,0 +1,5 @@
+(ns util-webdav.test
+  (require [clojure.test :refer [run-tests]]
+           [util-webdav.client-test]))
+
+;;(run-tests 'util-webdav.client-test)
diff --git a/test-resources/log4j2.properties b/test-resources/log4j2.properties
new file mode 100644
index 0000000..4fdab9d
--- /dev/null
+++ b/test-resources/log4j2.properties
@@ -0,0 +1,9 @@
+appenders = console
+appender.console.type = Console
+appender.console.name = STDOUT
+appender.console.target = SYSTEM_OUT
+appender.console.layout.type = PatternLayout
+appender.console.layout.pattern = %d [%t] %-5p %c - %m%n
+rootLogger.level = info
+rootLogger.appenderRefs = stdout
+rootLogger.appenderRef.stdout.ref = STDOUT