Implement repo directory listings

.circleci/config.yml

@@ -11,6 +11,11 @@ jobs:
           - POSTGRES_USER=clojars
           - POSTGRES_PASSWORD=clojars
           - POSTGRES_DB=clojars
+      - image: minio/minio:RELEASE.2023-04-20T17-56-55Z
+        command: server /data
+        environment:
+          MINIO_ROOT_USER: fake-access-key
+          MINIO_ROOT_PASSWORD: fake-secret-key
     working_directory: ~/clojars
     steps:
       - checkout

docker-compose.yml

@@ -20,3 +20,12 @@ services:
       - POSTGRES_DB=clojars
     volumes:
       - ./data/test-postgres:/var/lib/postgresql/data
+  minio:
+    image: minio/minio:RELEASE.2023-04-20T17-56-55Z
+    command: server /data --console-address ":9090"
+    ports:
+      - "9000:9000"
+      - "9090:9090"
+    environment:
+      MINIO_ROOT_USER: fake-access-key
+      MINIO_ROOT_PASSWORD: fake-secret-key

src/clojars/routes/repo_listing.clj

@@ -0,0 +1,23 @@
+(ns clojars.routes.repo-listing
+  (:require
+   [clojars.web.repo-listing :as repo-listing]
+   [compojure.core :as compojure :refer [GET HEAD]]
+   [ring.util.response :as ring.response]))
+
+(defn- repo-listing
+  [repo-bucket path]
+  (-> (repo-listing/index repo-bucket path)
+      (ring.response/response)
+      (ring.response/content-type "text/html;charset=utf-8")
+      ;; Instruct fastly to cache this result for 15 minutes
+      (ring.response/header "Cache-Control" "s-maxage=900")))
+
+(defn routes
+  [repo-bucket]
+  (compojure/routes
+   (GET ["/repo-listing"]
+        {{:keys [path]} :params}
+        (repo-listing repo-bucket path))
+   (HEAD ["/repo-listing"]
+         {{:keys [path]} :params}
+         (repo-listing repo-bucket path))))

src/clojars/s3.clj

@@ -2,17 +2,21 @@
   (:require
    [clojure.java.io :as io]
    [clojure.string :as str]
-   [cognitect.aws.client.api :as aws])
+   [cognitect.aws.client.api :as aws]
+   [cognitect.aws.credentials :as credentials])
   (:import
    (java.io
     ByteArrayInputStream)
+   (java.util
+    Date)
    (org.apache.commons.io
     IOUtils)))
 
 (defprotocol S3Bucket
   (-delete-object [client key])
   (-get-object-details [client key])
   (-get-object-stream [client key])
+  (-list-entries [client prefix])
   (-list-objects [client prefix])
   (-put-object [client key stream opts]))
 
@@ -23,26 +27,27 @@
     v))
 
 (defn- list-objects-chunk
-  [client bucket-name prefix marker]
+  [client bucket-name prefix delimeter continuation-token]
   (let [request (cond-> {:Bucket bucket-name}
-                  prefix (assoc :Prefix prefix)
-                  marker (assoc :Marker marker))]
+                  continuation-token (assoc :ContinuationToken continuation-token)
+                  delimeter          (assoc :Delimiter delimeter)
+                  prefix             (assoc :Prefix prefix))]
     (throw-on-error
      (aws/invoke client
-                 {:op :ListObjects
+                 {:op :ListObjectsV2
                   :request request}))))
 
 (defn- list-objects-seq
-  "Generates a lazy seq of objects, chunked by the API's paging."
-  [client bucket-name prefix marker]
-  (let [{:keys [Contents IsTruncated]}
-        (list-objects-chunk client bucket-name prefix marker)]
+  "Generates a lazy seq of list-objects results, chunked by the API's paging."
+  [client bucket-name {:as opts :keys [continuation-token delimeter prefix]}]
+  (let [{:as result :keys [IsTruncated NextContinuationToken]}
+        (list-objects-chunk client bucket-name prefix delimeter continuation-token)]
     (if IsTruncated
       (lazy-seq
-       (concat Contents
-               (list-objects-seq client bucket-name prefix
-                                 (-> Contents last :Key))))
-      Contents)))
+       (cons result
+             (list-objects-seq client bucket-name
+                               (assoc opts :continuation-token NextContinuationToken))))
+      [result])))
 
 (defn- strip-etag
   "ETags from the s3 api are wrapped in \"s"
@@ -82,8 +87,18 @@
          (throw-on-error)
          :Body))
 
