Merge branch 'improve-write-permissions'.

This commit is contained in:
Jean Niklas L'orange 2014-12-02 13:40:08 +01:00
commit fade5c25d3
2 changed files with 33 additions and 20 deletions

View file

@ -24,13 +24,16 @@
(URL. (str "http://" url))))) (URL. (str "http://" url)))))
(defmacro with-write-permissions (defmacro with-write-permissions
"Runs body only if path is writeable" "Runs body only if path is writeable, or - if it does not already exist - can
be created."
[path & body] [path & body]
`(let [f# (new File ~path)] `(let [p# ~path
(if (.canWrite f#) f# (new File p#)]
(if (or (and (.exists f#) (.canWrite f#))
(and (not (.exists f#)) (some-> f# .getParentFile .canWrite)))
(do ~@body) (do ~@body)
(throw (java.io.IOException. (throw (java.io.IOException.
(str "Permission denied. Please check your access rights for " ~path)))))) (str "Permission denied. Please check your access rights for " p#))))))
(defn read-file (defn read-file
"Returns the first Clojure form in a file if it exists." "Returns the first Clojure form in a file if it exists."

View file

@ -15,6 +15,18 @@
[leiningen.trampoline :as trampoline] [leiningen.trampoline :as trampoline]
[reply.main :as reply])) [reply.main :as reply]))
(defn- repl-port-file-vector
"Returns the repl port file for this project as a vector."
[project]
(if-let [root (:root project)]
[root ".nrepl-port"]
[(user/leiningen-home) "repl-port"]))
(defn- repl-port-file-path
"Returns the repl port file path for this project."
[project]
(.getPath (apply io/file (repl-port-file-vector project))))
(defn lookup-opt [opt-key opts] (defn lookup-opt [opt-key opts]
(second (drop-while #(not= % opt-key) opts))) (second (drop-while #(not= % opt-key) opts)))
@ -160,19 +172,16 @@
:ack-port ~ack-port :ack-port ~ack-port
:handler ~(handler-for project)) :handler ~(handler-for project))
port# (:port server#) port# (:port server#)
repl-port-file# (apply io/file ~(if (:root project) repl-port-file# (apply io/file ~(repl-port-file-vector project))
[(:root project) ".nrepl-port"] ;; TODO 3.0: remove legacy repl port support.
[(user/leiningen-home) "repl-port"]))
legacy-repl-port# (if (.exists (io/file ~(:target-path project))) legacy-repl-port# (if (.exists (io/file ~(:target-path project)))
(io/file ~(:target-path project) "repl-port"))] (io/file ~(:target-path project) "repl-port"))]
(when ~start-msg? (when ~start-msg?
(println "nREPL server started on port" port# "on host" ~(:host cfg) (println "nREPL server started on port" port# "on host" ~(:host cfg)
(str "- nrepl://" ~(:host cfg) ":" port#))) (str "- nrepl://" ~(:host cfg) ":" port#)))
(utils/with-write-permissions (.getPath repl-port-file#) (spit (doto repl-port-file# .deleteOnExit) port#)
(spit (doto repl-port-file# .deleteOnExit) port#))
(when legacy-repl-port# (when legacy-repl-port#
(utils/with-write-permissions (.getPath legacy-repl-port#) (spit (doto legacy-repl-port# .deleteOnExit) port#))
(spit (doto legacy-repl-port# .deleteOnExit) port#)))
@(promise)) @(promise))
;; TODO: remove in favour of :injections in the :repl profile ;; TODO: remove in favour of :injections in the :repl profile
`(do ~(when-let [init-ns (init-ns project)] `(do ~(when-let [init-ns (init-ns project)]
@ -285,14 +294,15 @@ deactivated, but it can be overridden."
([project] (repl project ":start")) ([project] (repl project ":start"))
([project subcommand & opts] ([project subcommand & opts]
(let [project (project/merge-profiles (let [project (project/merge-profiles
project project
(project/profiles-with-matching-meta project :repl))] (project/profiles-with-matching-meta project :repl))]
(if (= subcommand ":connect") (if (= subcommand ":connect")
(client project (doto (connect-string project opts) (client project (doto (connect-string project opts)
(->> (main/info "Connecting to nREPL at")))) (->> (main/info "Connecting to nREPL at"))))
(let [cfg {:host (or (opt-host opts) (repl-host project)) (let [cfg {:host (or (opt-host opts) (repl-host project))
:port (or (opt-port opts) (repl-port project))}] :port (or (opt-port opts) (repl-port project))}]
(utils/with-write-permissions (repl-port-file-path project)
(case subcommand (case subcommand
":start" (if trampoline/*trampoline?* ":start" (if trampoline/*trampoline?*
(trampoline-repl project (:port cfg)) (trampoline-repl project (:port cfg))
@ -300,7 +310,7 @@ deactivated, but it can be overridden."
":headless" (apply eval/eval-in-project project ":headless" (apply eval/eval-in-project project
(server-forms project cfg (ack-port project) (server-forms project cfg (ack-port project)
true)) true))
(main/abort (str "Unknown subcommand " subcommand)))))))) (main/abort (str "Unknown subcommand " subcommand)))))))))
;; A note on testing the repl task: it has a number of modes of operation ;; A note on testing the repl task: it has a number of modes of operation
;; which need to be tested individually: ;; which need to be tested individually: