receiver, verifier, retriever, storage: URL normalization

utils: add url utilities for accurate comparison

- add url/normalize taht reconstructs URL, strips unnecessary
components, reorders query string and ensures determinism
- add url/url= that uses url/normalize

receiver: normalize URLs before checking and putting in queue

- use url= and normalize from utils.url
- rename verify-request to check-request to avoid confusion with
verifier.clj

verifier: check if source includes target URL more accurately

- implement url/extract with robinst/autolink-java, which extracts a
vector a URLs from string
- check if source includes target by
  1. extracting all links from source body
  2. normalizing all links before comparing with target link (with url=
func)
- refactor verify-headers -> match-content-types, with a higher order
function and clearer description

retriever, storage: use url= instead of = when comparing urls

9 files changed, 143 insertions, 75 deletions

diff --git a/project.clj b/project.clj
index fa2d666..811348c 100644
--- a/project.clj
+++ b/project.clj
@@ -17,7 +17,8 @@
                  [cheshire "6.2.0"]
                  [ac.eltr/mf2clj "0.0.3"]
                  [com.taoensso/timbre "6.8.0"]
-                 [clj-rss "0.4.0"]]
+                 [clj-rss "0.4.0"]
+                 [org.nibor.autolink/autolink "0.12.0"]]
   :managed-dependencies [[org.clojure/tools.reader "1.6.0"]
                          [org.ow2.asm/asm "9.8"]] 
   :profiles {:uberjar {:aot :all}
diff --git a/src/weepinbell/processor/verifier.clj b/src/weepinbell/processor/verifier.clj
index 9a561ed..b868201 100644
--- a/src/weepinbell/processor/verifier.clj
+++ b/src/weepinbell/processor/verifier.clj
@@ -4,18 +4,24 @@
    1) source contains target URL.

    2) source respond with 2** status code.

    3) source's Content-Type is either HTML or plain text."

-  (:require [clojure.string :refer [includes? trim lower-case split]]

+  (:require [clojure.string :refer [trim lower-case split]]

+            [weepinbell.utils.url :as url]

             [weepinbell.http.client :as client]

             [taoensso.timbre :as timbre]))

 

