Merge pull request #45 from xeqi/uploads

act as maven repo supporting http uploads

project.clj

@@ -4,7 +4,7 @@
                  [org.apache.maven/maven-model "3.0.4"
                   :exclusions
                   [org.codehaus.plexus/plexus-utils]]
-                 [com.cemerick/pomegranate "0.0.10"]
+                 [com.cemerick/pomegranate "0.0.12"]
                  [compojure "1.0.1"]
                  [ring/ring-jetty-adapter "1.0.2"]
                  [hiccup "0.3.8"]
@@ -16,10 +16,12 @@
                  [org.apache.commons/commons-email "1.2"]
                  [net.cgrand/regex "1.0.1"]
                  [clj-time "0.3.8"]
-                 [com.cemerick/friend "0.0.7"]]
+                 [com.cemerick/friend "0.0.8"]]
   :profiles {:test {:resource-paths ["test-resources"]
                     :dependencies [[kerodon "0.0.4"]
-                                   [nailgun-shim "0.0.1"]]}}
+                                   [nailgun-shim "0.0.1"]]}
+             :dev {:dependencies [[kerodon "0.0.4"]
+                                  [nailgun-shim "0.0.1"]]}}
   :plugins [[lein-ring "0.6.3"]]
   :ring {:handler clojars.web/clojars-app}
   :aot [clojars.scp]

src/clojars/auth.clj

