Merge branch 'improve-write-permissions'.
This commit is contained in:
commit
fade5c25d3
2 changed files with 33 additions and 20 deletions
|
@ -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."
|
||||||
|
|
|
@ -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:
|
||||||
|
|
Loading…
Reference in a new issue