yogsototh/leiningen
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'improve-write-permissions'.

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

11
leiningen-core/src/leiningen/core/utils.clj
View file

@ -24,13 +24,16 @@
(URL. (str "http://" url)))))
(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]
`(let [f# (new File ~path)]
(if (.canWrite f#)
`(let [p# ~path
f# (new File p#)]
(if (or (and (.exists f#) (.canWrite f#))
(and (not (.exists f#)) (some-> f# .getParentFile .canWrite)))
(do ~@body)
(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
"Returns the first Clojure form in a file if it exists."

42
src/leiningen/repl.clj
View file

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