Permalink
Browse files

Merge pull request #37 from xeqi/tests

tests / dependency updates
  • Loading branch information...
2 parents 4006346 + 2ae6b16 commit 5a9fbfcd7d7f953fdace3098bbea5d5cf0f07432 @ato ato committed Apr 5, 2012
View
@@ -1,7 +1,8 @@
*.class
-*.jar
*.swp
-#*
+\#*
+\.#*
+lib/
home
data/
native/
View
@@ -0,0 +1,3 @@
+language: clojure
+before_script:
+ - "mkdir data && sqlite3 data/test_db < clojars.sql"
View
@@ -1,20 +1,22 @@
-(defproject clojars-web "0.6.4"
+(defproject clojars-web "0.7.0-SNAPSHOT"
:aot [clojars.scp]
:main clojars.main
- :dependencies [[org.clojure/clojure "1.2.1"]
+ :dependencies [[org.clojure/clojure "1.3.0"]
[org.clojure/java.jdbc "0.1.3"]
[org.apache.maven/maven-ant-tasks "2.0.10"]
[org.apache.maven/maven-artifact-manager "2.2.1"]
[org.apache.maven/maven-model "2.2.1"]
[org.apache.maven/maven-project "2.2.1"]
- [compojure "0.5.2"]
- [ring/ring-jetty-adapter "0.3.1"]
- [hiccup "0.3.0"]
+ [compojure "1.0.1"]
+ [ring/ring-jetty-adapter "1.0.2"]
+ [hiccup "0.3.8"]
[cheshire "2.2.2"]
[org.mindrot/jbcrypt "0.3m"]
[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.6.2"]
+ [kerodon "0.0.4"]
+ [nailgun-shim "0.0.1"]]
:ring {:handler clojars.web/clojars-app})
View
@@ -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)
View
@@ -94,5 +94,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)))
View
@@ -9,13 +9,13 @@
:methods [#^{:static true}
[nailMain [com.martiansoftware.nailgun.NGContext] void]]))
-(def *max-line-size* 4096)
-(def *max-file-size* 20485760)
-(def *allowed-suffixes* #{"pom" "xml" "jar" "sha1" "md5"})
+(def max-line-size 4096)
+(def max-file-size 20485760)
+(def allowed-suffixes #{"pom" "xml" "jar" "sha1" "md5"})
(defn safe-read-line
([#^InputStream stream #^StringBuilder builder]
- (when (> (.length builder) *max-line-size*)
+ (when (> (.length builder) max-line-size)
(throw (IOException. "Line too long")))
(let [c (char (.read stream))]
@@ -53,11 +53,11 @@
fn (File. #^String path)
suffix (last (.split (.getName fn) "\\."))]
- (when (> size *max-file-size*)
+ (when (> size max-file-size)
(throw (IOException. (str "Upload too large. Maximum size is "
- *max-file-size* " bytes"))))
+ max-file-size " bytes"))))
- (when-not (*allowed-suffixes* suffix)
+ (when-not (allowed-suffixes suffix)
(throw (IOException. (str "." suffix
" files are not supported."))))
@@ -101,10 +101,11 @@
(do
(.println *err* (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 "
"http://clojars.org/"))
@@ -113,46 +114,45 @@
(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))
View
@@ -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
@@ -11,10 +11,10 @@
[clojars.web.common :only [html-doc]]
[clojars.web.login :only [login login-form]]
[hiccup.core :only [html h]]
- [ring.middleware.session :only [wrap-session]]
[ring.middleware.file :only [wrap-file]]
[ring.util.response :only [redirect]]
- [compojure.core :only [defroutes GET POST ANY]]))
+ [compojure.core :only [defroutes GET POST ANY]]
+ [compojure.handler :only [site]]))
(defn not-found-doc []
(html [:h1 "Page not found"]
@@ -59,12 +59,12 @@
(if account
(dashboard account)
(index-page account))))
- (GET ["/groups/:group", :group #"[^/]+"] {session :session {group "group"} :params }
+ (GET ["/groups/:group", :group #"[^/]+"] {session :session {group :group} :params }
(if-let [members (with-db (group-members group))]
(try-account
(show-group account group members))
:next))
- (POST ["/groups/:group", :group #"[^/]+"] {session :session {group "group" user "user"} :params }
+ (POST ["/groups/:group", :group #"[^/]+"] {session :session {group :group user :user} :params }
(if-let [members (with-db (group-members group))]
(try-account
(cond
@@ -79,35 +79,40 @@
(show-group account group members (str "No such user: "
(h user)))))
:next))
- (GET "/users/:username" {session :session {username "username"} :params}
+ (GET "/users/:username" {session :session {username :username} :params}
(if-let [user (with-db (find-user username))]
(try-account
(show-user account user))
:next))
- (GET ["/:jarname", :jarname #"[^/]+"] {session :session {jarname "jarname"} :params}
+ (GET ["/:jarname", :jarname #"[^/]+"] {session :session {jarname :jarname} :params}
(if-let [jar (with-db (find-canon-jar jarname))]
(try-account
(show-jar account jar))
:next))
(GET ["/:group/:jarname", :group #"[^/]+", :jarname #"[^/]+"]
- {session :session {group "group" jarname "jarname"} :params}
+ {session :session {group :group jarname :jarname} :params}
(if-let [jar (with-db (find-jar group jarname))]
(try-account
(show-jar account jar))
:next))
- (GET "/:user" {session :session {user "user"} :params}
+ (GET "/:user" {session :session {user :user} :params}
(if-let [user (with-db (find-user user))]
(try-account
(show-user account user))
:next))
(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
+ (site
(-> main-routes
- wrap-session
(wrap-file "public")
- db-middleware))
+ db-middleware)))
(comment
(require 'swank.swank)
Oops, something went wrong.

0 comments on commit 5a9fbfc

Please sign in to comment.