Create test suite

Add travis-ci.
Use kerodon for integration tests.
Some test fake an scp request and jump straight to scp/nail using
nailgun-shim.
Some src changes were required to make testable and test pass.

.gitignore

@@ -1,7 +1,8 @@
 *.class
-*.jar
 *.swp
-#*
+\#*
+\.#*
+lib/
 home
 data/
 native/

.travis.yml

@@ -0,0 +1,3 @@
+language: clojure
+before_script: 
+  - "mkdir data && sqlite3 data/test_db < clojars.sql"

project.clj

@@ -15,6 +15,9 @@
                  [org.clojars.ato/nailgun "0.7.1"]
                  [org.xerial/sqlite-jdbc "3.6.17"]
                  [org.apache.commons/commons-email "1.2"]]
-  :dev-dependencies [[lein-ring "0.4.5"]]
+  :dev-dependencies [[lein-ring "0.4.5"]
+                     [enlive "1.0.0"]
+                     [kerodon "0.0.1-SNAPSHOT"]
+                     [nailgun-shim "0.0.1"]]
   :ring {:handler clojars.web/clojars-app})
 

src/clojars/db.clj

@@ -34,6 +34,9 @@
   [n]
   (apply str (repeatedly n #(rand-nth constituent-chars))))
 
+(defn ^:dynamic get-time []
+  (Date.))
+
 (defn write-key-file [path]
   (locking (:key-file config)
    (let [new-file (File. (str path ".new"))]
@@ -47,15 +50,13 @@
                             "\n")))))
      (.renameTo new-file (File. path)))))
 
-(defn db-middleware
-  [handler]
-  (fn [request]
-    (sql/with-connection (:db config) (handler request))))
-
 (defmacro with-db
   [& body]
-  `(sql/with-connection (:db config)
-     ~@body))
+  ;;TODO does connection sharing break something when deployed?
+  `(if (sql/find-connection)
+     (do ~@body)
+     (sql/with-connection (:db config)
+       ~@body)))
 
 (defn bcrypt [s]
   (BCrypt/hashpw s (BCrypt/gensalt (:bcrypt-work-factor config))))
@@ -90,7 +91,7 @@
 
 (defn auth-user [user plaintext]
   (sql/with-query-results rs
-      ["select * from users where (user = ? or email = ?)" user user]
+    ["select * from users where (user = ? or email = ?)" user user]
     (first (filter (partial authed? plaintext) rs))))
 
 (defn jars-by-user [user]
@@ -100,40 +101,41 @@
 
 (defn jars-by-group [group]
   (sql/with-query-results rs [(str "select * from jars where "
-                               "group_name = ? group by jar_name")
-                          group]
+                                   "group_name = ? group by jar_name")
+                              group]
     (vec rs)))
 
 (defn recent-jars []
   (sql/with-query-results rs
       [(str "select * from jars group by group_name, jar_name "
             "order by created desc limit 5")]
-    (vec rs)))
+      (vec rs)))
 
 (defn find-canon-jar [jarname]
   (sql/with-query-results rs
       [(str "select * from jars where "
             "jar_name = ? and group_name = ? "
             "order by created desc limit 1")
        jarname jarname]
-    (first rs)))
+      (first rs)))
 
 (defn find-jar
   ([jarname]
-     (sql/with-query-results rs [(str "select * from jars where "
-                                  "jar_name = ?") jarname]
+     (sql/with-query-results rs
+       [(str "select * from jars where jar_name = ?") jarname]
        (first rs)))
   ([group jarname]
-      (sql/with-query-results rs [(str "select * from jars where group_name = ? and "
-                                   "jar_name = ? order by created desc "
-                                   "limit 1") group jarname]
-        (first rs))))
+     (sql/with-query-results rs
+       [(str "select * from jars where group_name = ? and "
+             "jar_name = ? order by created desc "
+             "limit 1") group jarname]
+       (first rs))))
 
 (defn add-user [email user password ssh-key]
   (sql/insert-values :users
                      ;; TODO: remove salt field
                      [:email :user :password :salt :ssh_key :created]
-                     [email user (bcrypt password) "" ssh-key (Date.)])
+                     [email user (bcrypt password) "" ssh-key (get-time)])
   (sql/insert-values :groups
                      [:name :user]
                      [(str "org.clojars." user) user])
@@ -169,21 +171,19 @@
   (when-not (re-matches #"^[a-z0-9-_.]+$" (:name jarmap))
     (throw (Exception. (str "Jar names must consist solely of lowercase "
                             "letters, numbers, hyphens and underscores."))))
-
-  (sql/with-connection (:db config)
-    (sql/transaction
+  (sql/transaction
      (when check-only (sql/set-rollback-only))
      (check-and-add-group account (:group jarmap) (:name jarmap))
      (sql/insert-records :jars
                          {:group_name (:group jarmap)
                           :jar_name   (:name jarmap)
                           :version    (:version jarmap)
                           :user       account
-                          :created    (Date.)
+                          :created    (get-time)
                           :description (:description jarmap)
                           :homepage   (:homepage jarmap)
                           :authors    (str/join ", " (map #(.replace % "," "")
-                                                          (:authors jarmap)))}))))
+                                                          (:authors jarmap)))})))
 
 (defn quote-hyphenated
   "Wraps hyphenated-words in double quotes."
@@ -196,7 +196,7 @@
   (sql/with-query-results rs
       [(str "select jar_name, group_name from search where "
             "content match ? "
-	    "order by rowid desc "
+            "order by rowid desc "
             "limit 100 "
             "offset ?")
        (quote-hyphenated query)

src/clojars/maven.clj

@@ -21,7 +21,11 @@
 ;; TODO: find out if it's safe to just leave these hanging around like
 ;; this
 (def embedder (doto (Embedder.) (.start)))
-(def container (.getContainer embedder))
+(def container (let [container (.getContainer embedder)]
+                 (-> container
+                     (.getLoggerManager)
+                     (.setThreshold org.codehaus.plexus.logging.Logger/LEVEL_DISABLED))
+                 container))
 
 (defn model-to-map [model]
   {:name (.getArtifactId model)
@@ -94,5 +98,7 @@
 (defn deploy-model [jarfile model repo-path]
   (.deploy
    (.lookup container ArtifactDeployer/ROLE)
-   jarfile (make-artifact model) (make-repo "clojars" repo-path)
+   jarfile
+   (make-artifact model)
+   (make-repo "clojars" repo-path)
    (make-local-repo)))

src/clojars/scp.clj

@@ -99,60 +99,60 @@
             :let [names (jar-names jarmap)]]
       (if-let [jarfile (some jarfiles names)]
         (do
-          (.println *err* (str "\nDeploying " (:group jarmap) "/"
+          (.println (.err ctx) (str "\nDeploying " (:group jarmap) "/"
                                (:name jarmap) " " (:version jarmap)))
-          (db/add-jar account jarmap true)
-          (maven/deploy-model jarfile model
-                              (str "file://" (:repo config)))
-          (db/add-jar account jarmap))
+          (db/with-db
+            (db/add-jar account jarmap true)
+            (maven/deploy-model jarfile model
+                                (.toString (.toURI (File. (:repo config)))))
+            (db/add-jar account jarmap)))
         (throw (Exception. (str "You need to give me one of: " names)))))
-    (.println *err* (str "\nSuccess! Your jars are now available from "
+    (.println (.err ctx) (str "\nSuccess! Your jars are now available from "
                          "http://clojars.org/"))
     (.flush (.err ctx))))
 
 (defn nail [#^NGContext ctx]
   (let [old-out System/out]
     (try
-     (System/setOut (.err ctx))
-     (let [in (.in ctx)
-           err (.err ctx)
-           out (.out ctx)
-           account (first (.getArgs ctx))]
-
-       (when-not account
-         (throw (Exception. "I don't know who you are!")))
-
-       (doto (.err ctx)
-         (.println (str "Welcome to Clojars, " account "!"))
-         (.flush))
-
-       (loop [files [], okay true]
-         (when (> (count files) 100)
-           (throw (IOException. "Too many files uploaded at once")))
-
-         (when okay
-           (send-okay ctx))
-
-         (let [cmd (.read in)]
-           (if (= -1 cmd)
-             (finish-deploy ctx files)
-             (let [cmd (char cmd)]
-               ;; TODO: use core.match
-               (condp = cmd
-                   (char 0)      (recur files false)
-                   \C            (recur (conj files (scp-copy ctx)) true)
-                   \D            (do (safe-read-line in) (recur files true))
-                   \T            (do (safe-read-line in) (recur files true))
-                   \E            (do (safe-read-line in) (recur files true))
-                   (throw (IOException. (str "Unknown scp command: '"
-                                             (int cmd) "'")))))))))
-
-     (catch Throwable t
-       ;; (.printStackTrace t *err*)
-       (.println (.err ctx) (str "Error: " (.getMessage t)))
-       (.flush (.err ctx))
-       (throw t))
-     (finally (System/setOut old-out)))))
+      (System/setOut (.err ctx))
+      (let [in (.in ctx)
+            err (.err ctx)
+            account (first (.getArgs ctx))]
+
+        (when-not account
+          (throw (Exception. "I don't know who you are!")))
+
+        (doto (.err ctx)
+          (.println (str "Welcome to Clojars, " account "!"))
+          (.flush))
+
+        (loop [files [], okay true]
+          (when (> (count files) 100)
+            (throw (IOException. "Too many files uploaded at once")))
+
+          (when okay
+            (send-okay ctx))
+
+          (let [cmd (.read in)]
+            (if (= -1 cmd)
+              (finish-deploy ctx files)
+              (let [cmd (char cmd)]
+                ;; TODO: use core.match
+                (condp = cmd
+                  (char 0)      (recur files false)
+                  \C            (recur (conj files (scp-copy ctx)) true)
+                  \D            (do (safe-read-line in) (recur files true))
+                  \T            (do (safe-read-line in) (recur files true))
+                  \E            (do (safe-read-line in) (recur files true))
+                  (throw (IOException. (str "Unknown scp command: '"
+                                            (int cmd) "'")))))))))
+
+      (catch Throwable t
+        ;; (.printStackTrace t *err*)
+        (.println (.err ctx) (str "Error: " (.getMessage t)))
+        (.flush (.err ctx))
+        (throw t))
+      (finally (System/setOut old-out)))))
 
 (defn -nailMain [context]
   (nail context))

src/clojars/web.clj

@@ -1,6 +1,6 @@
 (ns clojars.web
   (:use [clojars.db :only [with-db group-members find-user add-member
-                           find-jar find-canon-jar db-middleware]]
+                           find-jar find-canon-jar]]
         [clojars.web.dashboard :only [dashboard index-page]]
         [clojars.web.search :only [search]]
         [clojars.web.user :only [profile-form update-profile show-user
@@ -84,6 +84,7 @@
        (try-account
         (show-user account user))
        :next))
+
   (GET ["/:jarname", :jarname #"[^/]+"] {session :session {jarname "jarname"} :params}
     (if-let [jar (with-db (find-canon-jar jarname))]
       (try-account
@@ -103,6 +104,11 @@
   (ANY "*" {session :session}
     (html-doc (session :account) "Page not found" (not-found-doc))))
 
+(defn db-middleware
+  [handler]
+  (fn [request]
+    (with-db (handler request))))
+
 (def clojars-app
    (-> main-routes
        wrap-session

src/clojars/web/user.clj

@@ -56,7 +56,7 @@
                           (seq (group-members user))))
                  "Username is already taken")
       (conj-when (not (re-matches #"[a-z0-9_-]+" user))
-                 (str "Usernames must consist only of lowercase "
+                 (str "Username must consist only of lowercase "
                       "letters, numbers, hyphens and underscores."))
       (conj-when (not (or (blank? ssh-key)
                           (valid-ssh-key? ssh-key)))
@@ -108,9 +108,12 @@
     [:h1 "Forgot password?"]
     (form-to [:post "/forgot-password"]
       (label :email-or-username "Email or username:")
-      (text-field :email-or-username "")
+      (text-field :email-or-username)
       (submit-button "Send new password"))))
 
+(defn ^{:dynamic true} send-out [email]
+  (.send email))
+
 ;; TODO: move this to another file?
 (defn send-mail [to subject message]
   (let [{:keys [hostname username password port ssl from]} (config/config :mail)
@@ -124,8 +127,8 @@
                (.setSubject subject)
                (.setMsg message))]
     (when (and username password)
-      (.setAuthentication username password))
-    (.send mail)))
+      (.setAuthentication mail username password))
+    (send-out mail)))
 
 (defn forgot-password [{email-or-username "email-or-username"}]
   (when-let [user (find-user-by-user-or-email email-or-username)]

test-resources/config.clj

@@ -0,0 +1,13 @@
+{:db {:classname "org.sqlite.JDBC"
+      :subprotocol "sqlite"
+      :subname "data/test_db"}
+ :key-file "data/test_authorized_keys"
+ :repo "data/test_repo"
+ :bcrypt-work-factor 12
+ :mail {:hostname "smtp.gmail.com"
+        :from "noreply@clojars.org"
+        :username "clojars@pupeno.com"
+        :password "fuuuuuu"
+        :port 465 ; If you change ssl to false, the port might not be effective, search for .setSSL and .setSslSmtpPort
+        :ssl true}}
+

test-resources/fake.jar

@@ -0,0 +1 @@
+bad jar

test-resources/fake.pom

@@ -0,0 +1,15 @@
+<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
+  <modelVersion>4.0.0</modelVersion>
+
+  <groupId>fake</groupId>
+  <artifactId>fake</artifactId>
+  <version>0.0.1</version>
+  <packaging>jar</packaging>
+
+  <name>asdf</name>
+
+  <properties>
+    <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
+  </properties>
+</project>

test-resources/test.jar

@@ -0,0 +1 @@
+bad jar

test-resources/test.pom

@@ -0,0 +1,15 @@
+<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
+  <modelVersion>4.0.0</modelVersion>
+
+  <groupId>fake</groupId>
+  <artifactId>test</artifactId>
+  <version>0.0.1</version>
+  <packaging>jar</packaging>
+
+  <name>asdf</name>
+
+  <properties>
+    <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
+  </properties>
+</project>