(ns leiningen.deploy

"Build and deploy jar to remote repository."

(:require [cemerick.pomegranate.aether :as aether]

[leiningen.core.classpath :as classpath]

[leiningen.core.main :as main]

[leiningen.core.eval :as eval]

[leiningen.core.user :as user]

[leiningen.core.utils :as utils]

[clojure.java.io :as io]

[leiningen.pom :as pom]

[leiningen.jar :as jar]

[clojure.java.shell :as sh]

[clojure.string :as str]))

(defn- abort-message [message]

(cond (re-find #"Return code is 405" message)

(str message "\n" "Ensure you are deploying over SSL.")

(re-find #"Return code is 401" message)

(str message "\n" "See `lein help deploy` for an explanation of how to"

" specify credentials.")

:else message))

(defn add-auth-from-url

[[id settings]]

(let [url (utils/build-url id)

user-info (and url (.getUserInfo url))

[username password] (and user-info (.split user-info ":"))]

(if username

[id (assoc settings :username username :password password)]

[id settings])))

(defn add-auth-interactively [[id settings]]

(if (or (and (:username settings) (some settings [:password :passphrase

:private-key-file]))

(.startsWith (:url settings) "file://"))

[id settings]

(do

(when @utils/rebound-io?

(main/abort "No credentials found for" id "(did you mean `lein deploy clojars`?)"

"\nPassword prompts are not supported when ran after other"

"(potentially)\ninteractive tasks. Maybe setting up"

"credentials may be an idea?\n\nSee `lein help deploy` for an"

"explanation of how to specify credentials."))

(println "No credentials found for" id "(did you mean `lein deploy clojars`?)")

(println "See `lein help deploy` for how to configure credentials.")

(print "Username: ") (flush)

(let [username (read-line)

password (.readPassword (System/console) "%s"

(into-array ["Password: "]))]

[id (assoc settings :username username :password password)]))))

(defn- sanitize-repo-name [name]

(last (.split name "/")))

(defn repo-for [project name]

(let [settings (merge (get (into {} (:repositories project)) name)

(get (into {} (:deploy-repositories project)) name))]

(-> [(sanitize-repo-name name) (or settings {:url name})]

(classpath/add-repo-auth)

(add-auth-from-url)

(add-auth-interactively))))

(defn signing-args

"Produce GPG arguments for signing a file."

[file opts]

(let [key-spec (if-let [key (:gpg-key opts)]

["--default-key" key])]

`["--yes" "-ab" ~@key-spec "--" ~file]))

(defn sign

"Create a detached signature and return the signature file name."

[file opts]

(let [{:keys [err exit]} (apply user/gpg (signing-args file opts))]

(when-not (zero? exit)

(main/abort "Could not sign"

(str file "\n" err

"\nSee `lein help gpg` for how to setup gpg." )))

(str file ".asc")))

(defn signature-for-artifact [[coords artifact-file] opts]

{(apply concat

(update-in

(apply hash-map coords) [:extension]

#(str (or % "jar") ".asc")))

(sign artifact-file opts)})

(defn sign-for-repo?

"Generally sign artifacts for this repo?"

[repo]

(:sign-releases (second repo) true))

(defn signing-opts

"Extract signing options map from a project."

[project repo]

(merge (:signing project) (:signing (second repo))))

(defn files-for [project repo]

(let [signed? (sign-for-repo? repo)

artifacts (merge {[:extension "pom"] (pom/pom project)}

(jar/jar project))

sig-opts (signing-opts project repo)]

(if (and signed? (not (.endsWith (:version project) "-SNAPSHOT")))

(reduce merge artifacts (map #(signature-for-artifact % sig-opts)

artifacts))

artifacts)))

(defn warn-missing-metadata [project]

(doseq [key [:description :license :url]]

(when (or (nil? (project key)) (re-find #"FIXME" (str (project key))))

(main/info "WARNING: please set" key "in project.clj."))))

(defn- in-branches [branches]

(-> (sh/sh "git" "rev-parse" "--abbrev-ref" "HEAD")

:out

butlast

str/join

branches

not))

(defn ^:no-project-needed deploy

"Deploy jar and pom to remote repository.

([project]

(deploy project (if (pom/snapshot? project)

"snapshots"

"releases")))

([project repository]

(let [branches (set (:deploy-branches project))]

(when (and (seq branches)

(in-branches branches))

(apply main/abort "Can only deploy from branches listed in"

":deploy-branches:" branches)))

(warn-missing-metadata project)

(let [repo (repo-for project repository)

files (files-for project repo)]

(try

(main/debug "Deploying" files "to" repo)

(aether/deploy

:coordinates [(symbol (:group project) (:name project))

(:version project)]

:artifact-map files

:transfer-listener :stdout

:repository [repo])

(catch org.sonatype.aether.deployment.DeploymentException e

(when main/*debug* (.printStackTrace e))

(main/abort (abort-message (.getMessage e)))))))

([project repository identifier version & files]

(let [identifier (symbol identifier)

artifact-id (name identifier)

group-id (or (namespace identifier))

repo (repo-for project repository)

artifacts (for [f files]

[[:extension (if (= "pom.xml" (.getName (io/file f)))

"pom" (last (.split f "\\.")))] f])]

(main/debug "Deploying" files "to" repo)

(aether/deploy

:coordinates [(symbol group-id artifact-id) version]

:artifact-map (into {} artifacts)

:transfer-listener :stdout

:repository [repo]

:local-repo (:local-repo project)))))