+  (-list-entries [_ prefix]
+    (sequence
+     (mapcat #(concat (:CommonPrefixes %) (map strip-etag (:Contents %))))
+     (list-objects-seq s3 bucket-name {:delimeter "/"
+                                       :prefix prefix})))
+
   (-list-objects [_ prefix]
-    (map strip-etag (list-objects-seq s3 bucket-name prefix nil)))
+    (sequence
+     (comp
+      (mapcat :Contents)
+      (map strip-etag))
+     (list-objects-seq s3 bucket-name {:prefix prefix})))
 
   (-put-object [_ key stream opts]
     (->> {:op :PutObject
@@ -95,13 +110,29 @@
          (throw-on-error))))
 
 (defn s3-client
-  [bucket]
-  {:pre [(not (str/blank? bucket))]}
-  ;; Credentials are derived from the instance's role and region comes from the
-  ;; aws.region property, so we don't have to set either here.
-  (->S3Client (doto (aws/client {:api :s3})
-                (aws/validate-requests true))
-              bucket))
+  ;; Credentials are derived from the instance's role when running in
+  ;; production and region comes from the aws.region property, so we don't have
+  ;; to set either here.
+  ([bucket]
+   (s3-client bucket nil))
+  ;; This arity is only used directly in testing, where we use minio via docker, and we have
+  ;; to override the endpoint and provide credentials
+  ([bucket {:keys [credentials endpoint region]}]
+   {:pre [(not (str/blank? bucket))]}
+   (->S3Client
+    (doto (aws/client
+           (cond-> {:api :s3}
+             credentials (assoc :credentials-provider (credentials/basic-credentials-provider credentials))
+             endpoint    (assoc :endpoint-override endpoint)
+             region      (assoc :region region)))
+      (aws/validate-requests true))
+    bucket)))
+
+(defn- mock-object-entry
+  [k bytes]
+  {:Key          k
+   :Size         (count bytes)
+   :LastModified (Date.)})
 
 (defrecord MockS3Client [state]
   S3Bucket
@@ -113,10 +144,27 @@
   (-get-object-stream [_ key]
     (when-let [data (get @state key)]
       (ByteArrayInputStream. data)))
-  (-list-objects [_ prefix]
+  (-list-entries [_ prefix]
     (->> (keys @state)
-         (filter (fn [k] (if prefix (.startsWith k prefix) true)))
-         (map (fn [k] {:Key k}))))
+         (filter (fn [k]
+                   (if prefix
+                     (.startsWith k prefix)
+                     true)))
+         (map (fn [k]
+                (let [k-sans-prefix (if prefix
+                                      (subs k (count prefix))
+                                      k)
+                      [k-segment & more] (str/split k-sans-prefix #"/")]
+                  (if more
+                    {:Prefix (format "%s%s/" (or prefix "") k-segment)}
+                    (mock-object-entry k (get @state k))))))
+         (distinct)))
+  (-list-objects [_ prefix]
+    (into []
+          (comp
+           (filter (fn [k] (if prefix (.startsWith k prefix) true)))
+           (map (fn [k] (mock-object-entry k (get @state k)))))
+          (keys @state)))
   (-put-object [_ key stream _opts]
     (swap! state assoc key (IOUtils/toByteArray stream))))
 
@@ -139,6 +187,17 @@
   [s3 key]
   (-get-object-stream s3 key))
 
+(defn list-entries
+  "Lists the entries in the bucket at the level defined by prefix.
+
+  Returns a sequence of intermixed prefix maps (of the form {:Prefix \"some/string/\"})
+  and object list maps (of the form {:Key \"a-key\", :Size 123, ...}, same as
+  `list-objects`).
+
+  This is used to generate directory listings."
+  [s3 prefix]
+  (-list-entries s3 prefix))
+
 (defn list-objects
   ([s3]
    (list-objects s3 nil))

src/clojars/system.clj

@@ -91,7 +91,7 @@
         (component/system-using
          {:app           [:clojars-app]
           :clojars-app   [:db :github :gitlab :error-reporter :http-client
-                          :mailer :stats :search :storage]
+                          :mailer :repo-bucket :stats :search :storage]
           :http          [:app]
           :notifications [:db :mailer]
           :storage       [:error-reporter :repo-bucket]}))))

src/clojars/web.clj

@@ -15,6 +15,7 @@
    [clojars.routes.artifact :as artifact]
    [clojars.routes.group :as group]
    [clojars.routes.repo :as repo]
+   [clojars.routes.repo-listing :as repo-listing]
    [clojars.routes.session :as session]
    [clojars.routes.token :as token]
    [clojars.routes.token-breach :as token-breach]
@@ -24,7 +25,7 @@
    [clojars.web.common :refer [html-doc]]
    [clojars.web.dashboard :refer [dashboard index-page]]
    [clojars.web.safe-hiccup :refer [raw]]
