deployer.clj

(ns deployer
  (:require [clojure.tools.deps.alpha :as deps]
            [clojure.tools.deps.alpha.reader :as reader]
            [clojure.java.io :as io]
            [clojure.string :as string])
  (:import (java.security MessageDigest)
           (com.jcraft.jsch JSch)
           (java.net URI)))

(def hex-alphabet (vec "0123456789ABCDEF"))

(defn hex [bytes]
  (let [chars (char-array (* 2 (count bytes)))]
    (dotimes [i (count bytes)]
      (let [v (bit-and (nth bytes i) 0xFF)]
        (aset chars (* 2 i) (nth hex-alphabet (unsigned-bit-shift-right v 4)))
        (aset chars (inc (* 2 i)) (nth hex-alphabet (bit-and v 0x0F)))))
    (String. chars)))

(defn hash-dir [dir]
  (let [md (MessageDigest/getInstance "SHA-256")
        c  (count (.getAbsolutePath dir))
        buf (byte-array 1024)]
    (doseq [f (file-seq dir)
            :when (not (.isDirectory f))
            :let [n (subs (.getAbsolutePath f) c)]]
      (.update md (.getBytes n))
      (with-open [in (io/input-stream f)]
        (loop []
          (let [i (.read in buf)]
            (when-not (neg? i)
              (.update md buf 0 i)
              (recur))))))
    (hex (.digest md))))

(defprotocol Target
  (exists? [_ path-segments])
  (mkdirs [_ path-segments])
  (write [_ data path-segments])
  (-resolve [_ path-segments]))

(extend-protocol Target
  java.io.File
  (exists? [this path-segments]
    (.exists (apply io/file this path-segments)))
  (mkdirs [this path-segments]
    (.mkdirs (apply io/file this path-segments)))
  (write [this data path-segments]
    (io/copy data (io/output-stream (apply io/file this path-segments))))
  (-resolve [this path-segments]
    (.getAbsolutePath (apply io/file this path-segments))))

(defn f [target n]
  (let [deps-map (reader/read-deps
                  (:config-files (reader/clojure-env)))
        paths (reduce
               (fn [accum [v p]]
                 (if (.exists (io/file p))
                   (if-not (.isDirectory (io/file p))
                     (do
                       (when-not (exists? target ["files"])
                         (mkdirs target ["files"]))
                       (let [f (io/file p)
                             n (.getName f)]
                         (when-not (exists? target ["files" n])
                           (write target f ["files" n]))
                         (conj accum (-resolve target ["files" n]))))
                     (do
                       (when-not (exists? target ["paths"])
                         (mkdirs target ["paths"]))
                       (let [f (io/file p)
                             n (hash-dir f)
                             c (inc (count (.getAbsolutePath f)))]
                         (when-not (exists? target ["paths" n])
                           (mkdirs target ["paths" n])
                           (doseq [file (file-seq f)
                                   :when (not (.isDirectory file))
                                   :let [s (subs (.getAbsolutePath file) c)]]
                             (mkdirs target (list* "paths" n (butlast (.split s "/"))))
                             (write target file (list* "paths" n (.split s "/")))))
                         (conj accum (-resolve target ["paths" n])))))
                   accum))
               []
               (concat
                (for [p (:paths deps-map)] [nil p])
                (for [[_ v] (deps/resolve-deps
                             deps-map
                             {})
                      p (:paths v)]
                  [v p])))]
    (write target (.getBytes (string/join ":" paths)) [n])))

(defn sftp-target [uri]
  (let [f (subs (.getPath uri) 1)
        host (.getHost uri)
        [user pass] (.split (.getUserInfo uri) ":")
        jsch (JSch.)
        session (.getSession jsch user host 22)
        _ (doto jsch
            (.setKnownHosts "/home/kevin/.ssh/known_hosts")
            (.addIdentity "/home/kevin/.ssh/id_rsa"))
        _ (.setConfig session
                      (doto (java.util.Properties.)
                        (.put "StrictHostKeyChecking" "no")))
        _ (.connect session)
        channel (.openChannel session "sftp")
        _ (.connect channel)
        pwd (.pwd channel)]
    (reify
      Target
      (exists? [_ path-segments]
        (boolean
         (try
           (.stat channel (string/join "/" (cons f path-segments)))
           (catch Throwable _))))
      (mkdirs [this path-segments]
        (reduce
         (fn [accum elem]
           (when-not (boolean
                      (try
                        (.stat channel (string/join "/" (conj accum elem)))
                        (catch Throwable _)))
             (.mkdir channel (string/join "/" (conj accum elem))))
           (conj accum elem))
         []
         (cons f path-segments)))
      (write [_ data path-segments]
        (with-open [in (io/input-stream data)]
          (.put channel in (string/join "/" (cons f path-segments)))))
      (-resolve [_ path-segments]
        (string/join "/" (concat [pwd f] path-segments)))
      java.io.Closeable
      (close [_]
        (.disconnect session)))))

(defn -main [uri & args]
  (with-open [s (sftp-target (URI. uri))]
    (f s "cp"))
  (shutdown-agents))