Add util for self-verification of VCS-based groups

Author: tobias

src/clojars/verification.clj

@@ -1,8 +1,10 @@
 (ns clojars.verification
   (:require
+   [clj-http.client :as http]
    [clojars.db :as db]
    [clojars.web.common :as common]
    [clojure.java.shell :as shell]
+   [clojure.set :as set]
    [clojure.string :as str]))
 
 (defn- get-txt-records
@@ -51,11 +53,15 @@
   [request msg]
   (assoc request :error msg))
 
-(defn- verify-group
-  [db request username group]
+(defn- verify-group*
+  [db username group]
   ;; will only create the group if it doesn't already exist
   (db/add-group db username group)
-  (db/verify-group! db username group)
+  (db/verify-group! db username group))
+
+(defn- verify-group
+  [db request username group]
+  (verify-group* db username group)
   (assoc request :message (format "The group '%s' has been verified." group)))
 
 (defn verify-group-by-TXT
@@ -95,7 +101,7 @@
           (err request "No valid verification TXT record found.")
 
           (not (= username username-from-txt))
-          (err request (format "Validation TXT record is for user '%s', not '%s' (you)."
+          (err request (format "The verification TXT record is for user '%s', not '%s' (you)."
                                username-from-txt username))
 
           group-verification
@@ -136,3 +142,56 @@
                                    (db/find-group-verifications-for-users-groups db username))]
         (verify-group db (assoc request :parent-group parent-group-name) username group)
         (err request "The group is not a subgroup of a verified group.")))))
+
+(defn- parse-url
+  [url]
+  (when (string? url)
+    (rest (re-find #"^https://(github|gitlab)\.com/([^/]+)/clojars-([^/]+)/?$" url))))
+
+(defn- repo-exists?
+  [url]
+  (try
+    (= 200 (:status (http/head url {:throw-exceptions false})))
+    (catch Exception _
+      false)))
+
+(defn- verify-groups
+  [db request username groups]
+  (if (= 1 (count groups))
+    (verify-group db request username (first groups))
+    (do
+      (doseq [group groups]
+        (verify-group* db username group))
+      ;; We will only have two groups here, so this format string should be fine
+      (assoc request :message (apply format "The groups '%s' & '%s' have been verified." groups)))))
+
+(defn verify-vcs-groups
+  "Verifies the net. and com. groups for a github/gitlab organization based on url."
+  [db {:as request :keys [username url]}]
+  (let [[provider org username-from-url] (parse-url url)
+        candidate-groups (set (for [tld ["com" "net"]] (format "%s.%s.%s" tld provider org)))
+        group-verifications (set (map
+                                  (fn [group-name]
+                                    (db/find-group-verification db group-name))
+                                  candidate-groups))
+        group-verification-names (set (map :group_name group-verifications))
+        groups-to-verify (set/difference candidate-groups group-verifications)]
+    (cond
+      (not provider)
+      (err request "The format of the URL is invalid.")
+
+      (= candidate-groups group-verification-names)
+      (let [{:keys [created verified_by]} (first group-verifications)]
+        (err request (format "Groups already verified by user '%s' on %s."
+                             verified_by
+                             (common/format-date created))))
+
+      (not (= username username-from-url))
+      (err request (format "The verification repo is for user '%s', not '%s' (you)."
+                           username-from-url username))
+
+      (not (repo-exists? url))
+      (err request "The verification repo does not exist.")
+
+      :else
+      (verify-groups db request username groups-to-verify))))

test/clojars/unit/verification_test.clj

@@ -1,5 +1,6 @@
 (ns clojars.unit.verification-test
   (:require
+   [clj-http.client :as http]
    [clojars.db :as db]
    [clojars.test-helper :as help]
    [clojars.verification :as nut]
@@ -70,7 +71,7 @@
     (help/with-TXT records
       (is (match?
            {:txt-records records
-            :error       "Validation TXT record is for user 'abc', not 'dantheman' (you)."}
+            :error       "The verification TXT record is for user 'abc', not 'dantheman' (you)."}
            (nut/verify-group-by-TXT help/*db* {:username "dantheman"
                                                :group   "com.foo"
                                                :domain  "foo.com"}))))))
@@ -170,3 +171,40 @@
         :parent-group "com.foo"}
        (nut/verify-group-by-parent-group help/*db* {:group    "com.foo.bar"
                                                     :username "dantheman"}))))
+
+(deftest verify-vcs-groups-with-invalid-url
+  (is (match?
+       {:error "The format of the URL is invalid."}
+       (nut/verify-vcs-groups help/*db* {:url "huh?"}))))
+
+(deftest verify-vcs-groups-with-url-not-matching-user
+  (is (match?
+       {:error "The verification repo is for user 'manthedan', not 'dantheman' (you)."}
+       (nut/verify-vcs-groups help/*db* {:url      "https://github.com/foo/clojars-manthedan"
+                                         :username "dantheman"}))))
+
+(deftest verify-vcs-groups-with-already-verified-groups
+  (db/verify-group! help/*db* "dantheman" "com.github.foo")
+  (db/verify-group! help/*db* "dantheman" "net.github.foo")
+  (is (match?
+       {:error (format "Groups already verified by user 'dantheman' on %s."
+                       (common/format-date (Date.)))}
+       (nut/verify-vcs-groups help/*db* {:url      "https://github.com/foo/clojars-dantheman"
+                                         :username "dantheman"}))))
+
+(deftest verify-vcs-groups-with-non-existent-repo
+  (doseq [responders [(constantly {:status 404})
+                      (constantly {:status 302})
+                      (fn [& _] (throw (ex-info "BOOM" {})))]]
+    (with-redefs [http/head responders]
+      (is (match?
+           {:error "The verification repo does not exist."}
+           (nut/verify-vcs-groups help/*db* {:url      "https://github.com/foo/clojars-dantheman"
+                                             :username "dantheman"}))))))
+
+(deftest verify-vcs-groups-when-the-repo-exists
+  (with-redefs [http/head (constantly {:status 200})]
+    (is (match?
+         {:message "The groups 'com.github.foo' & 'net.github.foo' have been verified."}
+         (nut/verify-vcs-groups help/*db* {:url      "https://github.com/foo/clojars-dantheman"
+                                           :username "dantheman"})))))