-   [clojars.web.search :refer [search]]
+   [clojars.web.search :as search]
    [clojure.java.io :as io]
    [compojure.core :refer [ANY context GET PUT routes]]
    [compojure.route :refer [not-found]]
@@ -46,51 +47,54 @@
                :error-message "The page query parameter must be an integer."
                :status 400})))))
 
-(defn- main-routes [db stats search-obj mailer]
-  (routes
-   (GET "/" _
-        (try-account
-         #(if %
-            (dashboard db %)
-            (index-page db stats %))))
-   (GET "/search" {:keys [params]}
-        (try-account
-         #(let [validated-params (if (:page params)
-                                   (assoc params :page (try-parse-page (:page params)))
-                                   params)]
-            (search search-obj % validated-params))))
-   (GET "/projects" {:keys [params]}
-        (try-account
-         #(let [validated-params (if (:page params)
-                                   (assoc params :page (try-parse-page (:page params)))
-                                   params)]
-            (browse db % validated-params))))
-   (GET "/security" []
-        (try-account
-         #(html-doc "Security" {:account %}
-                    (raw (slurp (io/resource "security.html"))))))
-   (GET "/dmca" []
-        (try-account
-         #(html-doc "DMCA" {:account %}
-                    (raw (slurp (io/resource "dmca.html"))))))
-   session/routes
-   (group/routes db)
-   (artifact/routes db stats)
-   ;; user routes must go after artifact routes
-   ;; since they both catch /:identifier
-   (user/routes db mailer)
-   (verify/routes db)
-   (token/routes db)
-   (api/routes db stats)
-   (GET "/error" _ (throw (Exception. "What!? You really want an error?")))
-   (PUT "*" _ {:status 405 :headers {} :body "Did you mean to use /repo?"})
-   (ANY "*" _
-        (try-account
-         #(not-found
-           (html-doc "Page not found" {:account %}
-                     [:div.small-section
-                      [:h1 "Page not found"]
-                      [:p "Thundering typhoons!  I think we lost it.  Sorry!"]]))))))
+(defn- main-routes
+  [{:as _system :keys [db mailer repo-bucket search stats]}]
+  (let [db (:spec db)]
+    (routes
+     (GET "/" _
+          (try-account
+           #(if %
+              (dashboard db %)
+              (index-page db stats %))))
+     (GET "/search" {:keys [params]}
+          (try-account
+           #(let [validated-params (if (:page params)
+                                     (assoc params :page (try-parse-page (:page params)))
+                                     params)]
+              (search/search search % validated-params))))
+     (GET "/projects" {:keys [params]}
+          (try-account
+           #(let [validated-params (if (:page params)
+                                     (assoc params :page (try-parse-page (:page params)))
+                                     params)]
+              (browse db % validated-params))))
+     (GET "/security" []
+          (try-account
+           #(html-doc "Security" {:account %}
+                      (raw (slurp (io/resource "security.html"))))))
+     (GET "/dmca" []
+          (try-account
+           #(html-doc "DMCA" {:account %}
+                      (raw (slurp (io/resource "dmca.html"))))))
+     session/routes
+     (repo-listing/routes repo-bucket)
+     (group/routes db)
+     (artifact/routes db stats)
+     ;; user routes must go after artifact routes
+     ;; since they both catch /:identifier
+     (user/routes db mailer)
+     (verify/routes db)
+     (token/routes db)
+     (api/routes db stats)
+     (GET "/error" _ (throw (Exception. "What!? You really want an error?")))
+     (PUT "*" _ {:status 405 :headers {} :body "Did you mean to use /repo?"})
+     (ANY "*" _
+          (try-account
+           #(not-found
+             (html-doc "Page not found" {:account %}
+                       [:div.small-section
+                        [:h1 "Page not found"]
+                        [:p "Thundering typhoons!  I think we lost it.  Sorry!"]])))))))
 
 (def ^:private defaults-config
   (-> ring-defaults/secure-site-defaults
@@ -102,14 +106,13 @@
       (dissoc :session)))
 
 (defn clojars-app
-  [{:keys [db
+  [{:as system
+    :keys [db
            error-reporter
            http-client
            github
            gitlab
-           mailer
            search
-           stats
            storage]}]
   (let [db (:spec db)]
     (routes
@@ -131,7 +134,7 @@
      (-> (token-breach/routes db)
          (wrap-exceptions error-reporter)
          (log/wrap-request-context))
-     (-> (main-routes db stats search mailer)
+     (-> (main-routes system)
          (friend/authenticate
           {:credential-fn (auth/password-credential-fn db)
            :workflows [(auth/interactive-form-with-mfa-workflow)