@@ -0,0 +1,19 @@
+(ns clojars.auth
+  (:require [cemerick.friend :as friend]
+            [clojars.db :refer [group-membernames]]))
+
+(defmacro with-account [body]
+  `(friend/authenticated (try-account ~body)))
+
+(defmacro try-account [body]
+  `(let [~'account (:username (friend/current-authentication))]
+     ~body))
+
+(defn authorized? [account group]
+  (let [names# (group-membernames group)]
+    (or (some #{account} names#) (empty? names#))))
+
+(defmacro require-authorization [group & body]
+  `(if (authorized? ~'account ~group)
+       (do ~@body)
+       (friend/throw-unauthorized friend/*identity*)))

src/clojars/db.clj

@@ -73,15 +73,6 @@
 (defn group-membernames [groupname]
   (map :user (select groups (fields :user) (where {:name groupname}))))
 
-(defn authed? [plaintext user]
-  (or (try (BCrypt/checkpw plaintext (:password user))
-           (catch java.lang.IllegalArgumentException _))))
-
-(defn auth-user [username-or-email plaintext]
-  (first (filter (partial authed? plaintext)
-                 (select users (where (or {:user username-or-email}
-                                          {:email username-or-email}))))))
-
 (defn jars-by-username [username]
   (select jars
           (where {:user username})
@@ -189,18 +180,32 @@
         (throw (Exception. (str "You don't have access to the "
                                 groupname " group.")))))))
 
-(defn- add-jar-helper [account jarmap]
-  (check-and-add-group account (:group jarmap))
+(defn- add-jar-helper [account {:keys [group name version
+                                       description homepage authors]}]
+  (check-and-add-group account group)
   (insert jars
-          (values {:group_name (:group jarmap)
-                   :jar_name   (:name jarmap)
-                   :version    (:version jarmap)
+          (values {:group_name group
+                   :jar_name   name
+                   :version    version
                    :user       account
                    :created    (get-time)
-                   :description (:description jarmap)
-                   :homepage   (:homepage jarmap)
+                   :description description
+                   :homepage   homepage
                    :authors    (str/join ", " (map #(.replace % "," "")
-                                                   (:authors jarmap)))})))
+                                                   authors))})))
+
+(defn update-jar [account {:keys [group name version
+                                  description homepage authors]}]
+  (update jars
+          (set-fields {:user       account
+                       :created    (get-time)
+                       :description description
+                       :homepage   homepage
+                       :authors    (str/join ", " (map #(.replace % "," "")
+                                                       authors))})
+          (where {:group_name group
+                  :jar_name   name
+                  :version    version})))
 
 (defn add-jar [account jarmap & [check-only]]
   (when-not (re-matches #"^[a-z0-9-_.]+$" (:name jarmap))

src/clojars/friend/registration.clj

@@ -0,0 +1,17 @@
+(ns clojars.friend.registration
+  (:require [cemerick.friend :as friend]
+            [cemerick.friend.workflows :as workflow]
+            [ring.util.response :refer [response]]
+            [clojars.web.user :refer [register-form validate-profile]]
+            [clojars.db :refer [add-user]]))
+
+(defn register [{:keys [email username password confirm ssh-key]}]
+  (if-let [errors (validate-profile nil email username password confirm ssh-key)]
+    (response (register-form errors email username ssh-key))
+    (do (add-user email username password ssh-key)
+        (workflow/make-auth {:identity username :username username}))))
+
+(defn workflow [{:keys [uri request-method params]}]
+  (when (and (= uri "/register")
+             (= request-method :post))
+    (register params)))

src/clojars/maven.clj

@@ -20,3 +20,6 @@
   [file]
   (with-open [reader (io/reader file)]
     (.read (MavenXpp3Reader.) reader)))
+
+
+(def pom-to-map (comp model-to-map read-pom))

src/clojars/repo.clj

@@ -0,0 +1,70 @@
+(ns clojars.repo
+  (:require [clojars.auth :refer [with-account require-authorization]]
+            [clojars.db :refer [find-jar add-jar update-jar]]
+            [clojars.config :refer [config]]
+            [clojars.maven :as maven]
+            [compojure.core :refer [defroutes PUT ANY]]
+            [compojure.route :refer [not-found]]
+            [clojure.java.io :as io]
+            [clojure.string :as string]
+            [ring.util.codec :as codec]
+            [ring.util.response :as response])
+  (:import java.io.StringReader))
+
+(defn save-to-file [sent-file input]
+  (-> sent-file
+      .getParentFile
+      .mkdirs)
+  (io/copy input sent-file))
+
+(defroutes routes
+  (PUT ["/:group/:artifact/:file"
+        :group #".+" :artifact #"[^/]+" :file #"maven-metadata\.xml[^/]*"]
+       {body :body {:keys [group artifact file]} :params}
+       (with-account
+         (require-authorization
+          (string/replace group "/" ".")
+          (save-to-file (io/file (config :repo) group artifact file)
+                        body)
+          {:status 201 :headers {} :body nil})))
+  (PUT ["/:group/:artifact/:version/:file"
+        :group #"[^\.]+" :artifact #"[^/]+" :version #"[^/]+"
+        :file #"[^/]+(\.pom|\.jar|\.sha1|\.md5)$"]
+       {body :body {:keys [group artifact version file]} :params}
+       (let [groupname (string/replace group "/" ".")]
+         (with-account
+           (require-authorization
+            groupname
+            (try
+              (let [info {:group groupname
+                          :name  artifact
+                          :version version}]
+                (if (.endsWith file ".pom")
+                  (let [contents (slurp body)
+                        pom-info (merge (maven/pom-to-map
+                                         (StringReader. contents)) info)]
+                    (if (find-jar groupname artifact version)
+                      (update-jar account pom-info)
+                      (add-jar account pom-info))
+                    (save-to-file (io/file (config :repo) group
+                                           artifact version file)
+                                  contents))
+                  (do
+                    (when-not (find-jar groupname artifact version)
+                      (add-jar account info))
+                    (save-to-file (io/file (config :repo) group
+                                           artifact version file)
+                                  body))))
+              {:status 201 :headers {} :body nil}
+              (catch Exception e
+                {:status 403 :headers {} :body (.getMessage e)}))))))
+  (PUT "*" _ {:status 400 :headers {}})
+  (not-found "Page not found"))
+
+(defn wrap-file [app dir]
+  (fn [req]
+    (if-not (= :get (:request-method req))
+      (app req)
+      (let [path (codec/url-decode (:path-info req))]
+        (or (response/file-response path {:root dir})
+            (app req))))))

src/clojars/scp.clj

@@ -76,11 +76,6 @@
 (defmacro printerr [& strs]
   `(.println (.err ~'ctx) (str ~@(interleave strs (repeat " ")))))
 
-(defn read-metadata [f default-group]
-  (let [model (maven/read-pom (:file f))
-        jarmap (maven/model-to-map model)]
-    [[model jarmap]]))
-
 (defn jar-names
   "Construct a few possible name variations a jar might have."
   [jarmap]
@@ -99,8 +94,8 @@
 
     (doseq [metafile metadata
             :when (not= (:name metafile) "maven-metadata.xml")
-            [model jarmap] (read-metadata metafile act-group)
-            :let [names (jar-names jarmap)]]
+            :let [jarmap (maven/pom-to-map (:file metafile))
+                  names (jar-names jarmap)]]
       (if-let [jarfile (some jarfiles names)]
         (do
           (.println (.err ctx) (str "\nDeploying " (:group jarmap) "/"

src/clojars/web.clj

@@ -2,10 +2,14 @@
   (:require [clojars.db :refer [group-membernames find-user add-member
                                 find-jar recent-versions count-versions
                                 find-user-by-user-or-email]]
+            [clojars.config :refer [config]]
+            [clojars.auth :refer [with-account try-account require-authorization]]
+            [clojars.repo :as repo]
+            [clojars.friend.registration :as registration]
             [clojars.web.dashboard :refer [dashboard index-page]]
             [clojars.web.search :refer [search]]
             [clojars.web.user :refer [profile-form update-profile show-user
-                                      register register-form
+                                      register-form
                                       forgot-password forgot-password-form]]
             [clojars.web.group :refer [show-group]]
             [clojars.web.jar :refer [show-jar show-versions]]
@@ -15,7 +19,7 @@
             [ring.middleware.file-info :refer [wrap-file-info]]
             [ring.middleware.resource :refer [wrap-resource]]
             [ring.util.response :refer [redirect status response]]
-            [compojure.core :refer [defroutes GET POST ANY]]
+            [compojure.core :refer [defroutes GET POST PUT ANY context]]
             [compojure.handler :refer [site]]
             [compojure.route :refer [not-found]]
             [cemerick.friend :as friend]
@@ -26,13 +30,6 @@
   (html [:h1 "Page not found"]
         [:p "Thundering typhoons!  I think we lost it.  Sorry!"]))
 
-(defmacro with-account [body]
-  `(friend/authenticated (try-account ~body)))
-
-(defmacro try-account [body]
-  `(let [~'account (:username (friend/current-authentication))]
-         ~body))
-
 (defroutes main-routes
   (GET "/search" {session :session params :params}
        (try-account
@@ -52,6 +49,7 @@
   (GET "/forgot-password" {params :params}
        (forgot-password-form))
   (friend/logout (ANY "/logout" request (ring.util.response/redirect "/")))
+
   (GET "/" {session :session params :params}
        (try-account
         (if account
@@ -67,17 +65,18 @@
         {session :session {groupname :groupname username :user} :params }
         (if-let [membernames (group-membernames groupname)]
           (try-account
-           (cond
-            (some #{username} membernames)
-            (show-group account groupname membernames "They're already a member!")
-            (and (some #{account} membernames)
-                 (find-user username))
-            (do (add-member groupname username)
-                (show-group account groupname
-                            (conj membernames username)))
-            :else
-            (show-group account groupname membernames (str "No such user: "
-                                                           (h username)))))
+           (require-authorization
+            groupname
+            (cond
+             (some #{username} membernames)
+             (show-group account groupname membernames "They're already a member!")
+             (find-user username)
+             (do (add-member groupname username)
+                 (show-group account groupname
+                             (conj membernames username)))
+             :else
+             (show-group account groupname membernames (str "No such user: "
+                                                            (h username))))))
           :next))
   (GET "/users/:username"  {session :session {username :username} :params}
        (if-let [user (find-user username)]
@@ -143,37 +142,41 @@
          (try-account
           (show-user account user))
          :next))
+  (PUT "*" _ {:status 405 :headers {} :body "Did you mean to use /repo?"})
   (ANY "*" {session :session}
        (not-found (html-doc (session :account)
                             "Page not found"
                             (not-found-doc)))))
 
-(defn registration [{:keys [uri request-method params]}]
-  (when (and (= uri "/register")
-             (= request-method :post))
-    (register params)))
-
-(def clojars-app
-  (site
-   (-> main-routes
-       (friend/authenticate
-        {:credential-fn
-         (partial creds/bcrypt-credential-fn
-                  (fn [id]
-                    (when-let [{:keys [user password]}
-                               (find-user-by-user-or-email id)]
-                      {:username user :password password})))
-         :workflows [(workflows/interactive-form)
-                     registration]
-         :login-uri "/login"
-         :default-landing-uri "/"})
-       (wrap-resource "public")
-       (wrap-file-info))))
-
-(comment
-  (require 'swank.swank)
-  (swank.swank/start-repl)
-
-  (find-jar "leiningen" "leiningen")
-  (def server (run-server {:port 8000} "/*" (servlet clojars-app)))
-  (.stop server))
+(defroutes clojars-app
+  (context "/repo" _
+           (-> repo/routes
+               (friend/authenticate
+                {:credential-fn
+                 (partial creds/bcrypt-credential-fn
+                          (fn [id]
+                            (when-let [{:keys [user password]}
+                                       (find-user-by-user-or-email id)]
+                              {:username user :password password})))
+                 :workflows [(workflows/http-basic :realm "clojars")]
+                 :unauthorized-handler
+                 (partial workflows/http-basic-deny "clojars")})
+               (repo/wrap-file (:repo config))))
+  (site (-> main-routes
+      (friend/authenticate
+       {:credential-fn
+        (partial creds/bcrypt-credential-fn
+                 (fn [id]
+                   (when-let [{:keys [user password]}
+                              (find-user-by-user-or-email id)]
+                     {:username user :password password})))
+        :workflows [(workflows/interactive-form)
+                    registration/workflow]
+        :login-uri "/login"
+        :default-landing-uri "/"
+        :unauthorized-handler
+        (fn [r]
+          (-> (redirect "/login")
+              (assoc-in [:session ::friend/unauthorized-uri] (:uri r))))})
+      (wrap-resource "public")
+      (wrap-file-info))))

src/clojars/web/group.clj

@@ -1,6 +1,7 @@
 (ns clojars.web.group
   (:require [clojars.web.common :refer [html-doc jar-link user-link error-list]]
             [clojars.db :refer [jars-by-groupname]]
+            [clojars.auth :refer [authorized?]]
             [hiccup.page-helpers :refer [unordered-list]]
             [hiccup.form-helpers :refer [form-to text-field submit-button]]))
 
@@ -12,7 +13,7 @@
     [:h2 "Members"]
     (unordered-list (map user-link membernames))
     (error-list errors)
-    (when (some #{account} membernames)
+    (when (authorized? account groupname)
       [:div {:class :add-member}
        (form-to [:post (str "/groups/" groupname)]
          (text-field "user")

src/clojars/web/login.clj

@@ -1,6 +1,5 @@
 (ns clojars.web.login
   (:require [clojars.web.common :refer [html-doc]]
-            [clojars.db :refer [auth-user]]
             [hiccup.page-helpers :refer [link-to]]
             [hiccup.form-helpers :refer [form-to label text-field
                                          password-field submit-button]]