(ns leiningen.core.classpath
  (:require [cemerick.pomegranate.aether :as aether]
            [cemerick.pomegranate :as pomegranate]
            [clojure.java.io :as io]
            [clojure.string :as str]
            [leiningen.core.user :as user]
            [leiningen.core.utils :as utils])
  (:import (java.util.jar JarFile)
           (org.sonatype.aether.resolution DependencyResolutionException)))

(defn- read-dependency-project [root dep]
  (let [project-file (io/file root "checkouts" dep "project.clj")]
    (if (.exists project-file)
      (let [project (.getAbsolutePath project-file)]
        ;; TODO: core.project and core.classpath currently rely upon each other *uk*
        (require 'leiningen.core.project)
        (try ((resolve 'leiningen.core.project/read) project [:default])
             (catch Exception e
               (throw (Exception. (format "Problem loading %s" project) e)))))
      (println
       "WARN ignoring checkouts directory" dep
       "as it does not contain a project.clj file."))))

(defn- checkout-dep-paths [project dep-project]
  ;; can't mapcat here since :checkout-deps-shares points to vectors and strings
  (flatten (map #(% dep-project) (:checkout-deps-shares project))))

(defn- checkout-deps-paths
  [project]
  (apply concat (for [dep (.list (io/file (:root project) "checkouts"))
                      :let [dep-project (read-dependency-project
                                         (:root project) dep)]
                      :when dep-project]
                  (checkout-dep-paths project dep-project))))

(defn extract-native-deps [files native-path native-prefixes]
  (doseq [file files
          :let [native-prefix (get native-prefixes file "native/")
                jar (JarFile. file)]
          entry (enumeration-seq (.entries jar))
          :when (.startsWith (.getName entry) native-prefix)]
    (let [f (io/file native-path (subs (.getName entry) (count native-prefix)))]
      (if (.isDirectory entry)
        (.mkdirs f)
        (do (.mkdirs (.getParentFile f))
            (io/copy (.getInputStream jar entry) f))))))

(defn when-stale
  [token keys project f & args]
  (let [file (io/file (:target-path project) "stale"
                      (str (name token) "." (str/join "+" (map name keys))))
        current-value (pr-str (map (juxt identity project) keys))
        old-value (and (.exists file) (slurp file))]
    (when (and (:name project) (:target-path project)
               (not= current-value old-value))
      (apply f args)
      (.mkdirs (.getParentFile file))
      (spit file (doall current-value))
      true)))

(defn add-repo-auth
  [[id repo]]
  [id (-> repo user/profile-auth user/resolve-credentials)])

(defn get-non-proxy-hosts []
  (let [system-no-proxy (System/getenv "no_proxy")
        lein-no-proxy (System/getenv "http_no_proxy")]
    (if (and (empty? lein-no-proxy) (not-empty system-no-proxy))
      (->> (str/split system-no-proxy #",")
           (map #(str "*" %))
           (str/join "|"))
      (System/getenv "http_no_proxy"))))

(defn get-proxy-settings
  ([] (get-proxy-settings "http_proxy"))
  ([key]
     (if-let [proxy (System/getenv key)]
       (let [url (utils/build-url proxy)
             user-info (.getUserInfo url)
             [username password] (and user-info (.split user-info ":"))]
         {:host (.getHost url)
          :port (.getPort url)
          :username username
          :password password
          :non-proxy-hosts (get-non-proxy-hosts)}))))

(defn- update-policies [update checksum [repo-name opts]]
  [repo-name (merge {:update (or update :daily)
                     :checksum (or checksum :fail)} opts)])

(defn- print-failures [e]
  (doseq [result (.getArtifactResults (.getResult e))
          :when (not (.isResolved result))
          exception (.getExceptions result)]
    (println (.getMessage exception)))
  (doseq [ex (.getCollectExceptions (.getResult e))
          ex2 (.getExceptions (.getResult ex))]
    (println (.getMessage ex2))))

(defn- root-cause [e]
  (last (take-while identity (iterate (memfn getCause) e))))

(def ^:private get-dependencies-memoized
  (memoize
   (fn [dependencies-key {:keys [repositories local-repo offline? update
                                 checksum mirrors] :as project}
        & {:keys [add-classpath? repository-session-fn]}]
     {:pre [(every? vector? (get project dependencies-key))]}
     (try
       ((if add-classpath?
          pomegranate/add-dependencies
          aether/resolve-dependencies)
        :repository-session-fn repository-session-fn
        :local-repo local-repo
        :offline? offline?
        :repositories (->> repositories
                           (map add-repo-auth)
                           (map (partial update-policies update checksum)))
        :coordinates (get project dependencies-key)
        :mirrors (->> mirrors
                      (map add-repo-auth)
                      (map (partial update-policies update checksum)))
        :transfer-listener
        (bound-fn [e]
          (let [{:keys [type resource error]} e]
            (let [{:keys [repository name size trace]} resource]
              (let [aether-repos (if trace (.getRepositories (.getData trace)))]
                (case type
                  :started
                  (if-let [repo (first (filter
                                        #(or (= (.getUrl %) repository)
                                             ;; sometimes the "base" url
                                             ;; doesn't have a slash on it
                                             (= (str (.getUrl %) "/") repository))
                                        aether-repos))]
                    (println "Retrieving"
                             name
                             "from"
                             (.getId repo))
                    ;;else case happens for metadata files)
                  nil)))))
        :proxy (get-proxy-settings))
       (catch DependencyResolutionException e
         (binding [*out* *err*]
           ;; Cannot recur from catch/finally so have to put this in its own defn
           (print-failures e)
           (println "This could be due to a typo in :dependencies or network issues.")
           #_(when-not (some #(= "https://clojars.org/repo/" (:url (second %))) repositories)
               (println "It's possible the specified jar is in the old Clojars Classic repo.")
               (println "If so see https://github.com/ato/clojars-web/wiki/Releases.")))
         (throw (ex-info "Could not resolve dependencies" {:suppress-msg true
                                                           :exit-code 1} e)))
       (catch Exception e
         (if (and (instance? java.net.UnknownHostException (root-cause e))
                  (not offline?))
           (get-dependencies-memoized dependencies-key (assoc project :offline? true))
           (throw e)))))))

(defn ^:internal get-dependencies [dependencies-key project & args]
  (apply get-dependencies-memoized
         dependencies-key (select-keys project [dependencies-key :repositories
                                                :local-repo :offline? :update
                                                :checksum :mirrors]) args))

(defn- get-original-dependency
  [dep dependencies]
  (some (fn [v] ; not certain if this is the best matching fn
          (when (= (subvec dep 0 2) (subvec v 0 2 )) v))
        dependencies))

(defn get-native-prefix
  [[id version & {:as opts}]]
  (get opts :native-prefix))

(defn- get-native-prefixes
  [dependencies dependencies-tree]
  (let [override-deps (->> (map #(get-original-dependency
                                  % dependencies)
                                (keys dependencies-tree))
                           (map get-native-prefix))]
    (->> (aether/dependency-files dependencies-tree)
         (#(map vector % override-deps))
         (filter second)
         (filter #(re-find #"\.(jar|zip)$" (.getName (first %))))
         (into {}))))

(defn resolve-dependencies
  [dependencies-key {:keys [repositories native-path] :as project} & rest]
  (let [dependencies-tree (apply get-dependencies dependencies-key project rest)
        jars (->> dependencies-tree
                  (aether/dependency-files)
                  (filter #(re-find #"\.(jar|zip)$" (.getName %))))
        native-prefixes (get-native-prefixes (get project dependencies-key)
                                             dependencies-tree)]
    (when-not (= :plugins dependencies-key)
      (or (when-stale :extract-native [dependencies-key] project
                      extract-native-deps jars native-path native-prefixes)
          ;; Always extract native deps from SNAPSHOT jars.
          (extract-native-deps (filter #(re-find #"SNAPSHOT" (.getName %)) jars)
                               native-path
                               native-prefixes)))
    jars))

(defn dependency-hierarchy
  [dependencies-key project & options]
  (if-let [deps-list (get project dependencies-key)]
    (aether/dependency-hierarchy deps-list
                                 (apply get-dependencies dependencies-key
                                        project options))))

(defn- normalize-path [root path]
  (let [f (io/file path)] ; http://tinyurl.com/ab5vtqf
    (.getAbsolutePath (if (or (.isAbsolute f) (.startsWith (.getPath f) "\\"))
                        f (io/file root path)))))

(defn ext-dependency?
  [dep]
  (second
   (some #(if (= :ext (first %)) dep)
         (partition 2 dep))))

(defn ext-classpath
  [project]
  (seq
   (->> (filter ext-dependency? (:dependencies project))
        (assoc project :dependencies)
        (resolve-dependencies :dependencies)
        (map (memfn getAbsolutePath)))))

(defn get-classpath
  [project]
  (for [path (concat (:test-paths project)
                     (:source-paths project)
                     (:resource-paths project)
                     [(:compile-path project)]
                     (checkout-deps-paths project)
                     (for [dep (resolve-dependencies :dependencies project)]
                       (.getAbsolutePath dep)))
        :when path]
    (normalize-path (:root project) path)))

(ns leiningen.core.eval
  (:require [classlojure.core :as cl]
            [clojure.java.io :as io]
            [clojure.string :as string]
            [cemerick.pomegranate :as pomegranate]
            [cemerick.pomegranate.aether :as aether]
            [leiningen.core.user :as user]
            [leiningen.core.project :as project]
            [leiningen.core.main :as main]
            [leiningen.core.classpath :as classpath]
            [leiningen.core.utils :as utils])
  (:import (com.hypirion.io Pipe ClosingPipe)))

(def ^:private arch-options
  {:x86 ["-d32"] :x86_64 ["-d64"]})

(def ^:deprecated get-os
  utils/get-os)

(def ^:deprecated get-arch
  utils/get-arch)

(def ^:deprecated platform-nullsink
  utils/platform-nullsink)

(defn run-prep-tasks
  [{:keys [prep-tasks] :as project}]
  (doseq [task prep-tasks]
    (let [[task-name & task-args] (if (vector? task) task [task])
          task-name (main/lookup-alias task-name project)]
      (main/apply-task task-name (dissoc project :prep-tasks) task-args))))

(defonce 
  prep-blocker (atom (promise)))

(defn prep
  [project]
  ;; This must exist before the project is launched.
  (when (:root project)
    (.mkdirs (io/file (:compile-path project "/tmp"))))
  (classpath/resolve-dependencies :dependencies project)
  (run-prep-tasks project)
  (deliver @prep-blocker true)
  (reset! prep-blocker (promise)))

(defn native-arch-paths
  [project]
  (let [os (:os project (get-os))
        arch (:arch project (get-arch))
        native-path (:native-path project)]
    (if (and os arch)
      (conj
       (->> (:dependencies project)
            (map classpath/get-native-prefix)
            (remove nil?)
            (map #(io/file native-path %)))
       (io/file native-path (name os) (name arch))))))

(defn- as-str [x]
  (if (instance? clojure.lang.Named x)
    (name x)
    (str x)))

(defn- d-property [[k v]]
  (format "-D%s=%s" (as-str k) v))

(defn- join-broken-arg [args x]
  (if (= \- (first x))
    (conj args x)
    (conj (vec (butlast args))
          (str (last args) " " x))))

(defn ^:internal get-jvm-opts-from-env [env-opts]
  (and (seq env-opts)
       (reduce join-broken-arg []
               (.split (string/trim env-opts) " "))))

(defn- get-jvm-args
  [project]
  (let [native-arch-paths (native-arch-paths project)]
    `(~@(get-jvm-opts-from-env (System/getenv "JVM_OPTS"))
      ~@(:jvm-opts project)
      ~@(get arch-options (:arch project))
      ;; TODO: support -Xverify:none
      ~@(map d-property {:clojure.compile.path (:compile-path project)
                         (str (:name project) ".version") (:version project)
                         :file.encoding (or (System/getProperty "file.encoding") "UTF-8")
                         :clojure.debug (boolean (or (System/getenv "DEBUG")
                                                     (:debug project)))})
      ~@(if native-arch-paths
          (let [extant-paths (filter #(.exists %) native-arch-paths)]
            (if (seq extant-paths)
              [(d-property [:java.library.path
                            (string/join java.io.File/pathSeparatorChar
                                         extant-paths)])])))
      ~@(when-let [{:keys [host port non-proxy-hosts]} (classpath/get-proxy-settings)]
          [(d-property [:http.proxyHost host])
           (d-property [:http.proxyPort port])
           (d-property [:http.nonProxyHosts non-proxy-hosts])])
      ~@(when-let [{:keys [host port]} (classpath/get-proxy-settings "https_proxy")]
          [(d-property [:https.proxyHost host])
           (d-property [:https.proxyPort port])]))))

(def ^:dynamic *dir*
  (System/getProperty "user.dir"))

(def ^:dynamic *env*
  nil)

(def ^:dynamic *pump-in*
  true)

(def drip-env
  {"DRIP_INIT" nil
   "DRIP_INIT_CLASS" nil})

(defn- overridden-env
  [env]
  (->> (if (:replace (meta env))
         env
         (merge {} (System/getenv) drip-env env))
       (filter val)
       (map #(str (name (key %)) "=" (val %)))
       (into-array String)))

(defn sh
  [& cmd]
  (when *pump-in*
    (utils/rebind-io!))
  (let [env (overridden-env *env*)
        proc (.exec (Runtime/getRuntime) (into-array cmd) env (io/file *dir*))]
    (.addShutdownHook (Runtime/getRuntime)
                      (Thread. (fn [] (.destroy proc))))
    (with-open [out (io/reader (.getInputStream proc))
                err (io/reader (.getErrorStream proc))
                in (.getOutputStream proc)]
      (let [pump-out (doto (Pipe. out *out*) .start)
            pump-err (doto (Pipe. err *err*) .start)
            pump-in (ClosingPipe. System/in in)]
        (when *pump-in* (.start pump-in))
        (.join pump-out)
        (.join pump-err)
        (let [exit-value (.waitFor proc)]
          (when *pump-in*
            (.kill System/in)
            (.join pump-in)
            (.resurrect System/in))
          exit-value)))))

(defn- form-string [form eval-in]
  (if (and (= (get-os) :windows) (not= :trampoline eval-in))
    ;; On windows if a parameter is in double quotes, then all we need
    ;; to worry about are double quotes, which we must escape
    (string/replace (pr-str form) "\ "\\\)
    (pr-str form)))

(defn- agent-arg [coords file]
  (let [{:keys [options bootclasspath]} (apply hash-map coords)]
    (concat [(str "-javaagent:" file (and options (str "=" options)))]
            (if bootclasspath [(str "-Xbootclasspath/a:" file)]))))

(defn ^:internal classpath-arg [project]
  (let [classpath-string (string/join java.io.File/pathSeparatorChar
                                      (classpath/get-classpath project))
        agent-tree (classpath/get-dependencies :java-agents project)
        ;; Seems like you'd expect dependency-files to walk the whole tree
        ;; here, but it doesn't, which is what we want. but maybe a bug?
        agent-jars (aether/dependency-files (aether/dependency-hierarchy
                                             (:java-agents project) agent-tree))]
    `(~@(mapcat agent-arg (:java-agents project) agent-jars)
      ~@(if (:bootclasspath project)
          [(str "-Xbootclasspath/a:" classpath-string)]
          ["-classpath" classpath-string]))))

(defn shell-command
  [project form]
  `(~(or (:java-cmd project) (System/getenv "JAVA_CMD") "java")
    ~@(classpath-arg project)
    ~@(get-jvm-args project)
    "clojure.main" "-e" ~(form-string form (:eval-in project))))

(defmulti eval-in
  ;; Force it to be a keyword so that we can accept symbols too. That
  ;; way ^:replace and ^:displace metadata can be applied.
  (fn [project _] (keyword (name (:eval-in project :subprocess)))))

(defmethod eval-in :subprocess [project form]
  (binding [*dir* (:root project)]
    (let [exit-code (apply sh (shell-command project form))]
      (when (pos? exit-code)
        (throw (ex-info "Subprocess failed" {:exit-code exit-code}))))))

(defonce trampoline-forms (atom []))
(defonce trampoline-profiles (atom []))

(defmethod eval-in :trampoline [project form]
  (swap! trampoline-forms conj form)
  (swap! trampoline-profiles conj (select-keys project
                                               [:dependencies :source-paths
                                                :resource-paths :test-paths])))

(defmethod eval-in :classloader [project form]
  (when-let [classpath (map io/file (classpath/ext-classpath project))]
    (cl/wrap-ext-classloader classpath))
  (let [classpath   (map io/file (classpath/get-classpath project))
        classloader (cl/classlojure classpath)]
    (doseq [opt (get-jvm-args project)
            :when (.startsWith opt "-D")
            :let [[_ k v] (re-find #"^-D(.*?)=(.*)$" opt)]]
      (if (= k "java.library.path")
        (cl/alter-java-library-path!
         (constantly (string/split v (re-pattern java.io.File/pathSeparator))))
        (System/setProperty k v)))
    (try (cl/eval-in classloader form)
         (catch Exception e
           (println (str "Error evaluating in classloader: "
                         (class e) ":" (.getMessage e)))
           (.printStackTrace e)
           (throw (ex-info "Classloader eval failed" {:exit-code 1}))))))

(defmethod eval-in :nrepl [project form]
  (require 'clojure.tools.nrepl)
  (let [port-file (io/file (:target-path project) "repl-port")
        connect (resolve 'clojure.tools.nrepl/connect)
        client (resolve 'clojure.tools.nrepl/client)
        client-session (resolve 'clojure.tools.nrepl/client-session)
        message (resolve 'clojure.tools.nrepl/message)
        recv (resolve 'clojure.tools.nrepl.transport/recv)]
    (if (.exists port-file)
      (let [transport (connect :host "localhost"
                               :port (Integer. (slurp port-file)))
            client (client-session (client transport Long/MAX_VALUE))]
        (message client {:op "eval" :code (pr-str form)})
        (doseq [{:keys [out err status]} (repeatedly #(recv transport 100))
                :while (not (some #{"done" "interrupted" "error"} status))]
          (when out (println out))
          (when err (binding [*out* *err*] (println err)))))
      ;; TODO: warn that repl couldn't be used?
      (eval-in (assoc project :eval-in :subprocess) form))))

(defmethod eval-in :leiningen [project form]
  (when (:debug project)
    (System/setProperty "clojure.debug" "true"))
  ;; :dependencies are loaded the same way as plugins in eval-in-leiningen
  (project/load-plugins project :dependencies)
  (doseq [path (classpath/get-classpath project)]
    (pomegranate/add-classpath path))
  (doseq [opt (get-jvm-args project)
          :when (.startsWith opt "-D")
          :let [[_ k v] (re-find #"^-D(.*?)=(.*)$" opt)]]
    (System/setProperty k v))
  (eval form))

(defn eval-in-project
  ([project form init]
     (prep project)
     (when (:warn-on-reflection project)
       (println "WARNING: :warn-on-reflection is deprecated; use :global-vars."))
     (eval-in project
              `(do (set! ~'*warn-on-reflection*
                         ~(:warn-on-reflection project))
                   ~@(map (fn [[k v]] `(set! ~k ~v)) (:global-vars project))
                   ~init
                   ~@(:injections project)
                   ~form)))
  ([project form] (eval-in-project project form nil)))

(ns leiningen.core.main
  (:require [leiningen.core.user :as user]
            [leiningen.core.project :as project]
            [leiningen.core.classpath :as classpath]
            [leiningen.core.utils :as utils]
            [clojure.java.io :as io]
            [clojure.string :as string]
            [bultitude.core :as b]))

(def aliases {"-h" "help", "-help" "help", "--help" "help", "-?" "help",
              "-v" "version", "-version" "version", "--version" "version",
              "überjar" "uberjar",
              "-o" ["with-profile" "+offline"]
              "-U" ["with-profile" "+update"]
              "cp" "classpath" "halp" "help"
              "with-profiles" "with-profile"
              "readme" ["help" "readme"]
              "tutorial" ["help" "tutorial"]
              "sample" ["help" "sample"]})

(def ^:private profile-aliases
  (delay (atom (-> (user/profiles) :user :aliases))))

(defn- get-and-dissoc!
  [atom key]
  (when-let [[k v] (find @atom key)]
    (swap! atom dissoc key)
    v))

(defn lookup-alias [task-name project & [not-found]]
  (or (aliases task-name)
      (get (:aliases project) task-name)
      (when-not project
        (get-and-dissoc! @profile-aliases task-name))
      task-name
      (or not-found "help")))

(defn task-args [args project]
  (if (= "help" (aliases (second args)))
    ["help" [(first args)]]
    [(lookup-alias (first args) project) (rest args)]))

(def ^:dynamic *debug* (System/getenv "DEBUG"))

(defn debug
  [& args]
  (when *debug* (apply println args)))

(def ^:dynamic *info* true)

(defn info
  [& args]
  (when *info* (apply println args)))

(def ^:dynamic *exit-process?*
   true)

(defn exit
  ([exit-code]
     (if *exit-process?*
       (do (shutdown-agents)
           (System/exit exit-code))
       (throw (ex-info "Suppressed exit" {:exit-code exit-code}))))
  ([] (exit 0)))

(defn abort
  [& msg]
  (binding [*out* *err*]
    (when (seq msg)
      (apply println msg))
    (exit 1)))

(defn- distance [s t]
  (letfn [(iters [n f start]
            (take n (map second
                         (iterate f start))))]
    (let [m (inc (count s)), n (inc (count t))
          first-row (vec (range m))
          matrix (iters n (fn [[j row]]
                            [(inc j)
                             (vec (iters m (fn [[i col]]
                                             [(inc i)
                                              (if (= (nth s i)
                                                     (nth t j))
                                                (get row i)
                                                (inc (min (get row i)
                                                          (get row (inc i))
                                                          col)))])
                                         [0 (inc j)]))])
                        [0 first-row])]
      (last (last matrix)))))

(defn tasks
  []
  (->> (b/namespaces-on-classpath :prefix "leiningen")
       (filter #(re-find #"^leiningen\.(?!core|main|util)[^\.]+$" (name %)))
       (distinct)
       (sort)))

(defn suggestions
  [task tasks]
  (let [suggestions (into {} (for [t tasks
                                   :let [n (.replaceAll (name t)
                                                        "leiningen." "")]]
                               [n (distance n task)]))
        min (apply min (vals suggestions))]
    (if (<= min 4)
      (map first (filter #(= min (second %)) suggestions)))))

(defn ^:no-project-needed task-not-found [task & _]
  (binding [*out* *err*]
    (println (str "'" task "' is not a task. See 'lein help'."))
    (when-let [suggestions (suggestions task (tasks))]
      (println)
      (println "Did you mean this?")
      (doseq [suggestion suggestions]
        (println "        " suggestion))))
  (throw (ex-info "Task not found" {:exit-code 1 :suppress-msg true})))

(defn- drop-partial-args [pargs]
  #(for [[f & r] %
         :let [non-varargs (if (pos? (inc (.indexOf (or r []) '&)))
                             (min (count pargs) (.indexOf r '&))
                             (count pargs))]]
     (cons f (drop non-varargs r))))

(defn resolve-task
  ([task not-found]
     (let [[task & pargs] (if (coll? task) task [task])]
       (if-let [task-var (utils/require-resolve (str "leiningen." task) task)]
         (with-meta
           (fn [project & args] (apply task-var project (concat pargs args)))
           (update-in (meta task-var) [:arglists] (drop-partial-args pargs)))
         (not-found task))))
  ([task] (resolve-task task #'task-not-found)))

(defn ^:internal matching-arity? [task args]
  (some (fn [parameters]
          (and (if (= '& (last (butlast parameters)))
                 (>= (count args) (- (count parameters) 3))
                 (= (count parameters) (inc (count args))))
               parameters))
        (:arglists (meta task))))

(defn- remove-alias
  [project alias]
  (-> project
      (update-in [:aliases] #(if (map? %) (dissoc % alias) %))
      (vary-meta update-in [:without-profiles :aliases] dissoc alias)
      (vary-meta update-in [:profiles]
                 #(zipmap
                   (keys %)
                   (map (fn [p] (if (map? p) (remove-alias p alias) p))
                        (vals %))))))

(defn apply-task
  [task-name project args]
  (let [[task-alias] (for [[k v] (:aliases project) :when (= v task-name)] k)
        project (and project (remove-alias project
                                           (or task-alias task-name)))
        task (resolve-task task-name)]
    (when-not (or (:root project) (:no-project-needed (meta task)))
      (abort "Couldn't find project.clj, which is needed for" task-name))
    (when-not (matching-arity? task args)
      (abort "Wrong number of arguments to" task-name "task."
             "\nExpected" (string/join " or " (map next (:arglists
                                                         (meta task))))))
    (debug "Applying task" task-name "to" args)
    (apply task project args)))

(defn resolve-and-apply [project args]
  (let [[task-name args] (task-args args project)]
    (apply-task task-name project args)))

(defn leiningen-version []
  (or (System/getenv "LEIN_VERSION")
      (with-open [reader (-> "META-INF/maven/leiningen/leiningen/pom.properties"
                             io/resource
                             io/reader)]
        (-> (doto (java.util.Properties.)
              (.load reader))
            (.getProperty "version")))))

(defn ^:internal version-satisfies? [v1 v2]
  (let [v1 (map #(Integer. %) (re-seq #"\d+" (first (string/split v1 #"-" 2))))
        v2 (map #(Integer. %) (re-seq #"\d+" (first (string/split v2 #"-" 2))))]
    (loop [versions (map vector v1 v2)
           [seg1 seg2] (first versions)]
      (cond (empty? versions) true
            (= seg1 seg2) (recur (rest versions) (first (rest versions)))
            (> seg1 seg2) true
            (< seg1 seg2) false))))

(def ^:private min-version-warning
  "*** Warning: This project requires Leiningen %s, but you have %s ***
Get the latest version of Leiningen at http://leiningen.org or by executing
\"lein upgrade\".")

(defn- verify-min-version
  [{:keys [min-lein-version]}]
  (when-not (version-satisfies? (leiningen-version) min-lein-version)
    (info (format min-version-warning min-lein-version (leiningen-version)))))

(defn user-agent []
  (format "Leiningen/%s (Java %s; %s %s; %s)"
          (leiningen-version) (System/getProperty "java.vm.name")
          (System/getProperty "os.name") (System/getProperty "os.version")
          (System/getProperty "os.arch")))

(defn- configure-http []
  "Set Java system properties controlling HTTP request behavior."
  (System/setProperty "aether.connector.userAgent" (user-agent))
  (when-let [{:keys [host port non-proxy-hosts]} (classpath/get-proxy-settings)]
    (System/setProperty "http.proxyHost" host)
    (System/setProperty "http.proxyPort" (str port))
    (when non-proxy-hosts
      (System/setProperty "http.nonProxyHosts" non-proxy-hosts)))
  (when-let [{:keys [host port]} (classpath/get-proxy-settings "https_proxy")]
    (System/setProperty "https.proxyHost" host)
    (System/setProperty "https.proxyPort" (str port))))

(defn -main
  [& raw-args]
  (try
    (user/init)
    (let [project (project/init-project
                   (if (.exists (io/file "project.clj"))
                     (project/read)
                     (-> (project/make {:eval-in :leiningen :prep-tasks []})
                         project/project-with-profiles
                         (project/init-profiles [:default]))))]
      (when (:min-lein-version project) (verify-min-version project))
      (configure-http)
      (resolve-and-apply project raw-args))
    (catch Exception e
      (if (or *debug* (not (:exit-code (ex-data e))))
        (.printStackTrace e)
        (when-not (:suppress-msg (ex-data e))
          (println (.getMessage e))))
      (exit (:exit-code (ex-data e) 1))))
  (exit 0))

(ns leiningen.core.project
  (:refer-clojure :exclude [read])
  (:require [clojure.walk :as walk]
            [clojure.java.io :as io]
            [clojure.set :as set]
            [clojure.string :as s]
            [cemerick.pomegranate :as pomegranate]
            [cemerick.pomegranate.aether :as aether]
            [leiningen.core.utils :as utils]
            [leiningen.core.ssl :as ssl]
            [leiningen.core.user :as user]
            [leiningen.core.classpath :as classpath]
            [useful.fn :refer [fix]]
            [useful.seq :refer [update-first find-first]]
            [useful.map :refer [update update-each map-vals]])
  (:import (clojure.lang DynamicClassLoader)
           (java.io PushbackReader)))

(defn artifact-map
  [id]
  {:artifact-id (name id)
   :group-id (or (namespace id) (name id))})

(defn exclusion-map
  [spec]
  (if-let [[id & {:as opts}] (fix spec symbol? vector)]
    (-> opts
        (merge (artifact-map id))
        (with-meta (meta spec)))))

(defn exclusion-vec
  [exclusion]
  (if-let [{:keys [artifact-id group-id]} exclusion]
    (into [(symbol group-id artifact-id)]
          (apply concat (dissoc exclusion :artifact-id :group-id)))))

(defn dependency-map
  [dep]
  (if-let [[id version & {:as opts}] dep]
    (-> opts
        (merge (artifact-map id))
        (assoc :version version)
        (update :exclusions #(if % (map exclusion-map %)))
        (with-meta (meta dep)))))

(defn dependency-vec
  [dep]
  (if-let [{:keys [artifact-id group-id version]} dep]
    (-> dep
        (update :exclusions #(if % (map exclusion-vec %)))
        (dissoc :artifact-id :group-id :version)
        (->> (apply concat)
             (into [(symbol group-id artifact-id) version]))
        (with-meta (meta dep)))))

(defn- meta*
  [obj]
  (if (instance? clojure.lang.IObj obj)
    (meta obj)
    nil))

(defn- with-meta*
  [obj m]
  (if (instance? clojure.lang.IObj obj)
    (with-meta obj m)
    obj))

(defn- displace?
  [obj]
  (-> obj meta* :displace))

(defn- replace?
  [obj]
  (-> obj meta* :replace))

(defn- different-priority?
  [left right]
  (boolean
   (some (some-fn nil? displace? replace?) [left right])))

(defn- pick-prioritized
  [left right]
  (cond (nil? left) right
        (nil? right) left
        (and (displace? left)   ;; Pick the rightmost
             (displace? right)) ;; if both are marked as displaceable
        (with-meta* right
          (merge (meta* left) (meta* right)))
        (and (replace? left)    ;; Pick the rightmost
             (replace? right))  ;; if both are marked as replaceable
        (with-meta* right
          (merge (meta* left) (meta* right)))
        (or (displace? left)
            (replace? right))
        (with-meta* right
          (merge (-> left meta* (dissoc :displace))
                 (-> right meta* (dissoc :replace))))
        (or (replace? left)
            (displace? right))
        (with-meta* left
          (merge (-> right meta* (dissoc :displace))
                 (-> left meta* (dissoc :replace))))))

(declare meta-merge)

(defn- unquote-project
  [args]
  (walk/walk (fn [item]
               (cond (and (seq? item) (= `unquote (first item))) (second item)
                     ;; needed if we want fn literals preserved
                     (or (seq? item) (symbol? item)) (list 'quote item)
                     :else (let [result (unquote-project item)]
                             ;; clojure.walk strips metadata
                             (if-let [m (meta item)]
                               (with-meta result m)
                               result))))
             identity
             args))

(def defaults
  ;; TODO: move :repositories here in 3.0
  {:source-paths ["src"]
   :resource-paths ["resources"]
   :test-paths ["test"]
   :native-path "target/native"
   :compile-path "target/classes"
   :target-path "target/%s"
   :prep-tasks ["javac" "compile"]
   :jar-exclusions [#"^\."]
   :certificates ["clojars.pem"]
   :offline? (not (nil? (System/getenv "LEIN_OFFLINE")))
   :uberjar-exclusions [#"(?i)^META-INF/[^/]*\.(SF|RSA|DSA)$"]
   :global-vars {}})

(defn- dep-key
  [[id version & opts]]
  (-> (apply hash-map opts)
      (select-keys [:classifier :extension])
      (assoc :id id)))

(defn- add-dep [deps dep]
  (let [k (dep-key dep)]
    (update-first deps #(= k (dep-key %))
                  (fn [existing]
                    (dependency-vec
                     (meta-merge (dependency-map existing)
                                 (dependency-map dep)))))))

(defn- normalize-repo
  [[id opts :as repo]]
  (with-meta
    [id (fix opts string? (partial hash-map :url))]
    (meta repo)))

(defn- normalize-repos
  [repos]
  (with-meta
    (mapv normalize-repo repos)
    (meta repos)))

(defn- add-repo [repos [id opts :as repo]]
  (update-first repos #(= id (first %))
                (fn [[_ existing :as original]]
                  (let [opts (if (keyword? opts)
                               (-> (find-first #(= (first %)
                                                   (name opts))
                                               repos)
                                   second)
                               opts)
                        repo (with-meta [id opts] (meta repo))]
                    (if (different-priority? repo original)
                      (pick-prioritized repo original)
                      (with-meta [id (meta-merge existing opts)]
                        (merge (meta original) (meta repo))))))))

(def empty-dependencies
  (with-meta [] {:reduce add-dep}))

(def empty-repositories
  (with-meta [] {:reduce add-repo}))

(def empty-paths
  (with-meta [] {:prepend true}))

(def default-repositories
  (with-meta
    [["central" {:url "http://repo1.maven.org/maven2/" :snapshots false}]
     ["clojars" {:url "https://clojars.org/repo/"}]]
    {:reduce add-repo}))

(def deploy-repositories
  (with-meta
    [["clojars" {:url "https://clojars.org/repo/"
                 :password :gpg :username :gpg}]]
    {:reduce add-repo}))

(defn update-if-in-map
  [m ks f & args]
  (apply update-each m (filter (partial contains? m) ks) f args))

(defn normalize-values
  [map]
  (-> map
      (update-if-in-map [:repositories :deploy-repositories
                         :mirrors :plugin-repositories] normalize-repos)
      (update-if-in-map [:profiles] map-vals normalize-values)))

(defn make
  ([project project-name version root]
     (make (with-meta (assoc project
                        :name (name project-name)
                        :group (or (namespace project-name)
                                   (name project-name))
                        :version version
                        :root root)
             (meta project))))
  ([project]
     (let [repos (if (:omit-default-repositories project)
                   (do (println "WARNING:"
                                ":omit-default-repositories is deprecated;"
                                "use :repositories ^:replace [...] instead.")
                       empty-repositories)
                   default-repositories)]
       (with-meta
         (meta-merge
          {:repositories repos
           :plugin-repositories repos
           :deploy-repositories deploy-repositories
           :plugins empty-dependencies
           :dependencies empty-dependencies
           :source-paths empty-paths
           :resource-paths empty-paths
           :test-paths empty-paths}
          (-> (merge defaults project)
              (assoc :jvm-opts (or (:jvm-opts project) (:java-opts project)
                                   (:jvm-opts defaults)))
              (dissoc :eval-in-leiningen :omit-default-repositories :java-opts)
              (assoc :eval-in (or (:eval-in project)
                                  (if (:eval-in-leiningen project)
                                    :leiningen, :subprocess)))
              (normalize-values)))
         (meta project)))))

(defmacro defproject
  [project-name version & {:as args}]
  `(let [args# ~(unquote-project args)
         root# ~(.getParent (io/file *file*))]
     (def ~'project
       (make args# '~project-name ~version root#))))

(defn- add-exclusions [exclusions dep]
  (dependency-vec
   (update (dependency-map dep) :exclusions
           into (map exclusion-map exclusions))))

(defn- add-global-exclusions [project]
  (let [{:keys [dependencies exclusions]} project]
    (if-let [exclusions (and (seq dependencies) (seq exclusions))]
      (assoc project
        :dependencies (with-meta
                        (mapv (partial add-exclusions exclusions)
                              dependencies)
                        (meta dependencies)))
      project)))

(defn- absolutize [root path]
  (str (if (.isAbsolute (io/file path))
         path
         (io/file root path))))

(defn- absolutize-path [{:keys [root] :as project} key]
  (cond (re-find #"-path$" (name key))
        (update-in project [key] (partial absolutize root))
        (re-find #"-paths$" (name key))
        (update-in project [key] (partial map (partial absolutize root)))
        :else project))

(defn absolutize-paths [project]
  (reduce absolutize-path project (keys project)))

(defn- sha1 [content]
  (.toString (BigInteger. 1 (-> (java.security.MessageDigest/getInstance "SHA1")
                                (.digest (.getBytes content)))) 16))

(defn profile-scope-target-path [project profiles]
  (let [n #(if (map? %) (subs (sha1 (pr-str %)) 0 8) (name %))]
    (if (:target-path project)
      (update-in project [:target-path] format (s/join "+" (map n profiles)))
      project)))

(def ^:private hooke-injection
  (with-open [rdr (-> "robert/hooke.clj" io/resource io/reader PushbackReader.)]
    `(do (ns ~'leiningen.core.injected)
         ~@(doall (take-while #(not= % ::eof)
                              (rest (repeatedly #(clojure.core/read
                                                  rdr false ::eof)))))
         (ns ~'user))))

(def tiered-jvm-opts
  (if (.contains (or (System/getenv "LEIN_JVM_OPTS") ) "Tiered")
    ["-XX:+TieredCompilation" "-XX:TieredStopAtLevel=1"] []))

(def default-profiles
  (atom {:default [:base :system :user :provided :dev]
         :base {:resource-paths ["dev-resources"]
                :jvm-opts tiered-jvm-opts
                :test-selectors {:default (with-meta '(constantly true)
                                            {:displace true})}
                :target-path "target"
                :dependencies '[[org.clojure/tools.nrepl "0.2.3"]
                                [clojure-complete "0.2.3"]]
                :checkout-deps-shares [:source-paths
                                       :test-paths
                                       :resource-paths
                                       :compile-path]}
         :leiningen/test {:injections [hooke-injection]
                          :test-selectors {:default (with-meta
                                                      '(constantly true)
                                                      {:displace true})}}
         :uberjar {} ; TODO: use :aot :all here in 3.0
         :update {:update :always}
         :offline {:offline? true}
         :debug {:debug true}}))

(defn- meta-merge
  [left right]
  (cond (different-priority? left right)
        (pick-prioritized left right)
        (-> left meta :reduce)
        (-> left meta :reduce
            (reduce left right)
            (with-meta (meta left)))
        (and (map? left) (map? right))
        (merge-with meta-merge left right)
        (and (set? left) (set? right))
        (set/union right left)
        (and (coll? left) (coll? right))
        (if (or (-> left meta :prepend)
                (-> right meta :prepend))
          (-> (concat right left)
              (with-meta (merge (meta left)
                                (select-keys (meta right) [:displace]))))
          (concat left right))
        (= (class left) (class right)) right
        :else
        (do (println left "and" right "have a type mismatch merging profiles.")
            right)))

(defn- apply-profiles [project profiles]
  (reduce (fn [project profile]
            (with-meta
              (meta-merge project profile)
              (meta-merge (meta project) (meta profile))))
          project
          profiles))

(defn- lookup-profile
  [profiles profile]
  (cond (keyword? profile)
        (let [result (get profiles profile)]
          (when-not (or result (#{:provided :dev :user :test :base :default
                                  :production :system :repl}
                                profile))
            (println "Warning: profile" profile "not found."))
          (vary-meta (lookup-profile profiles result)
                     update-in [:active-profiles] (fnil conj []) profile))
        ;; composite profile
        (vector? profile)
        (apply-profiles {} (map (partial lookup-profile profiles) profile))
        :else (or profile {})))

(defn- warn-user-repos [profiles]
  (let [has-url? (fn [entry] (or (string? entry) (:url entry)))
        repo-profiles (filter #(->> (second %)
                                    :repositories
                                    (map second)
                                    (some has-url?))
                              profiles)]
    (when (and (seq repo-profiles)
               (not (System/getenv "LEIN_SUPPRESS_USER_LEVEL_REPO_WARNINGS")))
      (println ":repositories detected in user-level profiles!"
               (vec (map first repo-profiles)) "\nSee"
               "https://github.com/technomancy/leiningen/wiki/Repeatability"))))

(alter-var-root #'warn-user-repos memoize)

(defn- warn-user-profile [profiles]
  (when (contains? profiles :user)
    (println "WARNING: user-level profile defined in project files.")))

(alter-var-root #'warn-user-profile memoize)

(defn- system-profiles []
  (let [sys-profile-dir (if (= :windows (utils/get-os))
                          (io/file (System/getenv "AllUsersProfile") "Leiningen")
                          (io/file "/etc" "leiningen"))]
    (user/load-profiles sys-profile-dir)))

(defn- project-profiles [project]
  (let [profiles (utils/read-file (io/file (:root project) "profiles.clj"))]
    (warn-user-profile profiles)
    profiles))

(defn read-profiles
  [project]
  (warn-user-repos (concat (user/profiles) (system-profiles)))
  (warn-user-profile (:profiles project))
  (merge @default-profiles (system-profiles) (user/profiles)
         (:profiles project) (project-profiles project)))

(defn ensure-dynamic-classloader []
  (let [thread (Thread/currentThread)
        cl (.getContextClassLoader thread)]
    (when-not (pomegranate/modifiable-classloader? cl)
      (.setContextClassLoader thread (DynamicClassLoader. cl)))))

(def ^:private registered-wagon-files (atom #{}))

(defn load-plugins
  ([project key]
     (when (seq (get project key))
       (ensure-dynamic-classloader)
       (classpath/resolve-dependencies
        key project
        :add-classpath? true))
     (doseq [wagon-file (-> (.getContextClassLoader (Thread/currentThread))
                            (.getResources "leiningen/wagons.clj")
                            (enumeration-seq))
             :when (not (@registered-wagon-files wagon-file))
             [hint factory] (read-string (slurp wagon-file))]
       (aether/register-wagon-factory! hint (eval factory))
       (swap! registered-wagon-files conj wagon-file))
     project)
  ([project] (load-plugins project :plugins)))

(defn plugin-vars [project type]
  (for [[plugin _ & {:as opts}] (:plugins project)
        :when (get opts type true)]
    (-> (symbol (str (name plugin) ".plugin") (name type))
        (with-meta {:optional true}))))

(defn- plugin-hooks [project]
  (plugin-vars project :hooks))

(defn- plugin-middleware [project]
  (plugin-vars project :middleware))

(defn- load-hook [hook-name]
  (if-let [hook (try (utils/require-resolve hook-name)
                     (catch Throwable e
                       (utils/error "problem requiring" hook-name "hook")
                       (throw e)))]
    (try (hook)
         (catch Throwable e
           (utils/error "problem activating" hook-name "hook")
           (throw e)))
    (when-not (:optional (meta hook-name))
      (utils/error "cannot resolve" hook-name "hook"))))

(defn load-hooks [project & [ignore-missing?]]
  (doseq [hook-name (concat (plugin-hooks project) (:hooks project))]
    ;; if hook-name is just a namespace assume hook fn is called activate
    (let [hook-name (if (namespace hook-name)
                      hook-name
                      (symbol (name hook-name) "activate"))]
      (load-hook hook-name)))
  project)

(defn apply-middleware
  ([project]
     (reduce apply-middleware project
             (concat (plugin-middleware project)
                     (:middleware project))))
  ([project middleware-name]
     (if-let [middleware (utils/require-resolve middleware-name)]
       (middleware project)
       (do (when-not (:optional (meta middleware-name))
             (utils/error "cannot resolve" middleware-name "middleware"))
           project))))

(defn load-certificates
  [project]
  (let [certs (mapcat ssl/read-certs (:certificates project))
        context (ssl/make-sslcontext (into (ssl/default-trusted-certs) certs))]
    (ssl/register-scheme (ssl/https-scheme context))
    project))

(defn activate-middleware
  [project]
  (doto (apply-middleware project)
    (load-certificates)
    (load-hooks)))

(defn project-with-profiles-meta [project profiles]
  ;;; should this dissoc :default?
  ;; (vary-meta project assoc :profiles (dissoc profiles :default))
  (vary-meta project assoc
             :profiles profiles))

(defn project-with-profiles [project]
  (project-with-profiles-meta project (read-profiles project)))

(defn ^:internal init-profiles
  [project include-profiles & [exclude-profiles]]
  (let [project (with-meta
                  (:without-profiles (meta project) project)
                  (meta project))
        profile-map (apply dissoc (:profiles (meta project)) exclude-profiles)
        profiles (map (partial lookup-profile profile-map) include-profiles)
        normalized-profiles (map normalize-values profiles)]
    (-> project
        (apply-profiles normalized-profiles)
        (absolutize-paths)
        (profile-scope-target-path include-profiles)
        (add-global-exclusions)
        (vary-meta merge {:without-profiles project
                          :included-profiles include-profiles
                          :excluded-profiles exclude-profiles}))))

(defn set-profiles
  [project include-profiles & [exclude-profiles]]
  (-> project
      (init-profiles include-profiles exclude-profiles)
      (load-plugins)
      (activate-middleware)))

(defn merge-profiles
  [project profiles]
  (let [{:keys [included-profiles excluded-profiles]} (meta project)]
    (set-profiles project
                  (concat included-profiles profiles)
                  (remove (set profiles) excluded-profiles))))

(defn unmerge-profiles
  [project profiles]
  (let [{:keys [included-profiles excluded-profiles]} (meta project)]
    (set-profiles project
                  (remove (set profiles) included-profiles)
                  (concat excluded-profiles profiles))))

(defn- init-lein-classpath
  [project]
  (when (= :leiningen (:eval-in project))
    (doseq [path (classpath/get-classpath project)]
      (pomegranate/add-classpath path))))

(defn init-project
  [project]
  (-> (doto project
        (load-certificates)
        (init-lein-classpath)
        (load-plugins))
      (activate-middleware)))

(defn add-profiles
  [project profiles-map]
  ;; Merge new profiles into both the project and without-profiles meta
  (vary-meta (update-in project [:profiles] merge profiles-map)
             merge
             {:without-profiles (update-in (:without-profiles (meta project)
                                                              project)
                                           [:profiles] merge
                                           profiles-map)}))

(defn read
  ([file profiles]
     (locking read
       (binding [*ns* (find-ns 'leiningen.core.project)]
         (try (load-file file)
              (catch Exception e
                (throw (Exception. (format "Error loading %s" file) e)))))
       (let [project (resolve 'leiningen.core.project/project)]
         (when-not project
           (throw (Exception. (format "%s must define project map" file))))
         ;; return it to original state
         (ns-unmap 'leiningen.core.project 'project)
         (init-profiles (project-with-profiles @project) profiles))))
  ([file] (read file [:default]))
  ([] (read "project.clj")))

(ns leiningen.core.ssl
  (:require [clojure.java.io :as io]
            [leiningen.core.user :as user])
  (:import java.security.KeyStore
           java.security.KeyStore$TrustedCertificateEntry
           java.security.Security
           java.security.cert.CertificateFactory
           javax.net.ssl.KeyManagerFactory
           javax.net.ssl.SSLContext
           javax.net.ssl.TrustManagerFactory
           javax.net.ssl.X509TrustManager
           java.io.FileInputStream
           org.apache.http.conn.ssl.SSLSocketFactory
           org.apache.http.conn.scheme.Scheme
           org.apache.maven.wagon.providers.http.HttpWagon
           org.apache.http.conn.ssl.BrowserCompatHostnameVerifier))

(defn ^TrustManagerFactory trust-manager-factory [^KeyStore keystore]
  (doto (TrustManagerFactory/getInstance "PKIX")
    (.init keystore)))

(defn default-trust-managers []
  (let [tmf (trust-manager-factory nil)
        tms (.getTrustManagers tmf)]
    (filter #(instance? X509TrustManager %) tms)))

(defn key-manager-props []
  (let [read #(java.lang.System/getProperty %)]
    (merge {:file (read "javax.net.ssl.keyStore")
            :type (read "javax.net.ssl.keyStoreType")
            :provider (read "javax.net.ssl.keyStoreProvider")
            :password (read "javax.net.ssl.keyStorePassword")}
           (-> (user/profiles) :user :key-manager-properties))))

(defn key-manager-factory [{:keys [file type provider password]}]
  (let [type (or type (KeyStore/getDefaultType))
        fis (if-not (empty? file) (FileInputStream. file))
        pwd (and password (.toCharArray password))
        store (if provider
                (KeyStore/getInstance type provider)
                (KeyStore/getInstance type))]
    (.load store fis pwd)
    (when fis (.close fis))
    (doto (KeyManagerFactory/getInstance
           (KeyManagerFactory/getDefaultAlgorithm))
      (.init store pwd))))

(defn default-trusted-certs
  []
  (mapcat #(.getAcceptedIssuers %) (default-trust-managers)))

(defn read-certs
  [f]
  (let [cf (CertificateFactory/getInstance "X.509")
        in (io/input-stream (or (io/resource f) (io/file f)))]
    (.generateCertificates cf in)))

(defn make-keystore
  [certs]
  (let [ks (KeyStore/getInstance "jks")]
    (.load ks nil nil)
    (doseq [[i cert] (map vector (range) certs)]
      (.setEntry ks (str i) (KeyStore$TrustedCertificateEntry. cert) nil))
    ks))

(defn make-sslcontext
  [trusted-certs]
  (let [ks (make-keystore trusted-certs)
        kmf (key-manager-factory (key-manager-props))
        tmf (trust-manager-factory ks)]
    (doto (SSLContext/getInstance "TLS")
      (.init (.getKeyManagers kmf) (.getTrustManagers tmf) nil))))

(alter-var-root #'make-sslcontext memoize)

(defn https-scheme
  ([context] (https-scheme context 443))
  ([context port]
     (let [factory (SSLSocketFactory. context (BrowserCompatHostnameVerifier.))]
       (Scheme. "https" port factory))))

(def register-scheme
  (memoize (fn [scheme]
             (-> (.getConnectionManager (HttpWagon.))
                 (.getSchemeRegistry)
                 (.register scheme)))))

(ns leiningen.core.user
  (:require [clojure.java.io :as io]
            [clojure.string :as str]
            [clojure.java.shell :as shell]
            [useful.map :refer [map-vals]]
            [leiningen.core.utils :as utils])
  (:import (java.util.regex Pattern)))

(defn getprop
  [prop-name]
  (System/getProperty prop-name))

(defn getenv
  [name]
  (System/getenv name))

(defn leiningen-home
  []
  (let [lein-home (getenv "LEIN_HOME")
        lein-home (or (and lein-home (io/file lein-home))
                      (io/file (System/getProperty "user.home") ".lein"))]
    (.getAbsolutePath (doto lein-home .mkdirs))))

(def init
  (memoize (fn []
             (let [init-file (io/file (leiningen-home) "init.clj")]
               (when (.exists init-file)
                 (try (load-file (.getAbsolutePath init-file))
                      (catch Exception e
                        (.printStackTrace e))))))))

(defn- load-profiles-d-file
  [file]
  (try
    (let [kw (->> file .getName (re-find #".+(?=\.clj)") keyword)
          contents (with-meta (utils/read-file file) ;; assumes the file exist
                     {:origin (.getAbsolutePath file)})]
      [kw contents])
    (catch Exception e
      (binding [*out* *err*]
        (println "Error reading" (.getName file)
                 "from" (-> file .getParentFile .getAbsolutePath (str ":")))
        (println (.getMessage e))))))

(def profiles-d-profiles
  (memoize
   (fn []
     (let [profile-dir (io/file (leiningen-home) "profiles.d")]
       (if (.isDirectory profile-dir)
         (for [file (.listFiles profile-dir)
               :when (-> file .getName (.endsWith ".clj"))]
           (load-profiles-d-file file)))))))

(def ^:internal load-profiles
  (memoize
   (fn [dir]
     (try
       (if-let [contents (utils/read-file (io/file dir "profiles.clj"))]
         (map-vals contents with-meta
                   {:origin (.getAbsolutePath (io/file dir "profiles.clj"))}))
       (catch Exception e
         (binding [*out* *err*]
           (println "Error reading profiles.clj from" dir)
           (println (.getMessage e))))))))

(def profiles
  (memoize
   (fn []
     (let [error-fn
           (fn [a b]
             (binding [*out* *err*]
               (println "Error: A profile is defined in both"
                        (-> a meta :origin) "and in" (-> b meta :origin)))
             (throw (ex-info "Multiple profiles defined in ~/.lein"
                             {:exit-code 1})))]
       (merge-with error-fn
                   (load-profiles (leiningen-home))
                   (into {} (profiles-d-profiles)))))))

(defn gpg-program
  []
  (or (getenv "LEIN_GPG") "gpg"))

(defn gpg
  [& args]
  (try
    (apply shell/sh (gpg-program) args)
    (catch java.io.IOException e
      {:exit 1 :err (.getMessage e)})))

(defn gpg-available?
  []
  (zero? (:exit (gpg "--version"))))

(defn credentials-fn
  ([] (let [cred-file (io/file (leiningen-home) "credentials.clj.gpg")]
        (if (.exists cred-file)
          (credentials-fn cred-file))))
  ([file]
     (let [{:keys [out err exit]} (gpg "--quiet" "--batch"
                                       "--decrypt" "--" (str file))]
       (if (pos? exit)
         (binding [*out* *err*]
           (println "Could not decrypt credentials from" (str file))
           (println err)
           (println "See `lein help gpg` for how to install gpg."))
         (read-string out)))))

(def credentials (memoize credentials-fn))

(defn- match-credentials [settings auth-map]
  (get auth-map (:url settings)
       (first (for [[re? cred] auth-map
                    :when (and (instance? Pattern re?)
                               (re-find re? (:url settings)))]
                cred))))

(defn- resolve-credential
  [source-settings result [k v]]
  (letfn [(resolve [v]
            (cond (= :env v)
                  (getenv (str "LEIN_" (str/upper-case (name k))))
                  (and (keyword? v) (= "env" (namespace v)))
                  (getenv (str/upper-case (name v)))
                  (= :gpg v)
                  (get (match-credentials source-settings (credentials)) k)
                  (coll? v) ;; collection of places to look
                  (->> (map resolve v)
                       (remove nil?)
                       first)
                  :else v))]
    (if (#{:username :password :passphrase :private-key-file} k)
      (assoc result k (resolve v))
      (assoc result k v))))

(defn resolve-credentials
  [settings]
  (let [gpg-creds (if (= :gpg (:creds settings))
                    (match-credentials settings (credentials)))
        resolved (reduce (partial resolve-credential settings)
                         (empty settings)
                         settings)]
    (if gpg-creds
      (dissoc (merge gpg-creds resolved) :creds)
      resolved)))

(defn profile-auth
  [settings]
  (if-let [repo-auth (-> (profiles) :auth :repository-auth)]
    (merge settings (match-credentials settings repo-auth))
    settings))

(ns leiningen.core.utils
  (:require [clojure.java.io :as io])
  (:import (com.hypirion.io RevivableInputStream)
           (clojure.lang LineNumberingPushbackReader)
           (java.io File FileDescriptor FileInputStream InputStreamReader)
           (java.net URL)))

(def rebound-io? (atom false))

(defn rebind-io! []
  (when-not @rebound-io?
    (let [new-in (-> FileDescriptor/in FileInputStream. RevivableInputStream.)]
      (System/setIn new-in)
      (.bindRoot #'*in* (-> new-in InputStreamReader.
                            LineNumberingPushbackReader.)))
    (reset! rebound-io? true)))

(defn build-url
  [url]
  (try (URL. url)
       (catch java.net.MalformedURLException _
         (URL. (str "http://" url)))))

(defn read-file
  [file]
  (if (.exists file)
    (read-string (slurp file))))

(defn symlink?
  [file]
  (let [canon (if-not (.getParent file)
                file
                (-> (.. file getParentFile getCanonicalFile)
                    (File. (.getName file))))]
    (not= (.getCanonicalFile canon)
          (.getAbsoluteFile canon))))

(defn ns-exists? [namespace]
  (some (fn [suffix]
          (-> (#'clojure.core/root-resource namespace)
              (subs 1)
              (str suffix)
              io/resource))
        [".clj" (str clojure.lang.RT/LOADER_SUFFIX ".class")]))

(defn error [& args]
  (binding [*out* *err*]
    (apply println "Error:" args)))

(defn require-resolve
  ([sym]
     (when-let [ns (namespace sym)]
       (when (ns-exists? ns)
         (let [ns (symbol ns)]
           (when-not (find-ns ns)
             (require ns)))
         (resolve sym))))
  ([ns sym] (require-resolve (symbol ns sym))))

(defn- get-by-pattern
  [m k]
  (m (first (drop-while #(nil? (re-find (re-pattern %) k))
                        (keys m)))))

(def ^:private native-names
  {"Mac OS X" :macosx "Windows" :windows "Linux" :linux
   "FreeBSD" :freebsd "OpenBSD" :openbsd
   "amd64" :x86_64 "x86_64" :x86_64 "x86" :x86 "i386" :x86
   "arm" :arm "SunOS" :solaris "sparc" :sparc "Darwin" :macosx})

(defn get-os
  []
  (get-by-pattern native-names (System/getProperty "os.name")))

(defn get-arch
  []
  (get-by-pattern native-names (System/getProperty "os.arch")))

(defn platform-nullsink
  []
  (io/file (if (= :windows (get-os))
             "NUL"
             "/dev/null")))