-(defn- verify-headers [headers]

+(def text-content-types #{"text/html" "text/plain"})

+(defn- match-content-type? 

+  "Return true if "

+  [types headers]

   (when-let [content-type (:content-type headers)]

-    (-> content-type

-        (split #";")

-        first

-        trim

-        lower-case

-        (#{"text/html" "text/plain"}))))

+    (-> content-type (split #";") first trim lower-case types)))

+(def text-content-types? 

+  (partial match-content-type? text-content-types))

+

+(defn- includes-url? 

+  "Return true if text includes a certain URL. URLs are normalized before comparison."

+  [text url]

+  (some #(url/url= % url) (url/extract text)))

 

 (defn- verify-mention

   "Get source and follow redirects to check if target link is present."

@@ -37,14 +43,12 @@
         (timbre/warn "invalid source of" id ", status:" status)

         false)

       ;; verify Content-Type 

-      (or (not (verify-headers headers))

-          (not (verify-headers target-headers)))

+      (not (every? text-content-types? [target-headers headers]))

       (do

         (timbre/warn "source or target of" id "is neither HTML nor plain text content.")

         false)

       ;; verify inclusion of target URL

-      ;; TODO needs to be more robust and performant

-      (not (includes? (str body) target))

+      (not (includes-url? (str body) target))

       (do

         (timbre/warn "invalid source of" id ": target not found in source body.")

         false)

diff --git a/src/weepinbell/receiver.clj b/src/weepinbell/receiver.clj
index 7e62a16..99665ab 100644
--- a/src/weepinbell/receiver.clj
+++ b/src/weepinbell/receiver.clj
@@ -1,19 +1,10 @@
 (ns weepinbell.receiver
   "Handler of route /endpoint or any other route the user configured. 
   Receiver receives Webmention request (a source and a target); verify the request; return error message if any; push Webmention into webbmention channel for processor to take."
-  (:require [clojure.string :as string]
-            [clojure.core.async :refer [put!]]
-            [weepinbell.utils.url :refer [get-domain valid-http-url?]]
+  (:require [clojure.core.async :refer [put!]]
+            [weepinbell.utils.url :refer [get-domain valid-http-url? normalize url=]]
             [weepinbell.utils.digest :refer [digest]]))
 
-;; utilities
-(defn- remove-anchor
-  "Takes a URL string. Removes anchor (#...)"
-  [url]
-  (when (string? url)
-    (string/replace url #"#.*" "")))
-;; end utilities
-
 ;; validation and verification
 
 (defn- validate-urls [s t]
@@ -23,7 +14,7 @@
   (let [target-domain (get-domain t)]
     (some #{target-domain} allow-list)))
 
-(defn- verify-request
+(defn- check-request
   "Verify source and target based on URLs, return error message (string) if any. Return nil if none."
   [source target opts]
   (cond
@@ -33,7 +24,7 @@
     "Invalid URLs. Source and target have to be valid http(s) urls."
     ;; The receiver MUST reject the request
     ;; if the source URL is the same as the target URL.
-    (= source target)
+    (url= source target)
     "Source and target are identical."
     ;; The receiver only accetps webmentions on behalf of configured domains.
     (not (validate-target target opts))
@@ -46,14 +37,12 @@
   Return JSON response of pending notification, rejection or error."
   [wm wmc config]
   (let [{:keys [s t]} wm
-        source (remove-anchor s)
-        target (remove-anchor t)
+        source (normalize s)
+        target (normalize t)
         new-wm {:s source :t target}
-        allowed-domains (:allowed-target-domains config)]
+        allowlist (:allowed-target-domains config)]
      ;; Request verification
-    (if-let [error-msg (verify-request source
-                                       target
-                                       allowed-domains)]
+    (if-let [error-msg (check-request source target allowlist)]
        ;; respond if request verification failed
       {:status 400
        :headers {"Content-Type" "application/json; charset=utf-8"}
diff --git a/src/weepinbell/retriever.clj b/src/weepinbell/retriever.clj
index 864f839..4018dbd 100644
--- a/src/weepinbell/retriever.clj
+++ b/src/weepinbell/retriever.clj
@@ -1,7 +1,7 @@
 (ns weepinbell.retriever
   "Handler of routes /api/mention/:id, /api/mentions/...
   Retriever gets webmention form storage and wraps it in a response."
-  (:require [weepinbell.utils.url :refer [get-domain]]
+  (:require [weepinbell.utils.url :refer [get-domain url=]]
             [weepinbell.microformats.reducer :refer [reduce-mf]]))
 
 (def default-page-size 12)
@@ -73,7 +73,7 @@
   (if url
     (cond->> (get-domain url)
       true ((:get-by-domain storage))
-      true (filter #(= url (get-in % [:webmention :target])))
+      true (filter #(url= url (get-in % [:webmention :target])))
       true (wrap-response-list opts)
       (:type opts) (filter-response-by-mftype (:type opts))
       page (partition-pages page default-page-size)
diff --git a/src/weepinbell/storage/edn_storage.clj b/src/weepinbell/storage/edn_storage.clj
index 5f07884..9d6da1b 100644
--- a/src/weepinbell/storage/edn_storage.clj
+++ b/src/weepinbell/storage/edn_storage.clj
@@ -3,7 +3,7 @@
   Entry function is use-store, which makes a valid storage vtable."
   (:require [clojure.edn :as edn]
             [clojure.java.io :as io]
-            [weepinbell.utils.url :refer [get-domain get-target get-path]]
+            [weepinbell.utils.url :refer [get-domain get-target get-path url=]]
             [clojure.string :refer [join]]))
 
 (defn unload-data
@@ -14,8 +14,8 @@
 
 ;; predicates used for filtering webmention
 (defn- st-pair-equal-pred [source target wm]
-  (and (= source (get-in wm [:webmention :source]))
-       (= target (get-in wm [:webmention :target]))))
+  (and (url= source (get-in wm [:webmention :source]))
+       (url= target (get-in wm [:webmention :target]))))
 (defn- id-equal-pred [id wm]
   (= id (get-in wm [:webmention :id])))
 (defn- get-predicate [source target]
diff --git a/src/weepinbell/utils/url.clj b/src/weepinbell/utils/url.clj
index 88c9fea..30cbdf9 100644
--- a/src/weepinbell/utils/url.clj
+++ b/src/weepinbell/utils/url.clj
@@ -1,5 +1,7 @@
 (ns weepinbell.utils.url

-  (:import [java.net URL URI MalformedURLException URISyntaxException IDN])

+  (:import [java.net URL URI MalformedURLException URISyntaxException IDN]

+           [org.nibor.autolink LinkExtractor LinkType]

+           [java.util EnumSet])

   (:require [clojure.string :as string]))

 

 (defn valid-http-url? [url-string]

@@ -25,3 +27,44 @@
 (defn get-target [wm]

   (get-in wm [:webmention :target]))

 

+(defn- normlaize-path [^String path*]

+  (let [path (or path* "")

+        deslashed (if (and (> (count path) 1) (.endsWith path "/"))

+                    (subs path 0 (dec (count path))) 

+                    path)]

+   (str (.normalize (URI. deslashed)))))

+(defn- normalize-query [^String query]

+  (some-> query

+    (string/split #"&")

+    sort

+    (->> (string/join "&"))))

+(defn normalize

+  "Normalize URL by removing trailing slashes; removing anchor;

+   replacing . and ..; ordering query params."

+  [^String url]

+  (let [base   (URI. url)

+        scheme (.getScheme base)

+        auth   (.getAuthority base)

+        path   (normlaize-path (.getPath base))

+        query  (normalize-query (.getQuery base))]

+    (str scheme "://" auth path

+      (when (seq query) (str "?" query)))))

+

+(defn url= [& urls]

+  (apply = (map normalize urls)))

+

+(defn extract 

+  "Given plain text. Returns a vector of URLs that appears in it."

+  [^String text]

+  {:pre [(string? text)]

+   :post [#(every? valid-http-url? %)]}

+  (let [extractor (-> (LinkExtractor/builder)

+                      (.linkTypes (EnumSet/of LinkType/URL))

+                      .build)

+        indexes (->> (.extractLinks extractor text)

+                     (map (fn [link] 

+                            [(.getBeginIndex link)

+                             (.getEndIndex link)])))

+        urls (map #(subs text (first %) (last %)) indexes)]

+    (vec urls)))

+

diff --git a/test/weepinbell/receiver_test.clj b/test/weepinbell/receiver_test.clj
index a0524dc..827c078 100644
--- a/test/weepinbell/receiver_test.clj
+++ b/test/weepinbell/receiver_test.clj
@@ -13,7 +13,7 @@
 
 (ns weepinbell.receiver-test
   (:require [clojure.test :refer [deftest testing is]]
-            [clojure.core.async :refer [chan poll! <!!]]
+            [clojure.core.async :refer [chan poll!]]
             [weepinbell.receiver :refer [receive]]))
 
 ;; utilities
@@ -40,6 +40,9 @@
                   ["https://bob.blog/post/123" "ftp://alice.blog/file/x" (wrap-400-msg :invalid-url)]
                   ;; identical URLs 
                   ["https://alice.blog/article/abc" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc/" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc#anchor" "https://alice.blog/article/abc" (wrap-400-msg :identical)]
+                  ["https://alice.blog/article/abc?a=1&b=2" "https://alice.blog/article/abc?b=2&a=1" (wrap-400-msg :identical)]
                   ;; domain not allowed 
                   ["https://bob.blog/post/123" "https://chris.blog/archive/xxx" (wrap-400-msg :domain-not-allowed)]])
 ;; end define test cases
@@ -98,39 +101,3 @@
          doall)))
 ;; end in-queue test
 
-;; anchor removing test
-(deftest anchor-remove-test
-  (testing "Receiver should remove anchor in URL before pushing it into queue"
-    (let [cases [{:has    ["https://bob.blog/page/1#heading-a"
-                           "https://alice.blog/"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/"]}
-                 {:has    ["https://bob.blog/page/1"
-                           "https://alice.blog/archive/a#heading-1"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/page/1#heading-a"
-                           "https://alice.blog/archive/a#heading-1"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/page/1"
-                           "https://alice.blog/archive/a"]
-                  :expects ["https://bob.blog/page/1"
-                            "https://alice.blog/archive/a"]}
-                 {:has    ["https://bob.blog/?page=1&key=value#heading-1"
-                           "https://alice.blog/archive/a"]
-                  :expects ["https://bob.blog/?page=1&key=value"
-                            "https://alice.blog/archive/a"]}]]
-      (->> cases
-           (map (fn [case]
-                  (let [hs (get-in case [:has 0])
-                        ht (get-in case [:has 1])
-                        es (get-in case [:expects 0])
-                        et (get-in case [:expects 1])
-                        wm {:s hs :t ht}
-                        test-queue (chan)]
-                    (receive wm test-queue {:allowed-target-domains ["alice.blog"]})
-                    (let [{:keys [s t]} (<!! test-queue)]
-                      (is (= s es))
-                      (is (= t et))))))
-           doall))))
diff --git a/test/weepinbell/utils_url_test.clj b/test/weepinbell/utils_url_test.clj
new file mode 100644
index 0000000..732ba1c
--- /dev/null
+++ b/test/weepinbell/utils_url_test.clj
@@ -0,0 +1,56 @@
+(ns weepinbell.utils-url-test
+  (:require [weepinbell.utils.url :as url]
+            [clojure.test :refer [deftest testing is]]))
+
+(deftest valid-http-url-test
+  (testing "valid url, return true"
+    (is (url/valid-http-url? "https://example.com/page/abc?param1=a&param2=b#anchor"))
+    (is (url/valid-http-url? "http://www.example.com/")))
+  (testing "url not a string, returns false"
+    (is (not (url/valid-http-url? 1)))
+    (is (not (url/valid-http-url? [])))
+    (is (not (url/valid-http-url? {})))
+    (is (not (url/valid-http-url? '())))
+    (is (not (url/valid-http-url? :not-url)))
+    (is (not (url/valid-http-url? true))))
+  (testing "malformed url, return false"
+    (is (not (url/valid-http-url? "123")))
+    (is (not (url/valid-http-url? "example.com")))
+    (is (not (url/valid-http-url? "http//example.com")))
+    (is (not (url/valid-http-url? "http:example.com"))))
+  (testing "not the right scheme, return false"
+    (is (not (url/valid-http-url? "ftp://example.com"))))
+  (testing "localhost, return false"
+    (is (not (url/valid-http-url? "http://localhost")))))
+
+(deftest getter-tests
+  (testing "getting domain"
+    (is (= "www.example.com" (url/get-domain "https://www.example.com/index.php?page=abc")))
+    (is (= "example.com" (url/get-domain "https://example.com/page/abc#anchor"))))
+  (testing "getting path"
+    (is (= "/index.php" (url/get-path "https://www.example.com/index.php?page=abc")))
+    (is (= "/page/abc" (url/get-path "https://example.com/page/abc#anchor"))))
+  (testing "getting target"
+    (is (= "https://www.example.com" (url/get-target {:webmention {:target "https://www.example.com"}}))))) 
+
+(deftest url-equal-test 
+  (testing "URL equality"
+    (is (url/url= "https://example.com/./abc" "https://example.com/abc"))
+    (is (url/url= "https://example.com/page/../abc" "https://example.com/abc"))
+    (is (url/url= "https://example.com/page/abc" "https://example.com/page/abc/"))
+    (is (url/url= "https://example.com/page#heading-1" "https://example.com/page/"))
+    (is (url/url= "https://example.com/p?b=123&a=321" "https://example.com/p/?a=321&b=123"))
+    (is (url/url= "https://example.com/p?b=123&a=321" "https://example.com/p/?a=321&b=123"))))
+
+(defn- has-same-elements? [& colls]
+  (apply = (map set colls)))
+(deftest url-extract-test 
+  (testing "Extracting URLs from string"
+    (is (has-same-elements? 
+          ["https://test.com" "https://example.com"]
+          (url/extract "two links: https://test.com and https://example.com")))
+    (is (has-same-elements? 
+          ["http://www.example.com/index.php?page=123#anchor"]
+          (url/extract "complicated one (http://www.example.com/index.php?page=123#anchor)")))))
+
+
diff --git a/test/weepinbell/verifier_test.clj b/test/weepinbell/verifier_test.clj
index 5780abd..313a4e9 100644
--- a/test/weepinbell/verifier_test.clj
+++ b/test/weepinbell/verifier_test.clj
@@ -83,6 +83,14 @@
                            "/target" {:status 200}]
       (is (not (test-verify "http://localhost:38888/source"
                             "http://localhost:38888/target")))))
+  (testing "unsupported content type"
+    (with-webmention :new ["/source" {:status 200
+                                      :headers {"Content-Type" "application/json"}
+                                      :body "{\"message\": \"I mentioned alice's other post\n https://alice.blog/article/efg\"}"}
+                           "/target" {:status 200
+                                      :headers {"Content-Type" "text/plain"}}]
+      (is (not (test-verify "http://localhost:38888/source"
+                            "http://localhost:38888/target")))))
   (testing "responses have no status"
     (with-webmention :new ["/source" {:status nil
                                       :headers {"Content-Type" "text/plain"}